[system] / trunk / webwork2 / lib / WeBWorK / ContentGenerator / Instructor / SendMail.pm Repository:
ViewVC logotype

Diff of /trunk/webwork2/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 1371 Revision 2035
1################################################################################
2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm,v 1.25 2004/05/05 01:53:51 gage Exp $
5#
6# This program is free software; you can redistribute it and/or modify it under
7# the terms of either: (a) the GNU General Public License as published by the
8# Free Software Foundation; either version 2, or (at your option) any later
9# version, or (b) the "Artistic License" which comes with this package.
10#
11# This program is distributed in the hope that it will be useful, but WITHOUT
12# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
13# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
14# Artistic License for more details.
15################################################################################
16
1package WeBWorK::ContentGenerator::Instructor::SendMail; 17package WeBWorK::ContentGenerator::Instructor::SendMail;
2use base qw(WeBWorK::ContentGenerator::Instructor); 18use base qw(WeBWorK::ContentGenerator::Instructor);
3 19
4=head1 NAME 20=head1 NAME
5 21
… …
8=cut 24=cut
9 25
10use strict; 26use strict;
11use warnings; 27use warnings;
12use CGI qw(); 28use CGI qw();
13use HTML::Entities; 29#use HTML::Entities;
30use Mail::Sender;
14 31
32my $REFRESH_RESIZE_BUTTON = "Reorder, Resize and Update"; # handle submit value idiocy
15sub initialize { 33sub initialize {
16 my ($self) = @_; 34 my ($self) = @_;
17 my $r = $self->{r}; 35 my $r = $self->r;
18 my $db = $self->{db}; 36 my $db = $r->db;
19 my $ce = $self->{ce}; 37 my $ce = $r->ce;
20 my $authz = $self->{authz}; 38 my $authz = $r->authz;
21 my $user = $r->param('user'); 39 my $user = $r->param('user');
22 40
23 unless ($authz->hasPermissions($user, "send_mail")) { 41 unless ($authz->hasPermissions($user, "send_mail")) {
24 $self->{submitError} = "You are not authorized to send mail to students."; 42 $self->{submitError} = "You are not authorized to send mail to students.";
25 return; 43 return;
26 } 44 }
… …
38 56
39 #FIXME get these values from global course environment (see subroutines as well) 57 #FIXME get these values from global course environment (see subroutines as well)
40 my $default_msg_file = 'default.msg'; 58 my $default_msg_file = 'default.msg';
41 my $old_default_msg_file = 'old_default.msg'; 59 my $old_default_msg_file = 'old_default.msg';
42 60
61
43 # store data 62 # store data
44 $self->{defaultFrom} = 'FIXME from'; 63 $self->{defaultFrom} = 'FIXME from';
45 $self->{defaultReply} = 'FIXME reply'; 64 $self->{defaultReply} = 'FIXME reply';
46 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows}; 65 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows};
47 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns}; 66 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns};
48 $self->{default_msg_file} = $default_msg_file; 67 $self->{default_msg_file} = $default_msg_file;
49 $self->{old_default_msg_file} = $old_default_msg_file; 68 $self->{old_default_msg_file} = $old_default_msg_file;
50 $self->{merge_file} = (defined($r->param('merge_file'))) ? $r->param('merge_file') : 'None'; 69 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None';
70 $self->{preview_user} = (defined($r->param('preview_user'))) ? $r->param('preview_user') : $user;
71
72
73#############################################################################################
74# gather database data
75#############################################################################################
76 # FIXME this might be better done in body? We don't always need all of this data. or do we?
77 my @users = $db->listUsers;
78 my @user_records = ();
79 foreach my $userName (@users) {
80 my $userRecord = $db->getUser($userName); # checked
81 die "record for user $userName not found" unless $userRecord;
82 push(@user_records, $userRecord);
83 }
84 ###########################
85 # Sort the users for presentation in the select list
86 ###########################
87 if (defined $r->param("sort_by") ) {
88 my $sort_method = $r->param("sort_by");
89 if ($sort_method eq 'section') {
90 @user_records = sort { (lc($a->section) cmp lc($b->section)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
91 } elsif ($sort_method eq 'recitation') {
92 @user_records = sort { (lc($a->recitation) cmp lc($b->recitation)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
93 } elsif ($sort_method eq 'alphabetical') {
94 @user_records = sort { (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
95 } elsif ($sort_method eq 'id' ) {
96 @user_records = sort { $a->user_id cmp $b->user_id } @user_records;
97 }
98 } else {
99 @user_records = sort { $a->user_id cmp $b->user_id } @user_records;
100 }
101
102
103 # replace the user names by a sorted version.
104 @users = map {$_->user_id} @user_records;
105 # store data
106 $self->{ra_users} = \@users;
107 $self->{ra_user_records} = \@user_records;
108
109#############################################################################################
110# gather list of recipients
111#############################################################################################
112 my @send_to = ();
113 #FIXME this (radio) is a lousy name
114 my $recipients = $r->param('radio');
115 if (defined($recipients) and $recipients eq 'all_students') { #only active students #FIXME status check??
116 foreach my $ur (@user_records) {
117 push(@send_to,$ur->user_id) if $ur->status eq 'C' and not($ur->user_id =~ /practice/);
118 }
119 } elsif (defined($recipients) and $recipients eq 'studentID' ) {
120 @send_to = $r->param('classList');
121 } else {
122 # no recipients have been defined -- probably the first time on the page
123 }
124 $self->{ra_send_to} = \@send_to;
51################################################################# 125#################################################################
52# Check the validity of the input file name 126# Check the validity of the input file name
53################################################################# 127#################################################################
54 my $input_file = ''; 128 my $input_file = '';
55 #make sure an input message file was submitted and exists 129 #make sure an input message file was submitted and exists
… …
71 "Check whether it exists and whether the directory $emailDirectory can be read by the webserver.",CGI::br(), 145 "Check whether it exists and whether the directory $emailDirectory can be read by the webserver.",CGI::br(),
72 "Using contents of the default message $default_msg_file instead.", 146 "Using contents of the default message $default_msg_file instead.",
73 ); 147 );
74 } 148 }
75 } else { 149 } else {
76 $input_file = $default_msg_file; 150 $input_file = $default_msg_file;
77 } 151 }
78 $self->{input_file}=$input_file; 152 $self->{input_file} =$input_file;
79 153
80################################################################# 154#################################################################
81# Determine the file name to save message into 155# Determine the file name to save message into
82################################################################# 156#################################################################
83 my $output_file = 'FIXME no output file specified'; 157 my $output_file = 'FIXME no output file specified';
84 if (defined($action) and $action eq 'Save as Default') { 158 if (defined($action) and $action eq 'Save as Default') {
85 $output_file = $default_msg_file; 159 $output_file = $default_msg_file;
86 } elsif ( defined($action) and ($action =~/save/i) and defined($savefilename) ){ 160 } elsif ( defined($action) and ($action =~/save/i) and defined($savefilename) and $savefilename ){
87 $output_file = $savefilename; 161 $output_file = $savefilename;
88 } elsif ( defined($input_file) ) { 162 } elsif ( defined($input_file) ) {
89 $output_file = $input_file; 163 $output_file = $input_file;
90 } 164 }
91# warn "FIXME savefilename $savefilename output file $output_file"; 165
92 ################################################################# 166 #################################################################
93 # Sanity check on save file name 167 # Sanity check on save file name
94 ################################################################# 168 #################################################################
95 169
96 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) { 170 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) {
97 $self->submission_error("For security reasons, you cannot specify a merge file from a directory", 171 $self->submission_error("For security reasons, you cannot specify a message file from a directory",
98 "higher than the email directory (you can't use ../blah/blah). ", 172 "higher than the email directory (you can't use ../blah/blah for example). ",
99 "Please specify a different file or move the needed file to the email directory", 173 "Please specify a different file or move the needed file to the email directory",
100 ); 174 );
101 } 175 }
102 unless ($output_file =~ m|\.msg$| ) { 176 unless ($output_file =~ m|\.msg$| ) {
103 $self->submission_error("Invalid file name.", 177 $self->submission_error("Invalid file name.",
… …
112 186
113############################################################################################# 187#############################################################################################
114# Determine input source 188# Determine input source
115############################################################################################# 189#############################################################################################
116 my $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file'; 190 my $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file';
117# warn "FIXME input source is $input_source from $input_file"; 191
118############################################################################################# 192#############################################################################################
119# Get inputs 193# Get inputs
120############################################################################################# 194#############################################################################################
121 my($from, $replyTo, $r_text, $subject); 195 my($from, $replyTo, $r_text, $subject);
122 if ($input_source eq 'file') { 196 if ($input_source eq 'file') {
123# warn "FIXME obtaining source from $emailDirectory/$input_file"; 197
124 ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file"); 198 ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file");
125# warn "FIXME Done reading source"; 199
126 200
127 } elsif ($input_source eq 'form') { 201 } elsif ($input_source eq 'form') {
128 # read info from the form 202 # read info from the form
129 # bail if there is no message body 203 # bail if there is no message body
130 204
… …
142 $self->{replyTo} = $replyTo; 216 $self->{replyTo} = $replyTo;
143 $self->{subject} = $subject; 217 $self->{subject} = $subject;
144 $self->{r_text} = $r_text; 218 $self->{r_text} = $r_text;
145 219
146 220
221
222###################################################################################
223#Determine the appropriate script action from the buttons
224###################################################################################
225# first time actions
226# open new file
227# open default file
228# choose merge file actions
229# chose merge button
230# option actions
231# 'reset rows'
232
233# save actions
234# "save" button
235# "save as" button
236# "save as default" button
237# preview actions
238# 'preview' button
239# email actions
240# 'entire class'
241# 'selected studentIDs'
242# error actions (various)
243
244
147############################################################################################# 245#############################################################################################
148# if no form is submitted, gather data needed to produce the mail form and return 246# if no form is submitted, gather data needed to produce the mail form and return
149############################################################################################# 247#############################################################################################
150 248 my $to = $r->param('To');
151 if(not defined($action) or $action eq 'Open' or $action eq 'Resize message window' 249 my $script_action = '';
250
251
252 if(not defined($action) or $action eq 'Open' or $action eq $REFRESH_RESIZE_BUTTON or $action eq 'Sort by'
152 or $action eq 'Choose merge file' ){ 253 or $action eq 'Set merge file to:' ){
153# warn "FIXME action is |$action| no further initialization required"; 254
154 return ''; 255 return '';
155 } 256 }
156 257
157 258
158 259
… …
161############################################################################################# 262#############################################################################################
162# If form is submitted deal with filled out forms 263# If form is submitted deal with filled out forms
163# and various actions resulting from different buttons 264# and various actions resulting from different buttons
164############################################################################################# 265#############################################################################################
165 266
166
167 my $to = $r->param('To');
168
169
170
171 ###################################################################################
172 #Determine the appropriate script action from the buttons
173 ###################################################################################
174 # save actions
175 # "save" button
176 # "save as" button
177 # "save as default" button
178 # preview actions
179 # 'preview' button
180 # email actions
181 # 'entire class'
182 # 'selected studentIDs'
183 # option actions
184 # 'reset rows'
185 # error actions (various)
186
187 my $script_action = '';
188 # user_errors
189 # save
190 # save as
191 # save as default
192 # send mail
193 # set defaults
194 267
195 if ($action eq 'Save' or $action eq 'Save as:' or $action eq 'Save as Default') { 268 if ($action eq 'Save' or $action eq 'Save as:' or $action eq 'Save as Default') {
196 269
197# warn "FIXME Saving files action = $action outputFileName=$output_file"; 270# warn "FIXME Saving files action = $action outputFileName=$output_file";
198 271
… …
226 } 299 }
227 ################################################################# 300 #################################################################
228 # Save the message 301 # Save the message
229 ################################################################# 302 #################################################################
230 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ); 303 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" );
304 unless ( $self->{submitError} or not -w "${emailDirectory}/$output_file" ) { # if there are no errors report success
231 $self->{message} .= "Message saved to file <code>${emailDirectory}/$output_file</code>."; 305 $self->{message} .= "Message saved to file <code>${emailDirectory}/$output_file</code>.";
232# warn "FIXME saving to ${emailDirectory}/$output_file"; 306 }
307
233 } elsif ($action eq 'preview') { 308 } elsif ($action eq 'Preview') {
234 309 $self->{response} = 'preview';
235 310
236 } elsif ($action eq 'Send Email') { 311 } elsif ($action eq 'Send Email') {
237 312 $self->{response} = 'send_email';
238 313
239 314 my @recipients = @{$self->{ra_send_to}};
240 315 $self->addmessage(CGI::div({class=>'ResultsWithError'},
316 "No recipients selected")) unless @recipients;
317 # get merge file
318 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
319 my $delimiter = ',';
320 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
321 unless (ref($rh_merge_data) ) {
322 warn "no merge data file";
323 $self->submission_error("Can't read merge file $merge_file. No message sent");
324 return;
325 } ;
326
327
328 foreach my $recipient (@recipients) {
329 #warn "FIXME sending email to $recipient";
330 my $ur = $self->{db}->getUser($recipient); #checked
331 die "record for user $recipient not found" unless $ur;
332 unless ($ur->email_address) {
333 $self->addmessage(CGI::div({class=>'ResultsWithError'},
334 "user $recipient does not have an email address -- skipping"));
335 next;
336 }
337 my ($msg, $preview_header);
338 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); };
339 warn "There were errors in processing user $ur, merge file $merge_file. $@" if $@;
340 my $mailer = Mail::Sender->new({
341 from => $from,
342 to => $ur->email_address,
343 smtp => $ce->{mail}->{smtpServer},
344 subject => $subject,
345 headers => "X-Remote-Host: ".$r->get_remote_host(),
346 });
347 unless (ref $mailer) {
348 warn "Failed to create a mailer for user $recipient: $Mail::Sender::Error";
349 next;
350 }
351 unless (ref $mailer->Open()) {
352 warn "Failed to open the mailer for user $recipient: $Mail::Sender::Error";
353 next;
354 }
355 my $MAIL = $mailer->GetHandle() or warn "Couldn't get handle";
356 print $MAIL $msg || warn "Couldn't print to $MAIL";
357 close $MAIL || warn "Couldn't close $MAIL";
358 #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject";
359
360 }
361
241 } else { 362 } else {
242 warn "Don't recognize button $action"; 363 warn "Didn't recognize button $action";
243 }
244
245 #if Save button was clicked
246 if (( $r->param('action') eq 'Save') && defined($r->param('body')) && defined($r->param('savefilename'))) {
247
248# my $temp_body = $body;
249# $temp_body =~ s/\r\n/\n/g;
250# $temp_body = "From: " . $from . "\n" .
251# "Reply-To: " . $replyTo . "\n" .
252# "Subject: " . $subject . "\n" .
253# "Message: \n" . $temp_body;
254#
255# saveProblem($temp_body, $savefilename);
256# $messageFileName = $savefilename;
257
258 #if Save As button was clicked
259 } elsif (( $r->param('action') eq 'Save as:') && defined($r->param('body')) && defined($r->param('savefilename'))) {
260
261# $messageFileName = $savefilename;
262#
263# if ($messageFileName =~ /^[~.]/ || $messageFileName =~ /\.\./) {
264# $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");
265# }
266#
267#
268# my $temp_body = $body;
269# $temp_body =~ s/\r\n/\n/g;
270# $temp_body = join("",
271# "From: $from \nReply-To: $replyTo)\n" ,
272# "Subject: $subject\n" ,
273# "Message: \n $temp_body");
274#
275# saveNewProblem($temp_body, $messageFileName);
276
277 #if Save As Default button was clicked
278 } elsif (( $r->param('action') eq 'save_as_default') && defined($r->param('body'))) {
279
280# my $temp_body;
281# $temp_body = $r->param('body');
282# $temp_body =~ s/\r\n/\n/g;
283#
284# #get default.msg and back it up in default.old.msg
285# open DEFAULT, "$emailDirectory/$default_msg_file";
286# $temp_body = <DEFAULT>;
287# close DEFAULT;
288#
289# if ( -e "$emailDirectory/$old_default_msg_file") {
290# # saveProblem($temp_body, $old_default_msg_file);
291# } else {
292# # saveNewProblem($temp_body, $old_default_msg_file);
293# }
294#
295# #save new default message as default.msg
296# $temp_body = $body;
297# $temp_body =~ s/\r\n/\n/g;
298# $temp_body = join("",
299# "From: $from \nReply-To: $replyTo)\n" ,
300# "Subject: $subject\n" ,
301# "Message: \n $temp_body");
302#
303# # saveProblem($temp_body, $default_msg_file);
304# $messageFileName = $default_msg_file;
305
306 #if Send Email button was clicked
307 } elsif ( $r->param('action') eq 'Send Email' ) {
308
309 my @studentID = ();
310
311 if ($r->param('To') eq 'classList' && defined($r->param('classList')) && $r->param('classList') ne 'None') {
312# my $classlist = $r->param('classList');
313# my $classListFile = "$templateDirectory$classlist";
314# my @classList = ();
315# #FIXME checkClasslistFile($Global::noOfFieldsInClasslist,$classListFile);
316# open(FILE, "$classListFile") || die "can't open $classListFile";
317# @classList=<FILE>;
318# close(FILE);
319#
320# foreach (@classList) { ## read through classlist and send e-mail
321# ## message to all active students
322# unless ($_ =~ /\S/) {next;} ## skip blank lines
323# chomp;
324# my @classListRecord=&getRecord($_);
325# my ($studentID, $lastName, $firstName, $status, $comment, $section, $recitation, $email_address, $login_name)
326# = @classListRecord;
327# unless (&dropStatus($status)) {
328# push (@studentID, $studentID);
329# $fn{$studentID} = $firstName;
330# $ln{$studentID} = $lastName;
331# $section{$studentID} = $section;
332# $recitation{$studentID} = $recitation;
333# $status{$studentID} = $status;
334# $email{$studentID} = $email_address;
335# $login{$studentID} = $login_name;
336# }
337# }
338 } elsif ($r->param('To') eq 'studentID' && defined($r->param('studentID'))) {
339 @studentID = $r->param('studentID');
340 my ($studentID, $login_name);
341#
342# foreach $studentID (@studentID) {
343# $login_name = $studentID_LoginName_Hash{$studentID};
344# &attachCLRecord($login_name);
345# $fn{$studentID} = CL_getStudentFirstName($login_name);
346# $ln{$studentID} = CL_getStudentLastName($login_name);
347# $section{$studentID} = CL_getClassSection($login_name);
348# $recitation{$studentID} = CL_getClassRecitation($login_name);
349# $status{$studentID} = CL_getStudentStatus($login_name);
350# $email{$studentID} = CL_getStudentEmailAddress($login_name);
351# $login{$studentID} = $login_name;
352# }
353
354 } elsif ($r->param('To') eq 'all_students') {
355 @studentID = ();
356 my ($studentID, $login_name, $status);
357
358# foreach $login_name (@availableStudents) {
359# &attachCLRecord($login_name);
360# $status = CL_getStudentStatus($login_name);
361# next if &dropStatus($status);
362# $studentID = CL_getStudentID($login_name);
363# push(@studentID,$studentID);
364#
365# $fn{$studentID} = CL_getStudentFirstName($login_name);
366# $ln{$studentID} = CL_getStudentLastName($login_name);
367# $section{$studentID} = CL_getClassSection($login_name);
368# $recitation{$studentID} = CL_getClassRecitation($login_name);
369# $status{$studentID} = CL_getStudentStatus($login_name);
370# $email{$studentID} = CL_getStudentEmailAddress($login_name);
371# $login{$studentID} = $login_name;
372# }
373 } else {
374 $self->submission_error('You didn\'t select any recipients. Make sure you select either all student in the course, individual students or a whole classlist.');
375 } 364 }
376
377 my $mergeFile = '';
378
379 #the radio button named 'merge' determines whether to take the selected mergefile
380 #or one that was typed in. A error message is given if select one and use the other
381 $mergeFile = $scoringDirectory . $r->param('mergeFiles')
382 if ($r->param('merge') eq 'mergeFiles' && defined($r->param('mergeFiles')) && $r->param('mergeFiles') ne 'None');
383
384 $mergeFile = $templateDirectory . $r->param('mergeFile')
385 if ($r->param('merge') eq 'mergeFile' && defined($r->param('mergeFile')) && $r->param('mergeFile') !~ m|/$|); #does not end in a /
386
387 if ($mergeFile =~ /^[~.]/ || $mergeFile =~ /\.\./) {
388 $self->submission_error("For security reasons, you cannot specify a merge file from a directory higher than the email directory. Please specify a different file or move the needed file to the email directory");
389 }
390 if ($r->param('body') =~ /(\$COL\[.*?\])/ && !(-e $mergeFile)) {
391 $self->submission_error("In order to use the \$COL[] you must specify a merge file. The file you specified does not exist. Also, make sure you selected the right checkbox.");
392 }
393
394
395 my %mergeAArray = ();
396# unless ($mergeFile eq '') {%mergeAArray = &delim2aa($mergeFile);}
397#
398
399#
400# foreach my $studentID (@studentID) {
401# @COL =();
402# $SID = $studentID;
403# $LN = defined $ln{$studentID} ? $ln{$studentID} :'';
404# $FN = defined $fn{$studentID} ? $fn{$studentID} :'';
405# $SECTION = defined $section{$studentID} ? $section{$studentID} :'';
406# $RECITATION = defined $recitation{$studentID} ? $recitation{$studentID} :'';
407# $EMAIL = defined $email{$studentID} ? $email{$studentID} :'';
408# $STATUS =defined $status{$studentID} ? $status{$studentID} :'';
409# $LOGIN = $login{$studentID};
410#
411# next if ($LOGIN =~ /^$practiceUser/); ## skip practice users
412#
413# if ($timeout_attempts >= $max_timeout_attempts) { ## have attemped to connect to smtp server
414# ## the max allowed times. Now just collect
415# ## data on emails not sent and exit
416# ++$emails_not_sent;
417# &log_error(\@exceeded_max_timeout,$FN,$LN,$EMAIL);
418# next;
419# }
420#
421# unless ((defined $mergeAArray{$studentID}) or ($mergeFile eq '')) {
422# if ($cgi->param('no_record')) {
423# ++$emails_not_sent;
424# &log_error(\@no_record,$FN,$LN,$EMAIL);
425# next;
426# }
427# }
428
429# my ($dbString, @dbArray);
430# if (defined $mergeAArray{$SID}) {
431# $dbString = $mergeAArray{$SID}; ## get sid record from merge file
432# @dbArray = &getRecord($dbString);
433# unshift(@dbArray,$SID);
434# unshift(@dbArray,""); ## note COL[1] is the first column
435# @COL= @dbArray; ## put merge fields in COL array
436# $endCol = @COL; ## \endCol-1 gives last field, etc
437# }
438# my $smtp;
439# if ($smtp = Net::SMTP->new($Global::smtpServer, Timeout => $timeout_sec)) {} else {
440# # &internal_error("Couldn't contact SMTP server.");
441# ++$emails_not_sent;
442# &log_error(\@timeout_problem,$FN,$LN,$EMAIL);
443# ++$timeout_attempts;
444# next;
445# }
446#
447# $smtp->mail($smtpSender);
448#
449# if ( $smtp->recipient($EMAIL)) { # this one's okay, keep going
450# if ( $smtp->data("To: $EMAIL\n" . output() ) ) {
451# ++$emails_sent;
452# } else {
453# ++$emails_not_sent;
454# &log_error(\@unknown_problem,$FN,$LN,$EMAIL);
455# next;
456# }
457# # &internal_error("Unknown problem sending message data to SMTP server.");
458# } else { # we have a problem with this address
459# $smtp->reset;
460# #&internal_error("SMTP server doesn't like this address: <$EMAIL>.");
461# ++$emails_not_sent;
462# &log_error(\@bad_email_addresses,$FN,$LN,$EMAIL);
463# }
464# $smtp->quit;
465# }
466# &success;
467 }
468
469 365
470 366
471 367
472} #end initialize 368} #end initialize
473 369
474sub fieldEditHTML {
475 my ($self, $fieldName, $value, $properties) = @_;
476 my $size = $properties->{size};
477 my $type = $properties->{type};
478 my $access = $properties->{access};
479 my $items = $properties->{items};
480 my $synonyms = $properties->{synonyms};
481
482
483 if ($access eq "readonly") {
484 return $value;
485 }
486 if ($type eq "number" or $type eq "text") {
487 return CGI::input({type=>"text", name=>$fieldName, value=>$value, size=>$size});
488 }
489 if ($type eq "enumerable") {
490 my $matched = undef; # Whether a synonym match has occurred
491 370
492 # Process synonyms for enumerable objects
493 foreach my $synonym (keys %$synonyms) {
494 if ($synonym ne "*" and $value =~ m/$synonym/) {
495 $value = $synonyms->{$synonym};
496 $matched = 1;
497 }
498 }
499 if (!$matched and exists $synonyms->{"*"}) {
500 $value = $synonyms->{"*"};
501 }
502 return CGI::popup_menu({
503 name => $fieldName,
504 values => [keys %$items],
505 default => $value,
506 labels => $items,
507 });
508 }
509}
510 371
511sub title {
512 my $self = shift;
513 return 'Send mail to ' .$self->{ce}->{courseName};
514}
515 372
516sub path { 373
374sub body {
517 my $self = shift; 375 my ($self) = @_;
518 my $args = $_[-1]; 376 my $r = $self->r;
377 my $urlpath = $r->urlpath;
378 my $setID = $urlpath->arg("setID");
379 my $response = (defined($self->{response}))? $self->{response} : '';
380 if ($response eq 'preview') {
381 $self->print_preview($setID);
382 } elsif (($response eq 'send_email')){
383 $self->{message} .= CGI::h3("Email sent to "). join(" ", @{$self->{ra_send_to}});
384 $self->print_form($setID);
385 } else {
386 $self->print_form($setID);
387 }
388
389}
390sub print_preview {
391 my ($self) = @_;
392 my $r = $self->r;
393 my $urlpath = $r->urlpath;
394 my $setID = $urlpath->arg("setID");
395
396 # get preview user
397 my $ur = $r->db->getUser($self->{preview_user}); #checked
398 die "record for preview user ".$self->{preview_user}. " not found." unless $ur;
519 399
520 my $ce = $self->{ce}; 400 # get merge file
521 my $root = $ce->{webworkURLs}->{root}; 401 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
522 my $courseName = $ce->{courseName}; 402 my $delimiter = ',';
523 return $self->pathMacro($args, 403 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
524 "Home" => "$root", 404
525 $courseName => "$root/$courseName", 405 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data);
526 'instructor' => "$root/$courseName/instructor", 406
527 "Send Mail to: $courseName" => '', 407 my $recipients = join(" ",@{$self->{ra_send_to} });
408 my $errorMessage = defined($self->{submitError}) ? CGI::h3($self->{submitError} ) : '' ;
409 $msg = join("",
410 $errorMessage,
411 $preview_header,
412 "To: " , $ur->email_address,"\n",
413 "From: " , $self->{from} , "\n" ,
414 "Reply-To: " , $self->{replyTo} , "\n" ,
415 "Subject: " , $self->{subject} , "\n" ,"\n" ,
416 $msg , "\n"
528 ); 417 );
529}
530 418
531sub body { 419 return join("", '<pre>',$msg,"\n","\n",
532 my ($self, $setID) = @_; 420 '</pre>',
533 my $r = $self->{r}; 421 CGI::p('Use browser back button to return from preview mode'),
534 my $authz = $self->{authz}; 422 CGI::h3('Emails to be sent to the following:'),
423 $recipients, "\n",
424
425 );
426
427}
428sub print_form {
429 my ($self) = @_;
430 my $r = $self->r;
431 my $urlpath = $r->urlpath;
432 my $authz = $r->authz;
433 my $db = $r->db;
434 my $ce = $r->ce;
435 my $courseName = $urlpath->arg("courseID");
436 my $setID = $urlpath->arg("setID");
535 my $user = $r->param('user'); 437 my $user = $r->param('user');
536 my $db = $self->{db}; 438
537 my $ce = $self->{ce};
538 my $root = $ce->{webworkURLs}->{root}; 439 my $root = $ce->{webworkURLs}->{root};
539 my $courseName = $ce->{courseName}; 440 my $sendMailPage = $urlpath->newFromModule($urlpath->module,courseID=>$courseName);
441 my $sendMailURL = $self->systemLink($sendMailPage, authen => 0);
540 442
541 return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); 443 return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools");
542 444
543 my $userTemplate = $db->newUser; 445 my $userTemplate = $db->newUser;
544 my $permissionLevelTemplate = $db->newPermissionLevel; 446 my $permissionLevelTemplate = $db->newPermissionLevel;
545 447
546 # This code will require changing if the permission and user tables ever have different keys. 448 # This code will require changing if the permission and user tables ever have different keys.
547 my @users = $db->listUsers; 449 my @users = @{ $self->{ra_users} };
450 my $ra_user_records = $self->{ra_user_records};
451 my %classlistLabels = ();# %$hr_classlistLabels;
452 foreach my $ur (@{ $ra_user_records }) {
453 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation;
454 }
548 455
549 # This table can be consulted when display-ready forms of field names are needed.
550# my %prettyFieldNames = map {$_ => $_} ($userTemplate->FIELDS(), $permissionLevelTemplate->FIELDS());
551# @prettyFieldNames{qw(
552# user_id
553# first_name
554# last_name
555# email_address
556# student_id
557# status
558# section
559# recitation
560# comment
561# permission
562# )} = (
563# "User ID",
564# "First Name",
565# "Last Name",
566# "E-mail",
567# "Student ID",
568# "Status",
569# "Section",
570# "Recitation",
571# "Comment",
572# "Perm. Level"
573# );
574 456
575# my %fieldProperties = (
576# user_id => {
577# type => "text",
578# size => 8,
579# access => "readonly",
580# },
581# first_name => {
582# type => "text",
583# size => 10,
584# access => "readwrite",
585# },
586# last_name => {
587# type => "text",
588# size => 10,
589# access => "readwrite",
590# },
591# email_address => {
592# type => "text",
593# size => 20,
594# access => "readwrite",
595# },
596# student_id => {
597# type => "text",
598# size => 11,
599# access => "readwrite",
600# },
601# status => {
602# type => "enumerable",
603# size => 4,
604# access => "readwrite",
605# items => {
606# "C" => "Enrolled",
607# "D" => "Drop",
608# "A" => "Audit",
609# },
610# synonyms => {
611# qr/^[ce]/i => "C",
612# qr/^[dw]/i => "D",
613# qr/^a/i => "A",
614# "*" => "C",
615# }
616# },
617# section => {
618# type => "text",
619# size => 4,
620# access => "readwrite",
621# },
622# recitation => {
623# type => "text",
624# size => 4,
625# access => "readwrite",
626# },
627# comment => {
628# type => "text",
629# size => 20,
630# access => "readwrite",
631# },
632# permission => {
633# type => "number",
634# size => 2,
635# access => "readwrite",
636# }
637# );
638
639
640
641############################################################################################################## 457##############################################################################################################
642 458
643# my ($ar_sortedNames, $hr_classlistLabels) = getClasslistFilesAndLabels($course); 459
644# my @sortedNames = @$ar_sortedNames;
645 my %classlistLabels = ();# %$hr_classlistLabels;
646 unshift(@users, "Yourself");
647 $classlistLabels{None} = 'Yourself';
648 my $from = $self->{from}; 460 my $from = $self->{from};
649 my $subject = $self->{subject}; 461 my $subject = $self->{subject};
650 my $replyTo = $self->{replyTo}; 462 my $replyTo = $self->{replyTo};
651 my $columns = $self->{columns}; 463 my $columns = $self->{columns};
652 my $rows = $self->{rows}; 464 my $rows = $self->{rows};
… …
654 my $input_file = $self->{input_file}; 466 my $input_file = $self->{input_file};
655 my $output_file = $self->{output_file}; 467 my $output_file = $self->{output_file};
656 my @sorted_messages = $self->get_message_file_names; 468 my @sorted_messages = $self->get_message_file_names;
657 my @sorted_merge_files = $self->get_merge_file_names; 469 my @sorted_merge_files = $self->get_merge_file_names;
658 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 470 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
659 471 my $delimiter = ',';
660 472 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
473 my @merge_keys = keys %$rh_merge_data;
474 my $preview_user = $self->{preview_user};
475 my $preview_record = $db->getUser($preview_user); # checked
476 die "record for preview user ".$self->{preview_user}. " not found." unless $preview_record;
477
478
479#############################################################################################
480
661 print CGI::start_form({method=>"post", action=>$r->uri()}); 481 print CGI::start_form({method=>"post", action=>$sendMailURL});
662#create list of sudents 482 print $self->hidden_authen_fields();
663# show professors's name and email address 483#############################################################################################
664# show replyTo field and From field 484# begin upper table
485#############################################################################################
486
665 print CGI::start_table({-border=>'2', -cellpadding=>'4'}); 487 print CGI::start_table({-border=>'2', -cellpadding=>'4'});
666 print CGI::Tr({-align=>'left',-valign=>'VCENTER'}, 488 print CGI::Tr({-align=>'left',-valign=>'top'},
489#############################################################################################
490# first column
491#############################################################################################
492
667 CGI::td("Message file: $input_file","\n",CGI::br(), 493 CGI::td(CGI::strong("Message file: $input_file"),"\n",CGI::br(),
668 CGI::submit(-name=>'action', -value=>'Open'), '&nbsp;&nbsp;&nbsp;&nbsp;',"\n", 494 CGI::submit(-name=>'action', -value=>'Open'), '&nbsp;&nbsp;&nbsp;&nbsp;',"\n",
669 #CGI::textfield(-name=>'openfilename', -size => 20, -value=> "$input_file", -override=>1), "\n",CGI::br(),
670 CGI::popup_menu(-name=>'openfilename', 495 CGI::popup_menu(-name=>'openfilename',
671 -values=>\@sorted_messages, 496 -values=>\@sorted_messages,
672 -default=>$input_file 497 -default=>$input_file
673 ), "\n",CGI::br(), 498 ), "\n",CGI::br(),
674 499
675 "Save file to: $output_file","\n",CGI::br(), 500 "Save file to: $output_file","\n",CGI::br(),
676 "\n", 'From:','&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1), 501 "\n", 'From:','&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1),
677 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1), 502 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1),
678 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>40, -override=>1), 503 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>30, -override=>1),
679 ), 504 ),
680 CGI::td({-align=>'left'}, 505#############################################################################################
506# second column
507#############################################################################################
508 CGI::td({-align=>'left',style=>'font-size:smaller'},
509
510 CGI::strong("Send to:"),
681 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], 511 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'],
682 -labels=>{all_students=>'All active students',studentID => 'Select recipients'}, 512 -labels=>{all_students=>'All',studentID => 'Selected'},
683 -default=>'studentID', 513 -default=>'studentID',
684 -linebreak=>1), 514 -linebreak=>0
685 CGI::br(), 515 ), CGI::br(),CGI::br(),
516
517 CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),,
518 CGI::radio_group(-name=>'sort_by', -values=>['id','alphabetical','section','recitation'],
519 -labels=>{id=>'Login',alphabetical=>'Alph.',section => 'Sec.',recitation=>'Rec.'},
520 -default=>defined($r->param("sort_by")) ? $r->param("sort_by") : 'id',
521 -linebreak=>0
522 ),
523
524 CGI::br(),CGI::br(),
686 CGI::popup_menu(-name=>'classList', 525 CGI::popup_menu(-name=>'classList',
687 -values=>\@users, 526 -values=>\@users,
688 -labels=>\%classlistLabels, 527 -labels=>\%classlistLabels,
689 -size => 10, 528 -size => 10,
690 -multiple => 1, 529 -multiple => 1,
691 -default=>'Yourself' 530 -default=>$user
692 ), 531 ),
693 532 ),
694 533
695 ), 534
535#############################################################################################
536# third column
537#############################################################################################
696 CGI::td({align=>'left'}, 538 CGI::td({align=>'left'},
539 "<b>Merge file:</b> $merge_file", CGI::br(),
697 CGI::submit(-name=>'action', -value=>'Choose merge file'), 540 CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(),
698 CGI::popup_menu(-name=>'merge_file', 541 CGI::popup_menu(-name=>'merge_file',
699 -values=>\@sorted_merge_files, 542 -values=>\@sorted_merge_files,
700 -default=>$merge_file, 543 -default=>$merge_file,
701 ), "\n",CGI::br(), 544 ), "\n",CGI::hr(),CGI::br(),
702 CGI::submit(-name=>'preview', -value=>'preview',-label=>'Preview')," email to ", 545 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview')," email to ",
703 CGI::popup_menu(-name=>'classList', 546 CGI::popup_menu(-name=>'preview_user',
704 -values=>\@users, 547 -values=>\@users,
705 -labels=>\%classlistLabels, 548 #-labels=>\%classlistLabels,
706 -default=>'Yourself' 549 -default=>$preview_user,
707 ), 550 ),
708 CGI::br(),CGI::br(), 551 CGI::hr(),
709 CGI::submit(-name=>'action', -value=>'resize', -label=>'Resize message window'),CGI::br(), 552 CGI::submit(-name=>'action', -value=>'resize', -label=>$REFRESH_RESIZE_BUTTON),CGI::br(),
710 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), 553 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows),
711 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), 554 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns),
712 CGI::br(),CGI::br(), 555 CGI::br(),CGI::br(),
713 #show available macros 556 #show available macros
714 CGI::popup_menu( 557 CGI::popup_menu(
… …
716 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'], 559 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'],
717 -labels=>{''=>'list of insertable macros', 560 -labels=>{''=>'list of insertable macros',
718 '$SID'=>'$SID - Student ID', 561 '$SID'=>'$SID - Student ID',
719 '$FN'=>'$FN - First name', 562 '$FN'=>'$FN - First name',
720 '$LN'=>'$LN - Last name', 563 '$LN'=>'$LN - Last name',
721 '$SECTION'=>'$SECTION - Student\'s Section', 564 '$SECTION'=>'$SECTION',
722 '$RECITATION'=>'$RECITATION', 565 '$RECITATION'=>'$RECITATION',
723 '$STATUS'=>'$STATUS - C, Audit, Drop, etc.', 566 '$STATUS'=>'$STATUS - C, Audit, Drop, etc.',
724 '$EMAIL'=>'$EMAIL - Email address', 567 '$EMAIL'=>'$EMAIL - Email address',
725 '$LOGIN'=>'$LOGIN - Login', 568 '$LOGIN'=>'$LOGIN - Login',
726 '$COL[3]'=>'$COL[3] - 3rd column in merge file', 569 '$COL[3]'=>'$COL[3] - 3rd col',
727 '$COL[-1]'=>'$COL[-1] - Last column' 570 '$COL[-1]'=>'$COL[-1] - Last column'
728 } 571 }
729 ), "\n", 572 ), "\n",
730 ), 573 ),
731 574
732 ); # end Tr 575 ); # end Tr
733 print CGI::end_table(); 576 print CGI::end_table();
577#############################################################################################
578# end upper table
579#############################################################################################
580
581# show merge file
582# print "<pre>",(map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} 0..8),"</pre>";
583# print CGI::popup_menu(
584# -name=>'dummyName2',
585# -values=>\@merge_keys,
586# -labels=>$rh_merge_data,
587# -multiple=>1,
588# -size =>2,
589#
590# ), "\n",CGI::br();
591# warn "merge keys ", join( " ",@merge_keys);
592#############################################################################################
593# merge file fragment and message text area field
594#############################################################################################
595 my @tmp2;
596 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; # checked
597 if ($@ and $merge_file ne 'None') {
598 print "No merge data for $preview_user in merge file: &lt;$merge_file&gt;",CGI::br();
599 } else {
600 print CGI::pre("",data_format(0..($#tmp2)),"<br>", data_format2(@tmp2));
601 }
734#create a textbox with the subject and a textarea with the message 602#create a textbox with the subject and a textarea with the message
735
736#print actual body of message 603#print actual body of message
737 604
738 print "\n", CGI::p( $self->{message}) if defined($self->{message}); 605 print "\n", CGI::p( $self->{message}) if defined($self->{message});
739 print "\n", CGI::p( CGI::textarea(-name=>'body', -default=>$text, -rows=>$rows, -columns=>$columns, -override=>1)); 606 print "\n", CGI::p( CGI::textarea(-name=>'body', -default=>$text, -rows=>$rows, -columns=>$columns, -override=>1));
740 607
741#create all necessary action buttons 608#############################################################################################
609# action button table
610#############################################################################################
742 print CGI::table( { -border=>2,-cellpadding=>4}, 611 print CGI::table( { -border=>2,-cellpadding=>4},
743 CGI::Tr( 612 CGI::Tr(
744 CGI::td( CGI::submit(-name=>'action', -value=>'Send Email') ), "\n", 613 CGI::td( CGI::submit(-name=>'action', -value=>'Send Email') ), "\n",
745 CGI::td(CGI::submit(-name=>'action', -value=>'Save')," to $output_file"), " \n", 614 CGI::td(CGI::submit(-name=>'action', -value=>'Save')," to $output_file"), " \n",
746 CGI::td(CGI::submit(-name=>'action', -value=>'Save as:'), 615 CGI::td(CGI::submit(-name=>'action', -value=>'Save as:'),
… …
750 ) 619 )
751 ); 620 );
752 621
753############################################################################################################## 622##############################################################################################################
754 623
755 print $self->hidden_authen_fields();
756# print CGI::submit({name=>"save_classlist", value=>"Save Changes to Users"});
757 print CGI::end_form(); 624 print CGI::end_form();
758 return ""; 625 return "";
759} 626}
760 627
761############################################################################## 628##############################################################################
762# Utility methods 629# Utility methods
763############################################################################## 630##############################################################################
764sub submission_error { 631sub submission_error {
765 my $self = shift; 632 my $self = shift;
766 my $msg = join( " ", @_); 633 my $msg = join( " ", @_);
767 $self->{submitError}= $msg; #CGI::b(HTML::Entities::encode($msg)); 634 $self->{submitError} .= CGI::br().$msg;
768# qq{Please hit the &quot;<B>Back</B>&quot; button on your browser to
769# try again, or notify your web master
770# if you believe this message is in error.
771# };
772 return; 635 return;
773} 636}
774 637
775sub saveProblem { 638sub saveProblem {
776 my $self = shift; 639 my $self = shift;
… …
816 $subject = "FIXME default subject"; 679 $subject = "FIXME default subject";
817 } 680 }
818 return ($from, $replyTo, $subject, \$text); 681 return ($from, $replyTo, $subject, \$text);
819} 682}
820 683
684
821sub get_message_file_names { 685sub get_message_file_names {
822 my $self = shift; 686 my $self = shift;
823 my $emailDirectory = $self->{ce}->{courseDirs}->{email}; 687 return $self->read_dir($self->{ce}->{courseDirs}->{email}, '\\.msg$');
824 #get all message files and create a list
825 local(*EMAILDIR);
826 opendir( EMAILDIR, $emailDirectory )|| die "Can't access directory $emailDirectory. Please check that webserver has permission to read this directory.";
827 my @messageFiles = grep /\.msg$/, readdir EMAILDIR; #all message files
828 closedir EMAILDIR;
829
830 return sort @messageFiles;
831} 688}
832sub get_merge_file_names { 689sub get_merge_file_names {
690 my $self = shift;
691 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed.
692}
693
694
695sub getRecord {
696 my $self = shift;
697 my $line = shift;
698 my $delimiter = shift;
699 $delimiter = ',' unless defined($delimiter);
700
701 # Takes a delimited line as a parameter and returns an
702 # array. Note that all white space is removed. If the
703 # last field is empty, the last element of the returned
704 # array is also empty (unlike what the perl split command
705 # would return). E.G. @lineArray=&getRecord(\$delimitedLine).
706
707 my(@lineArray);
708 $line.="${delimiter}___"; # add final field which must be non-empty
709 @lineArray = split(/\s*${delimiter}\s*/,$line); # split line into fields
710 $lineArray[0] =~s/^\s*//; # remove white space from first element
711 pop @lineArray; # remove the last artificial field
712 @lineArray;
713}
714
715sub process_message {
833 my $self = shift; 716 my $self = shift;
834 my $scoringDirectory = $self->{ce}->{courseDirs}->{scoring}; 717 my $ur = shift;
835 #get all message files and create a list 718 my $rh_merge_data = shift;
836 local(*SCORINGDIR); 719 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }:
837 opendir( SCORINGDIR, $scoringDirectory )|| die "Can't access directory $scoringDirectory.", 720 'FIXME no text was produced by initialization!!';
838 "Please check that webserver has permission to read this directory."; 721 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
839 my @mergeFiles = grep( /\.csv$/, readdir SCORINGDIR); #all message files 722 #user macros that can be used in the email message
840 closedir SCORINGDIR; 723 my $SID = $ur->student_id;
841 @mergeFiles = sort @mergeFiles; 724 my $FN = $ur->first_name;
842# warn "FIXME scoring directory $scoringDirectory merge Files", join(" ", @mergeFiles); 725 my $LN = $ur->last_name;
843 unshift(@mergeFiles, 'None'); 726 my $SECTION = $ur->section;
844 return @mergeFiles; 727 my $RECITATION = $ur->recitation;
728 my $STATUS = $ur->status;
729 my $EMAIL = $ur->email_address;
730 my $LOGIN = $ur->user_id;
731
732 # get record from merge file
733 # FIXME this is inefficient. The info should be cached
734 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : ();
735 if ($merge_file ne 'None' && not defined($rh_merge_data->{$SID}) ) {
736 $self->submission_error( "No merge data for $SID $FN $LN $LOGIN");
737 }
738
739 my $endCol = @COL;
740 # for safety, only evaluate special variables
741 my $msg = $text;
742 $msg =~ s/(\$SID)/eval($1)/ge;
743 $msg =~ s/(\$LN)/eval($1)/ge;
744 $msg =~ s/(\$FN)/eval($1)/ge;
745 $msg =~ s/(\$STATUS)/eval($1)/ge;
746 $msg =~ s/(\$SECTION)/eval($1)/ge;
747 $msg =~ s/(\$RECITATION)/eval($1)/ge;
748 $msg =~ s/(\$EMAIL)/eval($1)/ge;
749 $msg =~ s/(\$LOGIN)/eval($1)/ge;
750 $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g;
751 $msg =~ s/(\$COL\[.*?\])/eval($1)/ge;
752
753 $msg =~ s/\r//g;
754
755 my $preview_header = CGI::pre("",data_format(0..($#COL)),"<br>", data_format2(@COL)).
756 CGI::h3( "This sample mail would be sent to $EMAIL");
757
758
759 return $msg, $preview_header;
845} 760}
761
762
763# Ê sub data_format {
764#
765# Ê Ê Ê Ê Êmap {$_ =~s/\s/\./g;$_} Ê Ê map {sprintf('%-8.8s',$_);} Ê@_;
766 sub data_format {
767 map {"COL[$_]".'&nbsp;'x(3-length($_));} @_; # problems if $_ has length bigger than 4
768 }
769 sub data_format2 {
770 map {$_ =~s/\s/&nbsp;/g;$_} map {sprintf('%-8.8s',$_);} @_;
771 }
8461; 7721;
Legend:
Removed from v.1371  
changed lines
  Added in v.2035
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9