[system] / branches / rel-2-3-dev / webwork-modperl / lib / WeBWorK / ContentGenerator / Instructor / SendMail.pm Repository:
ViewVC logotype

Diff of /branches/rel-2-3-dev/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm

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

Revision 2049 Revision 3827
1################################################################################ 1################################################################################
2# WeBWorK Online Homework Delivery System 2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm,v 1.26 2004/05/07 18:49:40 sh002i Exp $ 4# $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm,v 1.44 2005/11/18 15:49:31 apizer Exp $
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 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 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 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. 9# version, or (b) the "Artistic License" which comes with this package.
… …
26use strict; 26use strict;
27use warnings; 27use warnings;
28use CGI qw(); 28use CGI qw();
29#use HTML::Entities; 29#use HTML::Entities;
30use Mail::Sender; 30use Mail::Sender;
31use Text::Wrap qw(wrap);
32use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/;
33use WeBWorK::Utils::FilterRecords qw/filterRecords/;
31 34
32my $REFRESH_RESIZE_BUTTON = "Reorder, Resize and Update"; # handle submit value idiocy 35#my $REFRESH_RESIZE_BUTTON = "Set preview to: "; # handle submit value idiocy
36my $UPDATE_SETTINGS_BUTTON = "Update settings and refresh page"; # handle submit value idiocy
33sub initialize { 37sub initialize {
34 my ($self) = @_; 38 my ($self) = @_;
35 my $r = $self->r; 39 my $r = $self->r;
36 my $db = $r->db; 40 my $db = $r->db;
37 my $ce = $r->ce; 41 my $ce = $r->ce;
38 my $authz = $r->authz; 42 my $authz = $r->authz;
39 my $user = $r->param('user'); 43 my $user = $r->param('user');
40 44
45 my @selected_filters;
46 if (defined ($r->param('classList!filter'))){ @selected_filters = $r->param('classList!filter');}
47 else {@selected_filters = ("all");}
48
49
50 # Check permissions
51 return unless $authz->hasPermissions($user, "access_instructor_tools");
41 unless ($authz->hasPermissions($user, "send_mail")) { 52 return unless $authz->hasPermissions($user, "send_mail");
42 $self->{submitError} = "You are not authorized to send mail to students."; 53
43 return;
44 }
45############################################################################################# 54#############################################################################################
46# gather directory data 55# gather directory data
47############################################################################################# 56#############################################################################################
48 my $emailDirectory = $ce->{courseDirs}->{email}; 57 my $emailDirectory = $ce->{courseDirs}->{email};
49 my $scoringDirectory = $ce->{courseDirs}->{scoring}; 58 my $scoringDirectory = $ce->{courseDirs}->{scoring};
50 my $templateDirectory = $ce->{courseDirs}->{templates}; 59 my $templateDirectory = $ce->{courseDirs}->{templates};
51 60
52 my $action = $r->param('action'); 61 my $action = $r->param('action') ;
53 my $openfilename = $r->param('openfilename'); 62 my $openfilename = $r->param('openfilename');
54 my $savefilename = $r->param('savefilename'); 63 my $savefilename = $r->param('savefilename');
55 64
56 65
57 #FIXME get these values from global course environment (see subroutines as well) 66 #FIXME get these values from global course environment (see subroutines as well)
58 my $default_msg_file = 'default.msg'; 67 my $default_msg_file = 'default.msg';
59 my $old_default_msg_file = 'old_default.msg'; 68 my $old_default_msg_file = 'old_default.msg';
60 69
61 70
71 # get user record
72 my $ur = $self->{db}->getUser($user);
73
62 # store data 74 # store data
63 $self->{defaultFrom} = 'FIXME from'; 75 $self->{defaultFrom} = $ur->email_address . " (".$ur->first_name." ".$ur->last_name.")";
64 $self->{defaultReply} = 'FIXME reply'; 76 $self->{defaultReply} = $ur->email_address;
77 $self->{defaultSubject} = $self->r->urlpath->arg("courseID") . " notice";
78
65 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows}; 79 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows};
66 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns}; 80 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns};
67 $self->{default_msg_file} = $default_msg_file; 81 $self->{default_msg_file} = $default_msg_file;
68 $self->{old_default_msg_file} = $old_default_msg_file; 82 $self->{old_default_msg_file} = $old_default_msg_file;
69 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None'; 83 $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; 84 #$self->{preview_user} = (defined($r->param('preview_user'))) ? $r->param('preview_user') : $user;
71 85 # an expermiment -- share the scrolling list for preivew and sendTo actions.
86 my @classList = (defined($r->param('classList'))) ? $r->param('classList') : ($user);
87 $self->{preview_user} = $classList[0] || $user;
72 88
73############################################################################################# 89#############################################################################################
74# gather database data 90# gather database data
75############################################################################################# 91#############################################################################################
76 # FIXME this might be better done in body? We don't always need all of this data. or do we? 92 # 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; 93 my @users = $db->listUsers;
94 my @Users = $db->getUsers(@users);
78 my @user_records = (); 95 my @user_records = ();
96
97## Mark's code to prefilter userlist
98
99
100 my (@viewable_sections,@viewable_recitations);
101
102 if (defined @{$ce->{viewable_sections}->{$user}})
103 {@viewable_sections = @{$ce->{viewable_sections}->{$user}};}
104 if (defined @{$ce->{viewable_recitations}->{$user}})
105 {@viewable_recitations = @{$ce->{viewable_recitations}->{$user}};}
106
107 if (@viewable_sections or @viewable_recitations){
108 foreach my $student (@Users){
109 my $keep = 0;
110 foreach my $sec (@viewable_sections){
111 if ($student->section() eq $sec){$keep = 1;}
112 }
113 foreach my $rec (@viewable_recitations){
114 if ($student->recitation() eq $rec){$keep = 1;}
115 }
116 if ($keep) {push @user_records, $student;}
117 }
118 }
119 else {@user_records = @Users;}
120
121## End Mark's code
122
79 foreach my $userName (@users) { 123# foreach my $userName (@users) {
80 my $userRecord = $db->getUser($userName); # checked 124# my $userRecord = $db->getUser($userName); # checked
81 die "record for user $userName not found" unless $userRecord; 125# die "record for user $userName not found" unless $userRecord;
82 push(@user_records, $userRecord); 126# push(@user_records, $userRecord);
83 } 127# }
84 ########################### 128 ###########################
85 # Sort the users for presentation in the select list 129 # Sort the users for presentation in the select list
86 ########################### 130 ###########################
87 if (defined $r->param("sort_by") ) { 131# if (defined $r->param("sort_by") ) {
88 my $sort_method = $r->param("sort_by"); 132# my $sort_method = $r->param("sort_by");
89 if ($sort_method eq 'section') { 133# 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; 134# @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') { 135# } 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; 136# @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') { 137# } elsif ($sort_method eq 'alphabetical') {
94 @user_records = sort { (lc($a->last_name) cmp lc($b->last_name)) } @user_records; 138# @user_records = sort { (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
95 } elsif ($sort_method eq 'id' ) { 139# } elsif ($sort_method eq 'id' ) {
96 @user_records = sort { $a->user_id cmp $b->user_id } @user_records; 140# @user_records = sort { $a->user_id cmp $b->user_id } @user_records;
97 } 141# }
98 } else { 142# } else {
99 @user_records = sort { $a->user_id cmp $b->user_id } @user_records; 143# @user_records = sort { $a->user_id cmp $b->user_id } @user_records;
100 } 144# }
101 145
102 146
103 # replace the user names by a sorted version. 147 # replace the user names by a sorted version.
104 @users = map {$_->user_id} @user_records; 148 @users = map {$_->user_id} @user_records;
105 # store data 149 # store data
… …
111############################################################################################# 155#############################################################################################
112 my @send_to = (); 156 my @send_to = ();
113 #FIXME this (radio) is a lousy name 157 #FIXME this (radio) is a lousy name
114 my $recipients = $r->param('radio'); 158 my $recipients = $r->param('radio');
115 if (defined($recipients) and $recipients eq 'all_students') { #only active students #FIXME status check?? 159 if (defined($recipients) and $recipients eq 'all_students') { #only active students #FIXME status check??
160
161## Add code so that only people who pass the current filters are added to our list of recipients.
162# @user_records = filterRecords({filter=\@selected_filters},@user_records);
163# I wasn't able to make this work
164# I edited the selection button to make that clear.
165#
166
116 foreach my $ur (@user_records) { 167 foreach my $ur (@user_records) {
117 push(@send_to,$ur->user_id) if $ur->status eq 'C' and not($ur->user_id =~ /practice/); 168 push(@send_to,$ur->user_id)
169 if $ce->status_abbrev_has_behavior($ur->status, "include_in_email")
170 and not $ur->user_id =~ /practice/;
118 } 171 }
119 } elsif (defined($recipients) and $recipients eq 'studentID' ) { 172 } elsif (defined($recipients) and $recipients eq 'studentID' ) {
120 @send_to = $r->param('classList'); 173 @send_to = $r->param('classList');
121 } else { 174 } else {
122 # no recipients have been defined -- probably the first time on the page 175 # no recipients have been defined -- probably the first time on the page
… …
131 if ( defined($openfilename) ) { 184 if ( defined($openfilename) ) {
132 if ( -e "${emailDirectory}/$openfilename") { 185 if ( -e "${emailDirectory}/$openfilename") {
133 if ( -R "${emailDirectory}/$openfilename") { 186 if ( -R "${emailDirectory}/$openfilename") {
134 $input_file = $openfilename; 187 $input_file = $openfilename;
135 } else { 188 } else {
136 warn join("", 189 $self->addbadmessage(CGI::p(join("",
137 "The file ${emailDirectory}/$openfilename is not readable by the webserver.",CGI::br(), 190 "The file ${emailDirectory}/$openfilename is not readable by the webserver.",CGI::br(),
138 "Check that it's permissions are set correctly.", 191 "Check that it's permissions are set correctly.",
139 ); 192 )));
140 } 193 }
141 } else { 194 } else {
142 $input_file = $default_msg_file; 195 $input_file = $default_msg_file;
143 warn join("", 196 $self->addbadmessage(CGI::p(join("",
144 "The file ${emailDirectory}/$openfilename cannot be found.",CGI::br(), 197 "The file ${emailDirectory}/$openfilename cannot be found.",CGI::br(),
145 "Check whether it exists and whether the directory $emailDirectory can be read by the webserver.",CGI::br(), 198 "Check whether it exists and whether the directory $emailDirectory can be read by the webserver.",CGI::br(),
146 "Using contents of the default message $default_msg_file instead.", 199 "Using contents of the default message $default_msg_file instead.",
147 ); 200 )));
148 } 201 }
149 } else { 202 } else {
150 $input_file = $default_msg_file; 203 $input_file = $default_msg_file;
151 } 204 }
152 $self->{input_file} =$input_file; 205 $self->{input_file} =$input_file;
… …
155# Determine the file name to save message into 208# Determine the file name to save message into
156################################################################# 209#################################################################
157 my $output_file = 'FIXME no output file specified'; 210 my $output_file = 'FIXME no output file specified';
158 if (defined($action) and $action eq 'Save as Default') { 211 if (defined($action) and $action eq 'Save as Default') {
159 $output_file = $default_msg_file; 212 $output_file = $default_msg_file;
160 } elsif ( defined($action) and ($action =~/save/i) and defined($savefilename) and $savefilename ){ 213 } elsif ( defined($action) and ($action =~/save/i)) {
214 if (defined($savefilename) and $savefilename ) {
161 $output_file = $savefilename; 215 $output_file = $savefilename;
216 } else {
217 $self->addbadmessage(CGI::p("No filename was specified for saving! The message was not saved."));
218 }
162 } elsif ( defined($input_file) ) { 219 } elsif ( defined($input_file) ) {
163 $output_file = $input_file; 220 $output_file = $input_file;
164 } 221 }
165 222
166 ################################################################# 223 #################################################################
167 # Sanity check on save file name 224 # Sanity check on save file name
168 ################################################################# 225 #################################################################
169 226
170 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) { 227 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) {
171 $self->submission_error("For security reasons, you cannot specify a message file from a directory", 228 $self->addbadmessage(CGI::p("For security reasons, you cannot specify a message file from a directory",
172 "higher than the email directory (you can't use ../blah/blah for example). ", 229 "higher than the email directory (you can't use ../blah/blah for example). ",
173 "Please specify a different file or move the needed file to the email directory", 230 "Please specify a different file or move the needed file to the email directory",));
174 );
175 } 231 }
176 unless ($output_file =~ m|\.msg$| ) { 232 unless ($output_file =~ m|\.msg$| ) {
177 $self->submission_error("Invalid file name.", 233 $self->addbadmessage(CGI::p("Invalid file name.",
178 "The file name \"$output_file\" does not have a \".msg\" extension", 234 "The file name \"$output_file\" does not have a \".msg\" extension",
179 "All email file names must end in the extension \".msg\"", 235 "All email file names must end in the extension \".msg\"",
180 "choose a file name with a \".msg\" extension.", 236 "choose a file name with a \".msg\" extension.",
181 "The message was not saved.", 237 "The message was not saved.",));
182 );
183 } 238 }
239
184 $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing. 240 $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing.
185 # FIXME $output_file can be blank if there was no savefilename 241
186 242
187############################################################################################# 243#############################################################################################
188# Determine input source 244# Determine input source
189############################################################################################# 245#############################################################################################
246 #warn "Action = $action";
247 my $input_source;
248 if ($action){
190 my $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file'; 249 $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file';}
250 else { $input_source = ( defined($r->param('body')) ) ? 'form' : 'file';}
191 251
192############################################################################################# 252#############################################################################################
193# Get inputs 253# Get inputs
194############################################################################################# 254#############################################################################################
195 my($from, $replyTo, $r_text, $subject); 255 my($from, $replyTo, $r_text, $subject);
… …
203 # bail if there is no message body 263 # bail if there is no message body
204 264
205 $from = $r->param('from'); 265 $from = $r->param('from');
206 $replyTo = $r->param('replyTo'); 266 $replyTo = $r->param('replyTo');
207 $subject = $r->param('subject'); 267 $subject = $r->param('subject');
208 my $body = $r->param('body'); 268 my $body = $r->param('body');
209 # Sanity check: body must contain non-white space 269 # Sanity check: body must contain non-white space
210 $self->submission_error('You didn\'t enter any message.') unless ($r->param('body') =~ /\S/); 270 $self->addbadmessage(CGI::p('You didn\'t enter any message.')) unless ($r->param('body') =~ /\S/);
211 $r_text = \$body; 271 $r_text = \$body;
212 272
213 } 273 }
214 # store data 274 # store data
215 $self->{from} = $from; 275 $self->{from} = $from;
… …
247############################################################################################# 307#############################################################################################
248 my $to = $r->param('To'); 308 my $to = $r->param('To');
249 my $script_action = ''; 309 my $script_action = '';
250 310
251 311
252 if(not defined($action) or $action eq 'Open' or $action eq $REFRESH_RESIZE_BUTTON or $action eq 'Sort by' 312 if(not defined($action) or $action eq 'Open'
253 or $action eq 'Set merge file to:' ){ 313 or $action eq $UPDATE_SETTINGS_BUTTON ){
254 314
255 return ''; 315 return '';
256 } 316 }
257 317
258 318
… …
281# warn "FIXME from $from | subject $subject |reply $replyTo|msg $temp_body"; 341# warn "FIXME from $from | subject $subject |reply $replyTo|msg $temp_body";
282 ################################################################# 342 #################################################################
283 # overwrite protection 343 # overwrite protection
284 ################################################################# 344 #################################################################
285 if ($action eq 'Save as:' and -e "$emailDirectory/$output_file") { 345 if ($action eq 'Save as:' and -e "$emailDirectory/$output_file") {
286 $self->submission_error("The file $emailDirectory/$output_file already exists and cannot be overwritten", 346 $self->addbadmessage(CGI::p("The file $emailDirectory/$output_file already exists and cannot be overwritten",
287 "The message was not saved"); 347 "The message was not saved"));
288 return; 348 return;
289 } 349 }
290 350
291 ################################################################# 351 #################################################################
292 # Back up existing file? 352 # Back up existing file?
293 ################################################################# 353 #################################################################
294 if ($action eq 'Save as Default' and -e "$emailDirectory/$default_msg_file") { 354 if ($action eq 'Save as Default' and -e "$emailDirectory/$default_msg_file") {
295 rename("$emailDirectory/$default_msg_file","$emailDirectory/$old_default_msg_file") or 355 rename("$emailDirectory/$default_msg_file","$emailDirectory/$old_default_msg_file") or
296 die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ", 356 die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ",
297 "Check permissions for webserver on directory $emailDirectory. $!"; 357 "Check permissions for webserver on directory $emailDirectory. $!";
298 $self->{message} .= "Backup file <code>$emailDirectory/$old_default_msg_file</code> created.".CGI::br(); 358 $self->addgoodmessage(CGI::p("Backup file <code>$emailDirectory/$old_default_msg_file</code> created." . CGI::br()));
299 } 359 }
300 ################################################################# 360 #################################################################
301 # Save the message 361 # Save the message
302 ################################################################# 362 #################################################################
303 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ); 363 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ) unless ($output_file =~ /^[~.]/ || $output_file =~ /\.\./ || not $output_file =~ m|\.msg$|);
304 unless ( $self->{submitError} or not -w "${emailDirectory}/$output_file" ) { # if there are no errors report success 364 unless ( $self->{submit_message} or not -w "${emailDirectory}/$output_file" ) { # if there are no errors report success
305 $self->{message} .= "Message saved to file <code>${emailDirectory}/$output_file</code>."; 365 $self->addgoodmessage(CGI::p("Message saved to file <code>${emailDirectory}/$output_file</code>."));
306 } 366 }
307 367
308 } elsif ($action eq 'Preview') { 368 } elsif ($action eq 'Preview message') {
309 $self->{response} = 'preview'; 369 $self->{response} = 'preview';
310 370
311 } elsif ($action eq 'Send Email') { 371 } elsif ($action eq 'Send Email') {
312 $self->{response} = 'send_email'; 372 $self->{response} = 'send_email';
313 373
374 # check that recipients have been selected.
314 my @recipients = @{$self->{ra_send_to}}; 375 my @recipients = @{$self->{ra_send_to}};
315 $self->addmessage(CGI::div({class=>'ResultsWithError'},
316 "No recipients selected")) unless @recipients; 376 $self->addbadmessage(CGI::p("No recipients selected ")) unless @recipients;
317 # get merge file 377 # get merge file
318 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 378 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
319 my $delimiter = ','; 379 my $delimiter = ',';
320 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 380 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
321 unless (ref($rh_merge_data) ) { 381 unless (ref($rh_merge_data) ) {
322 warn "no merge data file"; 382 $self->addbadmessage(CGI::p("No merge data file"));
323 $self->submission_error("Can't read merge file $merge_file. No message sent"); 383 $self->addbadmessage(CGI::p("Can't read merge file $merge_file. No message sent"));
324 return; 384 return;
325 } ; 385 } ;
386 if (@recipients) {
387 $self->{rh_merge_data} = $rh_merge_data;
388 $self->{smtpServer} = $ce->{mail}->{smtpServer};
389 my $post_connection_action = sub {
390 my $r = shift;
391 my $result_message = $self->mail_message_to_recipients();
392 $self->email_notification($result_message);
393 };
394 $r->post_connection($post_connection_action) ;
326 395 }
327
328 foreach my $recipient (@recipients) { 396# foreach my $recipient (@recipients) {
329 #warn "FIXME sending email to $recipient"; 397# #warn "FIXME sending email to $recipient";
330 my $ur = $self->{db}->getUser($recipient); #checked 398# my $ur = $self->{db}->getUser($recipient); #checked
331 die "record for user $recipient not found" unless $ur; 399# die "record for user $recipient not found" unless $ur;
332 unless ($ur->email_address) { 400# unless ($ur->email_address) {
333 $self->addmessage(CGI::div({class=>'ResultsWithError'},
334 "user $recipient does not have an email address -- skipping")); 401# $self->addbadmessage(CGI::p("user $recipient does not have an email address -- skipping"));
335 next; 402# next;
336 } 403# }
337 my ($msg, $preview_header); 404# my ($msg, $preview_header);
338 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); }; 405# 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 $@; 406# $self->addbadmessage(CGI::p("There were errors in processing user $ur, merge file $merge_file. $@")) if $@;
340 my $mailer = Mail::Sender->new({ 407# my $mailer = Mail::Sender->new({
341 from => $from, 408# from => $from,
342 to => $ur->email_address, 409# to => $ur->email_address,
343 smtp => $ce->{mail}->{smtpServer}, 410# smtp => $ce->{mail}->{smtpServer},
344 subject => $subject, 411# subject => $subject,
345 headers => "X-Remote-Host: ".$r->get_remote_host(), 412# headers => "X-Remote-Host: ".$r->get_remote_host(),
346 }); 413# });
347 unless (ref $mailer) { 414# unless (ref $mailer) {
348 warn "Failed to create a mailer for user $recipient: $Mail::Sender::Error"; 415# $self->addbadmessage(CGI::p("Failed to create a mailer for user $recipient: $Mail::Sender::Error"));
349 next; 416# next;
350 } 417# }
351 unless (ref $mailer->Open()) { 418# unless (ref $mailer->Open()) {
352 warn "Failed to open the mailer for user $recipient: $Mail::Sender::Error"; 419# $self->addbadmessage(CGI::p("Failed to open the mailer for user $recipient: $Mail::Sender::Error"));
353 next; 420# next;
354 } 421# }
355 my $MAIL = $mailer->GetHandle() or warn "Couldn't get handle"; 422# my $MAIL = $mailer->GetHandle() or $self->addbadmessage(CGI::p("Couldn't get handle"));
356 print $MAIL $msg || warn "Couldn't print to $MAIL"; 423# print $MAIL $msg || $self->addbadmessage(CGI::p("Couldn't print to $MAIL"));
357 close $MAIL || warn "Couldn't close $MAIL"; 424# close $MAIL || $self->addbadmessage(CGI::p("Couldn't close $MAIL"));
358 #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject"; 425# #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject";
359 426#
360 } 427# }
361 428
362 } else { 429 } else {
363 warn "Didn't recognize button $action"; 430 $self->addbadmessage(CGI::p("Didn't recognize button $action"));
364 } 431 }
365 432
366 433
367 434
368} #end initialize 435} #end initialize
… …
373 440
374sub body { 441sub body {
375 my ($self) = @_; 442 my ($self) = @_;
376 my $r = $self->r; 443 my $r = $self->r;
377 my $urlpath = $r->urlpath; 444 my $urlpath = $r->urlpath;
445 my $authz = $r->authz;
378 my $setID = $urlpath->arg("setID"); 446 my $setID = $urlpath->arg("setID");
379 my $response = (defined($self->{response}))? $self->{response} : ''; 447 my $response = (defined($self->{response}))? $self->{response} : '';
448 my $user = $r->param('user');
449
450 # Check permissions
451 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to access instructor tools"))
452 unless $authz->hasPermissions($user, "access_instructor_tools");
453
454 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to send mail to students"))
455 unless $authz->hasPermissions($user, "send_mail");
456
380 if ($response eq 'preview') { 457 if ($response eq 'preview') {
381 $self->print_preview($setID); 458 $self->print_preview($setID);
382 } elsif (($response eq 'send_email')){ 459 } elsif (($response eq 'send_email')){
383 $self->{message} .= CGI::h3("Email sent to "). join(" ", @{$self->{ra_send_to}}); 460 my $message = CGI::i("Email is being sent to ". scalar(@{$self->{ra_send_to}})." recipients. You will be notified"
461 ." by email when the task is completed. This may take several minutes if the class is large."
462 );
463 $self->addgoodmessage($message);
464 $self->{message} .= $message;
465
384 $self->print_form($setID); 466 $self->print_form($setID);
385 } else { 467 } else {
386 $self->print_form($setID); 468 $self->print_form($setID);
387 } 469 }
388 470
… …
403 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 485 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
404 486
405 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data); 487 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data);
406 488
407 my $recipients = join(" ",@{$self->{ra_send_to} }); 489 my $recipients = join(" ",@{$self->{ra_send_to} });
408 my $errorMessage = defined($self->{submitError}) ? CGI::h3($self->{submitError} ) : '' ; 490 my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ;
409 $msg = join("", 491 $msg = join("",
410 $errorMessage, 492 $errorMessage,
411 $preview_header, 493 $preview_header,
412 "To: " , $ur->email_address,"\n", 494 "To: " , $ur->email_address,"\n",
413 "From: " , $self->{from} , "\n" , 495 "From: " , $self->{from} , "\n" ,
… …
444 526
445 my $userTemplate = $db->newUser; 527 my $userTemplate = $db->newUser;
446 my $permissionLevelTemplate = $db->newPermissionLevel; 528 my $permissionLevelTemplate = $db->newPermissionLevel;
447 529
448 # This code will require changing if the permission and user tables ever have different keys. 530 # This code will require changing if the permission and user tables ever have different keys.
449 my @users = @{ $self->{ra_users} }; 531 my @users = sort @{ $self->{ra_users} };
450 my $ra_user_records = $self->{ra_user_records}; 532 my $ra_user_records = $self->{ra_user_records};
451 my %classlistLabels = ();# %$hr_classlistLabels; 533 my %classlistLabels = ();# %$hr_classlistLabels;
452 foreach my $ur (@{ $ra_user_records }) { 534 foreach my $ur (@{ $ra_user_records }) {
453 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation; 535 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation;
454 } 536 }
455 537
538## Mark edit define scrolling list
539 my $scrolling_user_list = scrollingRecordList({
540 name => "classList", ## changed from classList to action
541 request => $r,
542 default_sort => "lnfn",
543 default_format => "lnfn_uid",
544 default_filters => ["all"],
545 size => 5,
546 multiple => 1,
547 refresh_button_name =>'Update settings and refresh page',
548 }, @{$ra_user_records});
456 549
457############################################################################################################## 550##############################################################################################################
458 551
459 552
460 my $from = $self->{from}; 553 my $from = $self->{from};
… …
488 print CGI::Tr({-align=>'left',-valign=>'top'}, 581 print CGI::Tr({-align=>'left',-valign=>'top'},
489############################################################################################# 582#############################################################################################
490# first column 583# first column
491############################################################################################# 584#############################################################################################
492 585
493 CGI::td(CGI::strong("Message file: $input_file"),"\n",CGI::br(), 586 CGI::td(CGI::strong("Message file: "), $input_file,"\n",CGI::br(),
494 CGI::submit(-name=>'action', -value=>'Open'), '&nbsp;&nbsp;&nbsp;&nbsp;',"\n", 587 CGI::submit(-name=>'action', -value=>'Open'), '&nbsp;&nbsp;&nbsp;&nbsp;',"\n",
495 CGI::popup_menu(-name=>'openfilename', 588 CGI::popup_menu(-name=>'openfilename',
496 -values=>\@sorted_messages, 589 -values=>\@sorted_messages,
497 -default=>$input_file 590 -default=>$input_file
591 ),
498 ), "\n",CGI::br(), 592 "\n",CGI::br(),
499 593 CGI::strong("Save file to: "), $output_file,
500 "Save file to: $output_file","\n",CGI::br(), 594 "\n",CGI::br(),
595 CGI::strong('Merge file: '), $merge_file,
596 CGI::br(),
597 CGI::popup_menu(-name=>'merge_file',
598 -values=>\@sorted_merge_files,
599 -default=>$merge_file,
600 ), "\n",
601 "\n",
602 #CGI::hr(),
603 CGI::div({style=>"background-color: #CCCCCC"},
501 "\n", 'From:','&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1), 604 "\n", 'From:','&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1),
502 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1), 605 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1),
503 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>30, -override=>1), 606 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>30, -override=>1),
607 ),
608 #CGI::hr(),
609 CGI::submit(-name=>'action', -value=>$UPDATE_SETTINGS_BUTTON),
610
504 ), 611 ),
505############################################################################################# 612#############################################################################################
506# second column 613# second column
507############################################################################################# 614#############################################################################################
508 CGI::td({-align=>'left',style=>'font-size:smaller'}, 615# CGI::td({-align=>'left',style=>'font-size:smaller'},
509 616#
510 CGI::strong("Send to:"), 617# CGI::strong("Send to:"),
511 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], 618# CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'],
512 -labels=>{all_students=>'All',studentID => 'Selected'}, 619# -labels=>{all_students=>'All students in course',studentID => 'Selected'},
513 -default=>'studentID', 620# -default=>'studentID',
514 -linebreak=>0 621# -linebreak=>0
515 ), CGI::br(),CGI::br(), 622# ), CGI::br(),CGI::br(),
516 623## Edit by Mark to insert scrolling list
517 CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),, 624 CGI::td({-style=>"width:33%"},CGI::strong("Send to:"),
518 CGI::radio_group(-name=>'sort_by', -values=>['id','alphabetical','section','recitation'], 625 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'],
519 -labels=>{id=>'Login',alphabetical=>'Alph.',section => 'Sec.',recitation=>'Rec.'}, 626 -labels=>{all_students=>'All students in course',studentID => 'Selected students'},
520 -default=>defined($r->param("sort_by")) ? $r->param("sort_by") : 'id', 627 -default=>'studentID', -linebreak=>0),
521 -linebreak=>0 628 CGI::br(),$scrolling_user_list,
522 ), 629 CGI::i("Preview set to: "), $preview_record->last_name,
523 630 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview message'),'&nbsp;&nbsp;',
524 CGI::br(),CGI::br(),
525 CGI::popup_menu(-name=>'classList',
526 -values=>\@users,
527 -labels=>\%classlistLabels,
528 -size => 10,
529 -multiple => 1,
530 -default=>$user
531 ), 631 ),
532 ),
533 632
633## Edit here to insert filtering
634## be sure to fail GRACEFULLY!
635#
636#
637# CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),,
638# CGI::radio_group(-name=>'sort_by', -values=>['id','alphabetical','section','recitation'],
639# -labels=>{id=>'Login',alphabetical=>'Alph.',section => 'Sec.',recitation=>'Rec.'},
640# -default=>defined($r->param("sort_by")) ? $r->param("sort_by") : 'id',
641# -linebreak=>0
642# ),
643#
644# CGI::br(),CGI::br(),
645# CGI::popup_menu(-name=>'classList',
646# -values=>\@users,
647# -labels=>\%classlistLabels,
648# -size => 10,
649# -multiple => 1,
650# -default=>$user
651# ),
652# ),
653
654
655
534 656
535############################################################################################# 657#############################################################################################
536# third column 658# third column
537############################################################################################# 659#############################################################################################
538 CGI::td({align=>'left'}, 660 CGI::td({align=>'left'},
539 "<b>Merge file:</b> $merge_file", CGI::br(), 661# "<b>Merge file:</b> $merge_file", CGI::br(),
540 CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(), 662# CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(),
541 CGI::popup_menu(-name=>'merge_file', 663# CGI::popup_menu(-name=>'merge_file',
542 -values=>\@sorted_merge_files, 664# -values=>\@sorted_merge_files,
543 -default=>$merge_file, 665# -default=>$merge_file,
544 ), "\n",CGI::hr(),CGI::br(), 666# ), "\n",
545 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview')," email to ", 667# CGI::hr(),
668# CGI::b("Viewing email for: "), "$preview_user",CGI::br(),
669# CGI::submit(-name=>'action', -value=>'resize', -label=>$REFRESH_RESIZE_BUTTON),'&nbsp;',
546 CGI::popup_menu(-name=>'preview_user', 670# CGI::popup_menu(-name=>'preview_user',
547 -values=>\@users, 671# -values=>\@users,
548 #-labels=>\%classlistLabels, 672# #-labels=>\%classlistLabels,
549 -default=>$preview_user, 673# -default=>$preview_user,
550 ), 674# ),
675# CGI::br(),
676# CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview message'),'&nbsp;&nbsp;',
677#
678# CGI::br(),
679#
551 CGI::hr(), 680# CGI::hr(),
552 CGI::submit(-name=>'action', -value=>'resize', -label=>$REFRESH_RESIZE_BUTTON),CGI::br(),
553 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), 681 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows),
554 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), 682 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns),
555 CGI::br(),CGI::br(), 683 CGI::br(),
684# CGI::i('Press any action button to update display'),CGI::br(),
556 #show available macros 685 #show available macros
557 CGI::popup_menu( 686 CGI::popup_menu(
558 -name=>'dummyName', 687 -name=>'dummyName',
559 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'], 688 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'],
560 -labels=>{''=>'list of insertable macros', 689 -labels=>{''=>'list of insertable macros',
… …
595 my @tmp2; 724 my @tmp2;
596 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; # checked 725 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; # checked
597 if ($@ and $merge_file ne 'None') { 726 if ($@ and $merge_file ne 'None') {
598 print "No merge data for $preview_user in merge file: &lt;$merge_file&gt;",CGI::br(); 727 print "No merge data for $preview_user in merge file: &lt;$merge_file&gt;",CGI::br();
599 } else { 728 } else {
600 print CGI::pre("",data_format(0..($#tmp2)),"<br>", data_format2(@tmp2)); 729 print CGI::pre("",data_format(1..($#tmp2+1)),"<br>", data_format2(@tmp2));
601 } 730 }
602#create a textbox with the subject and a textarea with the message 731#create a textbox with the subject and a textarea with the message
603#print actual body of message 732#print actual body of message
604 733
605 print "\n", CGI::p( $self->{message}) if defined($self->{message}); 734 print "\n", CGI::p( $self->{message}) if defined($self->{message});
… …
626} 755}
627 756
628############################################################################## 757##############################################################################
629# Utility methods 758# Utility methods
630############################################################################## 759##############################################################################
631sub submission_error {
632 my $self = shift;
633 my $msg = join( " ", @_);
634 $self->{submitError} .= CGI::br().$msg;
635 return;
636}
637 760
638sub saveProblem { 761sub saveProblem {
639 my $self = shift; 762 my $self = shift;
640 my ($body, $probFileName)= @_; 763 my ($body, $probFileName)= @_;
641 local(*PROBLEM); 764 local(*PROBLEM);
642 open (PROBLEM, ">$probFileName") || 765 open (PROBLEM, ">$probFileName") ||
643 $self->submission_error("Could not open $probFileName for writing. 766 $self->addbadmessage(CGI::p("Could not open $probFileName for writing.
644 Check that the permissions for this problem are 660 (-rw-rw----)"); 767 Check that the permissions for this problem are 660 (-rw-rw----)"));
645 print PROBLEM $body; 768 print PROBLEM $body if -w $probFileName;
646 close PROBLEM; 769 close PROBLEM;
647 chmod 0660, "$probFileName" || 770 chmod 0660, "$probFileName" ||
648 $self->submission_error("
649 CAN'T CHANGE PERMISSIONS ON FILE $probFileName"); 771 $self->addbadmessage(CGI::p("CAN'T CHANGE PERMISSIONS ON FILE $probFileName"));
650} 772}
651 773
652sub read_input_file { 774sub read_input_file {
653 my $self = shift; 775 my $self = shift;
654 my $filePath = shift; 776 my $filePath = shift;
655 my ($text, @text); 777 my ($text, @text);
656 my $header = ''; 778 my $header = '';
657 my ($subject, $from, $replyTo); 779 my ($subject, $from, $replyTo);
658 local(*FILE); 780 local(*FILE);
659 if (-e "$filePath" and -r "$filePath") { 781 if (-e "$filePath" and -r "$filePath") {
660 open FILE, "$filePath" || do { $self->submission_error("Can't open $filePath"); return}; 782 open FILE, "$filePath" || do { $self->addbadmessage(CGI::p("Can't open $filePath")); return};
661 while ($header !~ s/Message:\s*$//m and not eof(FILE)) { 783 while ($header !~ s/Message:\s*$//m and not eof(FILE)) {
662 $header .= <FILE>; 784 $header .= <FILE>;
663 } 785 }
664 $text = join( '', <FILE>); 786 $text = join( '', <FILE>);
665 $text =~ s/^\s*//; # remove initial white space if any. 787 $text =~ s/^\s*//; # remove initial white space if any.
… …
674 796
675 } else { 797 } else {
676 $from = $self->{defaultFrom}; 798 $from = $self->{defaultFrom};
677 $replyTo = $self->{defaultReply}; 799 $replyTo = $self->{defaultReply};
678 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist"; 800 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist";
679 $subject = "FIXME default subject"; 801 $subject = $self->{defaultSubject};
680 } 802 }
681 return ($from, $replyTo, $subject, \$text); 803 return ($from, $replyTo, $subject, \$text);
682} 804}
683 805
684 806
… …
689sub get_merge_file_names { 811sub get_merge_file_names {
690 my $self = shift; 812 my $self = shift;
691 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed. 813 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed.
692} 814}
693 815
816sub mail_message_to_recipients {
817 my $self = shift;
818 my $subject = $self->{subject};
819 my $from = $self->{from};
820 my @recipients = @{$self->{ra_send_to}};
821 my $rh_merge_data = $self->{rh_merge_data};
822 my $merge_file = $self->{merge_file};
823 my $result_message = '';
824 my $failed_messages = 0;
825 foreach my $recipient (@recipients) {
826 # warn "FIXME sending email to $recipient";
827 my $error_messages = '';
828 my $ur = $self->{db}->getUser($recipient); #checked
829 unless ($ur) {
830 $error_messages .= "Record for user $recipient not found\n";
831 next;
832 }
833 unless ($ur->email_address) {
834 $error_messages .="User $recipient does not have an email address -- skipping\n";
835 next;
836 }
837 my ($msg, $preview_header);
838 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); };
839 $error_messages .= "There were errors in processing user $ur, merge file $merge_file. \n$@\n" if $@;
840 my $mailer = Mail::Sender->new({
841 from => $from,
842 to => $ur->email_address,
843 smtp => $self->{smtpServer},
844 subject => $subject,
845 headers => "X-Remote-Host: ".$self->r->get_remote_host(),
846 });
847 unless (ref $mailer) {
848 $error_messages .= "Failed to create a mailer for user $recipient: $Mail::Sender::Error\n";
849 next;
850 }
851 unless (ref $mailer->Open()) {
852 $error_messages .= "Failed to open the mailer for user $recipient: $Mail::Sender::Error\n";
853 next;
854 }
855 my $MAIL = $mailer->GetHandle() || ($error_messages .= "Couldn't get mailer handle \n");
856 print $MAIL $msg || ($error_messages .= "Couldn't print to $MAIL");
857 close $MAIL || ($error_messages .= "Couldn't close $MAIL");
858 #warn "FIXME mailed to $recipient: ", $ur->email_address, " from $from subject $subject Errors: $error_messages";
859 $failed_messages++ if $error_messages;
860 $result_message .= $error_messages;
861 }
862 my $courseName = $self->r->urlpath->arg("courseID");
863 my $number_of_recipients = scalar(@recipients) - $failed_messages;
864 $result_message = <<EndText.$result_message;
865
866 A message with the subject line
867 $subject
868 has been sent to
869 $number_of_recipients recipient(s) in the class $courseName.
870 There were $failed_messages message(s) that could not be delivered.
871
872EndText
694 873
874}
875sub email_notification {
876 my $self = shift;
877 my $result_message = shift;
878 # find info on mailer and sender
879 # use the defaultFrom address.
880
881 # find info on instructor recipient and message
882 my $subject="WeBWorK email sent";
883
884 my $mailing_errors = "";
885 # open MAIL handle
886 my $mailer = Mail::Sender->new({
887 from => $self->{defaultFrom},
888 to => $self->{defaultFrom},
889 smtp => $self->{smtpServer},
890 subject => $subject,
891 headers => "X-Remote-Host: ".$self->r->get_remote_host(),
892 });
893 unless (ref $mailer) {
894 $mailing_errors .= "Failed to create a mailer: $Mail::Sender::Error";
895 return "";
896 }
897 unless (ref $mailer->Open()) {
898 $mailing_errors .= "Failed to open the mailer: $Mail::Sender::Error";
899 return "";
900 }
901 my $MAIL = $mailer->GetHandle();
902 # print message
903 print $MAIL $result_message;
904 # clean up
905 close $MAIL;
906
907 warn "instructor message sent to ", $self->{defaultFrom};
908
909}
695sub getRecord { 910sub getRecord {
696 my $self = shift; 911 my $self = shift;
697 my $line = shift; 912 my $line = shift;
698 my $delimiter = shift; 913 my $delimiter = shift;
699 $delimiter = ',' unless defined($delimiter); 914 $delimiter = ',' unless defined($delimiter);
… …
717 my $ur = shift; 932 my $ur = shift;
718 my $rh_merge_data = shift; 933 my $rh_merge_data = shift;
719 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 934 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }:
720 'FIXME no text was produced by initialization!!'; 935 'FIXME no text was produced by initialization!!';
721 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 936 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
937
938 my $status_name = $self->r->ce->status_abbrev_to_name($ur->status);
939 $status_name = $ur->status unless defined $status_name;
940
722 #user macros that can be used in the email message 941 #user macros that can be used in the email message
723 my $SID = $ur->student_id; 942 my $SID = $ur->student_id;
724 my $FN = $ur->first_name; 943 my $FN = $ur->first_name;
725 my $LN = $ur->last_name; 944 my $LN = $ur->last_name;
726 my $SECTION = $ur->section; 945 my $SECTION = $ur->section;
727 my $RECITATION = $ur->recitation; 946 my $RECITATION = $ur->recitation;
728 my $STATUS = $ur->status; 947 my $STATUS = $status_name;
729 my $EMAIL = $ur->email_address; 948 my $EMAIL = $ur->email_address;
730 my $LOGIN = $ur->user_id; 949 my $LOGIN = $ur->user_id;
731 950
732 # get record from merge file 951 # get record from merge file
733 # FIXME this is inefficient. The info should be cached 952 # FIXME this is inefficient. The info should be cached
734 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); 953 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : ();
735 if ($merge_file ne 'None' && not defined($rh_merge_data->{$SID}) ) { 954 if ($merge_file ne 'None' && not defined($rh_merge_data->{$SID}) ) {
736 $self->submission_error( "No merge data for $SID $FN $LN $LOGIN"); 955 $self->addbadmessage(CGI::p("No merge data for student id:$SID; name:$FN $LN; login:$LOGIN"));
737 } 956 }
738 957 unshift(@COL,""); ## this makes COL[1] the first column
739 my $endCol = @COL; 958 my $endCol = @COL;
740 # for safety, only evaluate special variables 959 # for safety, only evaluate special variables
741 my $msg = $text; 960 my $msg = $text;
742 $msg =~ s/(\$SID)/eval($1)/ge; 961 $msg =~ s/\$SID/$SID/ge;
743 $msg =~ s/(\$LN)/eval($1)/ge; 962 $msg =~ s/\$LN/$LN/ge;
744 $msg =~ s/(\$FN)/eval($1)/ge; 963 $msg =~ s/\$FN/$FN/ge;
745 $msg =~ s/(\$STATUS)/eval($1)/ge; 964 $msg =~ s/\$STATUS/$STATUS/ge;
746 $msg =~ s/(\$SECTION)/eval($1)/ge; 965 $msg =~ s/\$SECTION/$SECTION/ge;
747 $msg =~ s/(\$RECITATION)/eval($1)/ge; 966 $msg =~ s/\$RECITATION/$RECITATION/ge;
748 $msg =~ s/(\$EMAIL)/eval($1)/ge; 967 $msg =~ s/\$EMAIL/$EMAIL/ge;
749 $msg =~ s/(\$LOGIN)/eval($1)/ge; 968 $msg =~ s/\$LOGIN/$LOGIN/ge;
750 $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g; 969 if (defined($COL[1])) { # prevents extraneous error messages.
751 $msg =~ s/(\$COL\[.*?\])/eval($1)/ge if defined($COL[0]); # prevents extraneous error messages. 970 $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1]/ge
752 971 }
753 972 else { # prevents extraneous $COL's in email message
973 $msg =~ s/\$COL\[(\-?\d+)\]//g
974 }
975
754 $msg =~ s/\r//g; 976 $msg =~ s/\r//g;
755 977
978 my @preview_COL = @COL;
979 shift @preview_COL; ## shift back for preview
756 my $preview_header = CGI::pre("",data_format(0..($#COL)),"<br>", data_format2(@COL)). 980 my $preview_header = CGI::pre("",data_format(1..($#COL)),"<br>", data_format2(@preview_COL)).
757 CGI::h3( "This sample mail would be sent to $EMAIL"); 981 CGI::h3( "This sample mail would be sent to $EMAIL");
758 982
759
760 return $msg, $preview_header; 983 return $msg, $preview_header;
761} 984}
762 985
763 986
764# Ê sub data_format { 987# Ý sub data_format {
765# 988#
766# Ê Ê Ê Ê Êmap {$_ =~s/\s/\./g;$_} Ê Ê map {sprintf('%-8.8s',$_);} Ê@_; 989# Ý Ý Ý Ý Ýmap {$_ =~s/\s/\./g;$_} Ý Ý map {sprintf('%-8.8s',$_);} Ý@_;
767 sub data_format { 990 sub data_format {
768 map {"COL[$_]".'&nbsp;'x(3-length($_));} @_; # problems if $_ has length bigger than 4 991 map {"COL[$_]".'&nbsp;'x(3-length($_));} @_; # problems if $_ has length bigger than 4
769 } 992 }
770 sub data_format2 { 993 sub data_format2 {
771 map {$_ =~s/\s/&nbsp;/g;$_} map {sprintf('%-8.8s',$_);} @_; 994 map {$_ =~s/\s/&nbsp;/g;$_} map {sprintf('%-8.8s',$_);} @_;
Legend:
Removed from v.2049  
changed lines
  Added in v.3827
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9