--- trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm 2003/07/13 19:22:50 1376 +++ trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm 2004/09/16 18:59:01 2786 @@ -1,3 +1,19 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ +# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm,v 1.36 2004/09/14 18:55:58 apizer Exp $ +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + package WeBWorK::ContentGenerator::Instructor::SendMail; use base qw(WeBWorK::ContentGenerator::Instructor); @@ -10,21 +26,29 @@ use strict; use warnings; use CGI qw(); -use HTML::Entities; +#use HTML::Entities; use Mail::Sender; +use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; +use WeBWorK::Utils::FilterRecords qw/filterRecords/; +my $REFRESH_RESIZE_BUTTON = "Set preview to: "; # handle submit value idiocy sub initialize { my ($self) = @_; - my $r = $self->{r}; - my $db = $self->{db}; - my $ce = $self->{ce}; - my $authz = $self->{authz}; - my $user = $r->param('user'); - - unless ($authz->hasPermissions($user, "send_mail")) { - $self->{submitError} = "You are not authorized to send mail to students."; - return; - } + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $user = $r->param('user'); + + my @selected_filters; + if (defined ($r->param('classList!filter'))){ @selected_filters = $r->param('classList!filter');} + else {@selected_filters = ("all");} + + + # Check permissions + return unless $authz->hasPermissions($user, "access_instructor_tools"); + return unless $authz->hasPermissions($user, "send_mail"); + ############################################################################################# # gather directory data ############################################################################################# @@ -32,7 +56,7 @@ my $scoringDirectory = $ce->{courseDirs}->{scoring}; my $templateDirectory = $ce->{courseDirs}->{templates}; - my $action = $r->param('action'); + my $action = $r->param('action') ; my $openfilename = $r->param('openfilename'); my $savefilename = $r->param('savefilename'); @@ -42,9 +66,14 @@ my $old_default_msg_file = 'old_default.msg'; + # get user record + my $ur = $self->{db}->getUser($user); + # store data - $self->{defaultFrom} = 'FIXME from'; - $self->{defaultReply} = 'FIXME reply'; + $self->{defaultFrom} = $ur->email_address . " (".$ur->first_name." ".$ur->last_name.")"; + $self->{defaultReply} = $ur->email_address; + $self->{defaultSubject} = $self->r->urlpath->arg("courseID") . " notice"; + $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows}; $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns}; $self->{default_msg_file} = $default_msg_file; @@ -57,10 +86,62 @@ # gather database data ############################################################################################# # FIXME this might be better done in body? We don't always need all of this data. or do we? - my @users = sort $db->listUsers; + my @users = $db->listUsers; + my @Users = $db->getUsers(@users); my @user_records = (); - push(@user_records,$db->getUser($_)) foreach (@users); + +## Mark's code to prefilter userlist + + + my (@viewable_sections,@viewable_recitations); + + if (defined @{$ce->{viewable_sections}->{$user}}) + {@viewable_sections = @{$ce->{viewable_sections}->{$user}};} + if (defined @{$ce->{viewable_recitations}->{$user}}) + {@viewable_recitations = @{$ce->{viewable_recitations}->{$user}};} + + if (@viewable_sections or @viewable_recitations){ + foreach my $student (@Users){ + my $keep = 0; + foreach my $sec (@viewable_sections){ + if ($student->section() eq $sec){$keep = 1;} + } + foreach my $rec (@viewable_recitations){ + if ($student->recitation() eq $rec){$keep = 1;} + } + if ($keep) {push @user_records, $student;} + } + } + else {@user_records = @Users;} + +## End Mark's code + +# foreach my $userName (@users) { +# my $userRecord = $db->getUser($userName); # checked +# die "record for user $userName not found" unless $userRecord; +# push(@user_records, $userRecord); +# } + ########################### + # Sort the users for presentation in the select list + ########################### +# if (defined $r->param("sort_by") ) { +# my $sort_method = $r->param("sort_by"); +# if ($sort_method eq 'section') { +# @user_records = sort { (lc($a->section) cmp lc($b->section)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records; +# } elsif ($sort_method eq 'recitation') { +# @user_records = sort { (lc($a->recitation) cmp lc($b->recitation)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records; +# } elsif ($sort_method eq 'alphabetical') { +# @user_records = sort { (lc($a->last_name) cmp lc($b->last_name)) } @user_records; +# } elsif ($sort_method eq 'id' ) { +# @user_records = sort { $a->user_id cmp $b->user_id } @user_records; +# } +# } else { +# @user_records = sort { $a->user_id cmp $b->user_id } @user_records; +# } + + # replace the user names by a sorted version. + @users = map {$_->user_id} @user_records; # store data $self->{ra_users} = \@users; $self->{ra_user_records} = \@user_records; @@ -72,6 +153,13 @@ #FIXME this (radio) is a lousy name my $recipients = $r->param('radio'); if (defined($recipients) and $recipients eq 'all_students') { #only active students #FIXME status check?? + +## Add code so that only people who pass the current filters are added to our list of recipients. +# @user_records = filterRecords({filter=\@selected_filters},@user_records); +# I wasn't able to make this work +# I edited the selection button to make that clear. +# + foreach my $ur (@user_records) { push(@send_to,$ur->user_id) if $ur->status eq 'C' and not($ur->user_id =~ /practice/); } @@ -92,18 +180,18 @@ if ( -R "${emailDirectory}/$openfilename") { $input_file = $openfilename; } else { - warn join("", + $self->addbadmessage(CGI::p(join("", "The file ${emailDirectory}/$openfilename is not readable by the webserver.",CGI::br(), "Check that it's permissions are set correctly.", - ); + ))); } } else { $input_file = $default_msg_file; - warn join("", + $self->addbadmessage(CGI::p(join("", "The file ${emailDirectory}/$openfilename cannot be found.",CGI::br(), "Check whether it exists and whether the directory $emailDirectory can be read by the webserver.",CGI::br(), "Using contents of the default message $default_msg_file instead.", - ); + ))); } } else { $input_file = $default_msg_file; @@ -116,46 +204,53 @@ my $output_file = 'FIXME no output file specified'; if (defined($action) and $action eq 'Save as Default') { $output_file = $default_msg_file; - } elsif ( defined($action) and ($action =~/save/i) and defined($savefilename) ){ - $output_file = $savefilename; + } elsif ( defined($action) and ($action =~/save/i)) { + if (defined($savefilename) and $savefilename ) { + $output_file = $savefilename; + } else { + $self->addbadmessage(CGI::p("No filename was specified for saving! The message was not saved.")); + } } elsif ( defined($input_file) ) { $output_file = $input_file; } -# warn "FIXME savefilename $savefilename output file $output_file"; + ################################################################# # Sanity check on save file name ################################################################# if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) { - $self->submission_error("For security reasons, you cannot specify a merge file from a directory", - "higher than the email directory (you can't use ../blah/blah). ", - "Please specify a different file or move the needed file to the email directory", - ); - } + $self->addbadmessage(CGI::p("For security reasons, you cannot specify a message file from a directory", + "higher than the email directory (you can't use ../blah/blah for example). ", + "Please specify a different file or move the needed file to the email directory",)); + } unless ($output_file =~ m|\.msg$| ) { - $self->submission_error("Invalid file name.", + $self->addbadmessage(CGI::p("Invalid file name.", "The file name \"$output_file\" does not have a \".msg\" extension", "All email file names must end in the extension \".msg\"", "choose a file name with a \".msg\" extension.", - "The message was not saved.", - ); + "The message was not saved.",)); } + $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing. - # FIXME $output_file can be blank if there was no savefilename + ############################################################################################# # Determine input source ############################################################################################# - my $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file'; -# warn "FIXME input source is $input_source from $input_file"; + #warn "Action = $action"; + my $input_source; + if ($action){ + $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file';} + else { $input_source = ( defined($r->param('body')) ) ? 'form' : 'file';} + ############################################################################################# # Get inputs ############################################################################################# my($from, $replyTo, $r_text, $subject); if ($input_source eq 'file') { -# warn "FIXME obtaining source from $emailDirectory/$input_file"; + ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file"); -# warn "FIXME Done reading source"; + } elsif ($input_source eq 'form') { # read info from the form @@ -166,7 +261,7 @@ $subject = $r->param('subject'); my $body = $r->param('body'); # Sanity check: body must contain non-white space - $self->submission_error('You didn\'t enter any message.') unless ($r->param('body') =~ /\S/); + $self->addbadmessage(CGI::p('You didn\'t enter any message.')) unless ($r->param('body') =~ /\S/); $r_text = \$body; } @@ -208,9 +303,9 @@ my $script_action = ''; - if(not defined($action) or $action eq 'Open' or $action eq 'Resize message window' + if(not defined($action) or $action eq 'Open' or $action eq $REFRESH_RESIZE_BUTTON or $action eq 'Sort by' or $action eq 'Set merge file to:' ){ -# warn "FIXME action is |$action| no further initialization required"; + return ''; } @@ -242,9 +337,9 @@ # overwrite protection ################################################################# if ($action eq 'Save as:' and -e "$emailDirectory/$output_file") { - $self->submission_error("The file $emailDirectory/$output_file already exists and cannot be overwritten", - "The message was not saved"); - return; + $self->addbadmessage(CGI::p("The file $emailDirectory/$output_file already exists and cannot be overwritten", + "The message was not saved")); + return; } ################################################################# @@ -254,39 +349,46 @@ rename("$emailDirectory/$default_msg_file","$emailDirectory/$old_default_msg_file") or die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ", "Check permissions for webserver on directory $emailDirectory. $!"; - $self->{message} .= "Backup file $emailDirectory/$old_default_msg_file created.".CGI::br(); + $self->addgoodmessage(CGI::p("Backup file $emailDirectory/$old_default_msg_file created." . CGI::br())); } ################################################################# # Save the message ################################################################# - $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ); - $self->{message} .= "Message saved to file ${emailDirectory}/$output_file."; -# warn "FIXME saving to ${emailDirectory}/$output_file"; - } elsif ($action eq 'Preview') { + $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ) unless ($output_file =~ /^[~.]/ || $output_file =~ /\.\./ || not $output_file =~ m|\.msg$|); + unless ( $self->{submit_message} or not -w "${emailDirectory}/$output_file" ) { # if there are no errors report success + $self->addgoodmessage(CGI::p("Message saved to file ${emailDirectory}/$output_file.")); + } + + } elsif ($action eq 'Preview message') { $self->{response} = 'preview'; } elsif ($action eq 'Send Email') { $self->{response} = 'send_email'; my @recipients = @{$self->{ra_send_to}}; - warn "No recipients selected " unless @recipients; + $self->addbadmessage(CGI::p("No recipients selected ")) unless @recipients; # get merge file my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; my $delimiter = ','; - my $rh_merge_data = $self->read_merge_file("$merge_file", "$delimiter"); + my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); unless (ref($rh_merge_data) ) { - warn "no merge data file"; - $self->submission_error("Can't read merge file $merge_file. No message sent"); + $self->addbadmessage(CGI::p("No merge data file")); + $self->addbadmessage(CGI::p("Can't read merge file $merge_file. No message sent")); return; } ; foreach my $recipient (@recipients) { #warn "FIXME sending email to $recipient"; - my $ur = $self->{db}->getUser($recipient); + my $ur = $self->{db}->getUser($recipient); #checked + die "record for user $recipient not found" unless $ur; + unless ($ur->email_address) { + $self->addbadmessage(CGI::p("user $recipient does not have an email address -- skipping")); + next; + } my ($msg, $preview_header); eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); }; - warn "There were errors in processing user $ur, merge file $merge_file. $@" if $@; + $self->addbadmessage(CGI::p("There were errors in processing user $ur, merge file $merge_file. $@")) if $@; my $mailer = Mail::Sender->new({ from => $from, to => $ur->email_address, @@ -295,22 +397,22 @@ headers => "X-Remote-Host: ".$r->get_remote_host(), }); unless (ref $mailer) { - warn "Failed to create a mailer: $Mail::Sender::Error"; + $self->addbadmessage(CGI::p("Failed to create a mailer for user $recipient: $Mail::Sender::Error")); next; } unless (ref $mailer->Open()) { - warn "Failed to open the mailer: $Mail::Sender::Error"; + $self->addbadmessage(CGI::p("Failed to open the mailer for user $recipient: $Mail::Sender::Error")); next; } - my $MAIL = $mailer->GetHandle() or warn "Couldn't get handle"; - print $MAIL $msg || warn "Couldn't print to $MAIL"; - close $MAIL || warn "Couldn't close $MAIL"; + my $MAIL = $mailer->GetHandle() or $self->addbadmessage(CGI::p("Couldn't get handle")); + print $MAIL $msg || $self->addbadmessage(CGI::p("Couldn't print to $MAIL")); + close $MAIL || $self->addbadmessage(CGI::p("Couldn't close $MAIL")); #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject"; } } else { - warn "Didn't recognize button $action"; + $self->addbadmessage(CGI::p("Didn't recognize button $action")); } @@ -318,33 +420,30 @@ } #end initialize -sub title { - my $self = shift; - return 'Send mail to ' .$self->{ce}->{courseName}; -} -sub path { - my $self = shift; - my $args = $_[-1]; - - my $ce = $self->{ce}; - my $root = $ce->{webworkURLs}->{root}; - my $courseName = $ce->{courseName}; - return $self->pathMacro($args, - "Home" => "$root", - $courseName => "$root/$courseName", - 'instructor' => "$root/$courseName/instructor", - "Send Mail to: $courseName" => '', - ); -} + sub body { - my ($self, $setID) = @_; + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $authz = $r->authz; + my $setID = $urlpath->arg("setID"); my $response = (defined($self->{response}))? $self->{response} : ''; + my $user = $r->param('user'); + + # Check permissions + return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to access instructor tools")) + unless $authz->hasPermissions($user, "access_instructor_tools"); + + return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to send mail to students")) + unless $authz->hasPermissions($user, "send_mail"); + if ($response eq 'preview') { $self->print_preview($setID); } elsif (($response eq 'send_email')){ - $self->{message} .= CGI::h3("Email sent to "). join(" ", @{$self->{ra_send_to}}); + $self->addgoodmessage(CGI::p("Email sent to ". scalar(@{$self->{ra_send_to}})." students.")); + $self->{message} .= CGI::i("Email sent to ". scalar(@{$self->{ra_send_to}})." students."); $self->print_form($setID); } else { $self->print_form($setID); @@ -352,19 +451,24 @@ } sub print_preview { - my ($self, $setID) = @_; + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $setID = $urlpath->arg("setID"); + # get preview user - my $ur = $self->{db}->getUser($self->{preview_user}); + my $ur = $r->db->getUser($self->{preview_user}); #checked + die "record for preview user ".$self->{preview_user}. " not found." unless $ur; # get merge file my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; my $delimiter = ','; - my $rh_merge_data = $self->read_merge_file("$merge_file", "$delimiter"); + my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data); my $recipients = join(" ",@{$self->{ra_send_to} }); - my $errorMessage = defined($self->{submitError}) ? CGI::h3($self->{submitError} ) : '' ; + my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ; $msg = join("", $errorMessage, $preview_header, @@ -385,14 +489,19 @@ } sub print_form { - my ($self, $setID) = @_; - my $r = $self->{r}; - my $authz = $self->{authz}; - my $user = $r->param('user'); - my $db = $self->{db}; - my $ce = $self->{ce}; - my $root = $ce->{webworkURLs}->{root}; - my $courseName = $ce->{courseName}; + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $authz = $r->authz; + my $db = $r->db; + my $ce = $r->ce; + my $courseName = $urlpath->arg("courseID"); + my $setID = $urlpath->arg("setID"); + my $user = $r->param('user'); + + my $root = $ce->{webworkURLs}->{root}; + my $sendMailPage = $urlpath->newFromModule($urlpath->module,courseID=>$courseName); + my $sendMailURL = $self->systemLink($sendMailPage, authen => 0); return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); @@ -404,9 +513,19 @@ my $ra_user_records = $self->{ra_user_records}; my %classlistLabels = ();# %$hr_classlistLabels; foreach my $ur (@{ $ra_user_records }) { - $classlistLabels{$ur->user_id} = $ur->user_id.' '.$ur->last_name. ', '. $ur->first_name.' - '.$ur->section; + $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation; } +## Mark edit define scrolling list + my $scrolling_user_list = scrollingRecordList({ + name => "classList", ## changed from classList to action + request => $r, + default_sort => "lnfn", + default_format => "lnfn_uid", + default_filters => ["all"], + size => 5, + multiple => 1, + }, @{$ra_user_records}); ############################################################################################################## @@ -423,26 +542,28 @@ my @sorted_merge_files = $self->get_merge_file_names; my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; my $delimiter = ','; - my $rh_merge_data = $self->read_merge_file("$merge_file", "$delimiter"); + my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); my @merge_keys = keys %$rh_merge_data; my $preview_user = $self->{preview_user}; - my $preview_record = $db->getUser($preview_user); + my $preview_record = $db->getUser($preview_user); # checked + die "record for preview user ".$self->{preview_user}. " not found." unless $preview_record; + ############################################################################################# - print CGI::start_form({method=>"post", action=>$r->uri()}); + print CGI::start_form({method=>"post", action=>$sendMailURL}); print $self->hidden_authen_fields(); ############################################################################################# # begin upper table ############################################################################################# print CGI::start_table({-border=>'2', -cellpadding=>'4'}); - print CGI::Tr({-align=>'left',-valign=>'VCENTER'}, + print CGI::Tr({-align=>'left',-valign=>'top'}, ############################################################################################# # first column ############################################################################################# - CGI::td("Message file: $input_file","\n",CGI::br(), + CGI::td(CGI::strong("Message file: $input_file"),"\n",CGI::br(), CGI::submit(-name=>'action', -value=>'Open'), '    ',"\n", CGI::popup_menu(-name=>'openfilename', -values=>\@sorted_messages, @@ -457,43 +578,70 @@ ############################################################################################# # second column ############################################################################################# - CGI::td({-align=>'left'}, - CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], - -labels=>{all_students=>'All active students',studentID => 'Select recipients'}, - -default=>'studentID', - -linebreak=>1), - CGI::br(), - CGI::popup_menu(-name=>'classList', - -values=>\@users, - -labels=>\%classlistLabels, - -size => 10, - -multiple => 1, - -default=>$user - ), +# CGI::td({-align=>'left',style=>'font-size:smaller'}, +# +# CGI::strong("Send to:"), +# CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], +# -labels=>{all_students=>'All students in course',studentID => 'Selected'}, +# -default=>'studentID', +# -linebreak=>0 +# ), CGI::br(),CGI::br(), +## Edit by Mark to insert scrolling list + CGI::td({-style=>"width:33%"},CGI::strong("Send to:"), + CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], + -labels=>{all_students=>'All students in course',studentID => 'Selected students'}, + -default=>'studentID', -linebreak=>0), + CGI::br(),$scrolling_user_list), +## Edit here to insert filtering +## be sure to fail GRACEFULLY! +# +# +# CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),, +# CGI::radio_group(-name=>'sort_by', -values=>['id','alphabetical','section','recitation'], +# -labels=>{id=>'Login',alphabetical=>'Alph.',section => 'Sec.',recitation=>'Rec.'}, +# -default=>defined($r->param("sort_by")) ? $r->param("sort_by") : 'id', +# -linebreak=>0 +# ), +# +# CGI::br(),CGI::br(), +# CGI::popup_menu(-name=>'classList', +# -values=>\@users, +# -labels=>\%classlistLabels, +# -size => 10, +# -multiple => 1, +# -default=>$user +# ), +# ), + - - ), + + ############################################################################################# # third column ############################################################################################# CGI::td({align=>'left'}, - "Merge file is: $merge_file", CGI::br(), + "Merge file: $merge_file", CGI::br(), CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(), CGI::popup_menu(-name=>'merge_file', -values=>\@sorted_merge_files, -default=>$merge_file, - ), "\n",CGI::hr(),CGI::br(), - CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview')," email to ", + ), "\n",CGI::hr(), + CGI::b("Viewing email for: "), "$preview_user",CGI::br(), + CGI::submit(-name=>'action', -value=>'resize', -label=>$REFRESH_RESIZE_BUTTON),' ', CGI::popup_menu(-name=>'preview_user', -values=>\@users, #-labels=>\%classlistLabels, -default=>$preview_user, ), + CGI::br(), + CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview message'),'  ', + + CGI::br(), + CGI::hr(), - CGI::submit(-name=>'action', -value=>'resize', -label=>'Resize message window'),CGI::br(), " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), - CGI::br(),CGI::br(), + CGI::br(),CGI::i('Press any action button to update display'),CGI::br(), #show available macros CGI::popup_menu( -name=>'dummyName', @@ -534,11 +682,11 @@ # merge file fragment and message text area field ############################################################################################# my @tmp2; - eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; - if ($@) { - print CGI::p( "Couldn't get merge data for $preview_user", CGI::br(), $@) ; + eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; # checked + if ($@ and $merge_file ne 'None') { + print "No merge data for $preview_user in merge file: <$merge_file>",CGI::br(); } else { - print CGI::pre("",data_format(0..($#tmp2)),"\n", data_format(@tmp2)); + print CGI::pre("",data_format(1..($#tmp2+1)),"
", data_format2(@tmp2)); } #create a textbox with the subject and a textarea with the message #print actual body of message @@ -571,13 +719,9 @@ ############################################################################## sub submission_error { my $self = shift; - my $msg = join( " ", @_); - $self->{submitError} .= CGI::br().$msg; #CGI::b(HTML::Entities::encode($msg)); -# qq{Please hit the "Back" button on your browser to -# try again, or notify your web master -# if you believe this message is in error. -# }; - return; + my $msg = join( " ", @_); + $self->{submitError} .= CGI::br().$msg; + return; } sub saveProblem { @@ -585,13 +729,12 @@ my ($body, $probFileName)= @_; local(*PROBLEM); open (PROBLEM, ">$probFileName") || - $self->submission_error("Could not open $probFileName for writing. - Check that the permissions for this problem are 660 (-rw-rw----)"); - print PROBLEM $body; + $self->addbadmessage(CGI::p("Could not open $probFileName for writing. + Check that the permissions for this problem are 660 (-rw-rw----)")); + print PROBLEM $body if -w $probFileName; close PROBLEM; chmod 0660, "$probFileName" || - $self->submission_error(" - CAN'T CHANGE PERMISSIONS ON FILE $probFileName"); + $self->addbadmessage(CGI::p("CAN'T CHANGE PERMISSIONS ON FILE $probFileName")); } sub read_input_file { @@ -602,7 +745,7 @@ my ($subject, $from, $replyTo); local(*FILE); if (-e "$filePath" and -r "$filePath") { - open FILE, "$filePath" || do { $self->submission_error("Can't open $filePath"); return}; + open FILE, "$filePath" || do { $self->addbadmessage(CGI::p("Can't open $filePath")); return}; while ($header !~ s/Message:\s*$//m and not eof(FILE)) { $header .= ; } @@ -621,70 +764,22 @@ $from = $self->{defaultFrom}; $replyTo = $self->{defaultReply}; $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist"; - $subject = "FIXME default subject"; + $subject = $self->{defaultSubject}; } return ($from, $replyTo, $subject, \$text); } -sub get_message_file_names { - my $self = shift; - my $emailDirectory = $self->{ce}->{courseDirs}->{email}; - #get all message files and create a list - local(*EMAILDIR); - opendir( EMAILDIR, $emailDirectory )|| die "Can't access directory $emailDirectory. Please check that webserver has permission to read this directory."; - my @messageFiles = grep /\.msg$/, readdir EMAILDIR; #all message files - closedir EMAILDIR; - return sort @messageFiles; +sub get_message_file_names { + my $self = shift; + return $self->read_dir($self->{ce}->{courseDirs}->{email}, '\\.msg$'); } -sub get_merge_file_names { - my $self = shift; - my $scoringDirectory = $self->{ce}->{courseDirs}->{scoring}; - #get all message files and create a list - local(*SCORINGDIR); - opendir( SCORINGDIR, $scoringDirectory )|| die "Can't access directory $scoringDirectory.", - "Please check that webserver has permission to read this directory."; - my @mergeFiles = grep( /\.csv$/, readdir SCORINGDIR); #all message files - closedir SCORINGDIR; - @mergeFiles = sort @mergeFiles; -# warn "FIXME scoring directory $scoringDirectory merge Files", join(" ", @mergeFiles); - unshift(@mergeFiles, 'None'); - return @mergeFiles; +sub get_merge_file_names { + my $self = shift; + return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed. } -sub read_merge_file { - my $self = shift; - my $fileName = shift; - my $delimiter = shift; - $delimiter = ',' unless defined($delimiter); - my $scoringDirectory= $self->{ce}->{courseDirs}->{scoring}; - my $filePath = "$scoringDirectory/$fileName"; - # Takes a delimited file as a parameter and returns an - # associative array with the first field as the key. - # Blank lines are skipped. White space is removed - my(@dbArray,$key,$dbString); - my %assocArray = (); - local(*FILE); - if ($fileName eq 'None') { - # do nothing - } elsif ( open(FILE, "$filePath") ) { - my $index=0; - while (){ - unless ($_ =~ /\S/) {next;} ## skip blank lines - chomp; - @{$dbArray[$index]} =$self->getRecord($_,$delimiter); - $key =$dbArray[$index][0]; - #@dbArray = map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} @dbArray; - #$dbString = join(" | ",@dbArray); - $assocArray{$key}=$dbArray[$index]; - $index++; - } - close(FILE); - } else { - warn "Couldn't read file $filePath"; - } - return \%assocArray; -} + sub getRecord { my $self = shift; my $line = shift; @@ -698,10 +793,10 @@ # would return). E.G. @lineArray=&getRecord(\$delimitedLine). my(@lineArray); - $line.=$delimiter; # add 'A' to end of line so that - # last field is never empty - @lineArray = split(/\s*${delimiter}\s*/,$line); + $line.="${delimiter}___"; # add final field which must be non-empty + @lineArray = split(/\s*${delimiter}\s*/,$line); # split line into fields $lineArray[0] =~s/^\s*//; # remove white space from first element + pop @lineArray; # remove the last artificial field @lineArray; } @@ -710,7 +805,8 @@ my $ur = shift; my $rh_merge_data = shift; my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: - 'FIXME no text was produced by initialization!!'; + 'FIXME no text was produced by initialization!!'; + my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; #user macros that can be used in the email message my $SID = $ur->student_id; my $FN = $ur->first_name; @@ -720,11 +816,14 @@ my $STATUS = $ur->status; my $EMAIL = $ur->email_address; my $LOGIN = $ur->user_id; + # get record from merge file # FIXME this is inefficient. The info should be cached my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); - $self->submission_error( "No merge data for $SID $FN $LN $LOGIN") unless defined($rh_merge_data->{$SID}); - + if ($merge_file ne 'None' && not defined($rh_merge_data->{$SID}) ) { + $self->addbadmessage(CGI::p("No merge data for student id:$SID; name:$FN $LN; login:$LOGIN")); + } + unshift(@COL,""); ## this makes COL[1] the first column my $endCol = @COL; # for safety, only evaluate special variables my $msg = $text; @@ -736,18 +835,27 @@ $msg =~ s/(\$RECITATION)/eval($1)/ge; $msg =~ s/(\$EMAIL)/eval($1)/ge; $msg =~ s/(\$LOGIN)/eval($1)/ge; - $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g; - $msg =~ s/(\$COL\[.*?\])/eval($1)/ge; - - $msg =~ s/\r//g; +# $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g; ## Perl handles negative indexes correctly, so there is no need to do this + $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1]/ge if defined($COL[1]); # prevents extraneous error messages. - my $preview_header = CGI::pre("",data_format(0..($#COL)),"\n", data_format(@COL)). + $msg =~ s/\r//g; + + my @preview_COL = @COL; + shift @preview_COL; ## shift back for preview + my $preview_header = CGI::pre("",data_format(1..($#COL)),"
", data_format2(@preview_COL)). CGI::h3( "This sample mail would be sent to $EMAIL"); - return $msg, $preview_header; } + + +# Ê sub data_format { +# +# Ê Ê Ê Ê Êmap {$_ =~s/\s/\./g;$_} Ê Ê map {sprintf('%-8.8s',$_);} Ê@_; sub data_format { - map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} @_; + map {"COL[$_]".' 'x(3-length($_));} @_; # problems if $_ has length bigger than 4 + } + sub data_format2 { + map {$_ =~s/\s/ /g;$_} map {sprintf('%-8.8s',$_);} @_; } 1;