[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 1376 Revision 2786
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.36 2004/09/14 18:55:58 apizer 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;
14use Mail::Sender; 30use Mail::Sender;
31use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/;
32use WeBWorK::Utils::FilterRecords qw/filterRecords/;
15 33
34my $REFRESH_RESIZE_BUTTON = "Set preview to: "; # handle submit value idiocy
16sub initialize { 35sub initialize {
17 my ($self) = @_; 36 my ($self) = @_;
18 my $r = $self->{r}; 37 my $r = $self->r;
19 my $db = $self->{db}; 38 my $db = $r->db;
20 my $ce = $self->{ce}; 39 my $ce = $r->ce;
21 my $authz = $self->{authz}; 40 my $authz = $r->authz;
22 my $user = $r->param('user'); 41 my $user = $r->param('user');
23 42
43 my @selected_filters;
44 if (defined ($r->param('classList!filter'))){ @selected_filters = $r->param('classList!filter');}
45 else {@selected_filters = ("all");}
46
47
48 # Check permissions
49 return unless $authz->hasPermissions($user, "access_instructor_tools");
24 unless ($authz->hasPermissions($user, "send_mail")) { 50 return unless $authz->hasPermissions($user, "send_mail");
25 $self->{submitError} = "You are not authorized to send mail to students."; 51
26 return;
27 }
28############################################################################################# 52#############################################################################################
29# gather directory data 53# gather directory data
30############################################################################################# 54#############################################################################################
31 my $emailDirectory = $ce->{courseDirs}->{email}; 55 my $emailDirectory = $ce->{courseDirs}->{email};
32 my $scoringDirectory = $ce->{courseDirs}->{scoring}; 56 my $scoringDirectory = $ce->{courseDirs}->{scoring};
33 my $templateDirectory = $ce->{courseDirs}->{templates}; 57 my $templateDirectory = $ce->{courseDirs}->{templates};
34 58
35 my $action = $r->param('action'); 59 my $action = $r->param('action') ;
36 my $openfilename = $r->param('openfilename'); 60 my $openfilename = $r->param('openfilename');
37 my $savefilename = $r->param('savefilename'); 61 my $savefilename = $r->param('savefilename');
38 62
39 63
40 #FIXME get these values from global course environment (see subroutines as well) 64 #FIXME get these values from global course environment (see subroutines as well)
41 my $default_msg_file = 'default.msg'; 65 my $default_msg_file = 'default.msg';
42 my $old_default_msg_file = 'old_default.msg'; 66 my $old_default_msg_file = 'old_default.msg';
43 67
44 68
69 # get user record
70 my $ur = $self->{db}->getUser($user);
71
45 # store data 72 # store data
46 $self->{defaultFrom} = 'FIXME from'; 73 $self->{defaultFrom} = $ur->email_address . " (".$ur->first_name." ".$ur->last_name.")";
47 $self->{defaultReply} = 'FIXME reply'; 74 $self->{defaultReply} = $ur->email_address;
75 $self->{defaultSubject} = $self->r->urlpath->arg("courseID") . " notice";
76
48 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows}; 77 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows};
49 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns}; 78 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns};
50 $self->{default_msg_file} = $default_msg_file; 79 $self->{default_msg_file} = $default_msg_file;
51 $self->{old_default_msg_file} = $old_default_msg_file; 80 $self->{old_default_msg_file} = $old_default_msg_file;
52 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None'; 81 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None';
… …
55 84
56############################################################################################# 85#############################################################################################
57# gather database data 86# gather database data
58############################################################################################# 87#############################################################################################
59 # FIXME this might be better done in body? We don't always need all of this data. or do we? 88 # FIXME this might be better done in body? We don't always need all of this data. or do we?
60 my @users = sort $db->listUsers; 89 my @users = $db->listUsers;
90 my @Users = $db->getUsers(@users);
61 my @user_records = (); 91 my @user_records = ();
62 push(@user_records,$db->getUser($_)) foreach (@users); 92
93## Mark's code to prefilter userlist
94
63 95
96 my (@viewable_sections,@viewable_recitations);
97
98 if (defined @{$ce->{viewable_sections}->{$user}})
99 {@viewable_sections = @{$ce->{viewable_sections}->{$user}};}
100 if (defined @{$ce->{viewable_recitations}->{$user}})
101 {@viewable_recitations = @{$ce->{viewable_recitations}->{$user}};}
102
103 if (@viewable_sections or @viewable_recitations){
104 foreach my $student (@Users){
105 my $keep = 0;
106 foreach my $sec (@viewable_sections){
107 if ($student->section() eq $sec){$keep = 1;}
108 }
109 foreach my $rec (@viewable_recitations){
110 if ($student->recitation() eq $rec){$keep = 1;}
111 }
112 if ($keep) {push @user_records, $student;}
113 }
114 }
115 else {@user_records = @Users;}
116
117## End Mark's code
118
119# foreach my $userName (@users) {
120# my $userRecord = $db->getUser($userName); # checked
121# die "record for user $userName not found" unless $userRecord;
122# push(@user_records, $userRecord);
123# }
124 ###########################
125 # Sort the users for presentation in the select list
126 ###########################
127# if (defined $r->param("sort_by") ) {
128# my $sort_method = $r->param("sort_by");
129# if ($sort_method eq 'section') {
130# @user_records = sort { (lc($a->section) cmp lc($b->section)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
131# } elsif ($sort_method eq 'recitation') {
132# @user_records = sort { (lc($a->recitation) cmp lc($b->recitation)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
133# } elsif ($sort_method eq 'alphabetical') {
134# @user_records = sort { (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
135# } elsif ($sort_method eq 'id' ) {
136# @user_records = sort { $a->user_id cmp $b->user_id } @user_records;
137# }
138# } else {
139# @user_records = sort { $a->user_id cmp $b->user_id } @user_records;
140# }
141
142
143 # replace the user names by a sorted version.
144 @users = map {$_->user_id} @user_records;
64 # store data 145 # store data
65 $self->{ra_users} = \@users; 146 $self->{ra_users} = \@users;
66 $self->{ra_user_records} = \@user_records; 147 $self->{ra_user_records} = \@user_records;
67 148
68############################################################################################# 149#############################################################################################
… …
70############################################################################################# 151#############################################################################################
71 my @send_to = (); 152 my @send_to = ();
72 #FIXME this (radio) is a lousy name 153 #FIXME this (radio) is a lousy name
73 my $recipients = $r->param('radio'); 154 my $recipients = $r->param('radio');
74 if (defined($recipients) and $recipients eq 'all_students') { #only active students #FIXME status check?? 155 if (defined($recipients) and $recipients eq 'all_students') { #only active students #FIXME status check??
156
157## Add code so that only people who pass the current filters are added to our list of recipients.
158# @user_records = filterRecords({filter=\@selected_filters},@user_records);
159# I wasn't able to make this work
160# I edited the selection button to make that clear.
161#
162
75 foreach my $ur (@user_records) { 163 foreach my $ur (@user_records) {
76 push(@send_to,$ur->user_id) if $ur->status eq 'C' and not($ur->user_id =~ /practice/); 164 push(@send_to,$ur->user_id) if $ur->status eq 'C' and not($ur->user_id =~ /practice/);
77 } 165 }
78 } elsif (defined($recipients) and $recipients eq 'studentID' ) { 166 } elsif (defined($recipients) and $recipients eq 'studentID' ) {
79 @send_to = $r->param('classList'); 167 @send_to = $r->param('classList');
… …
90 if ( defined($openfilename) ) { 178 if ( defined($openfilename) ) {
91 if ( -e "${emailDirectory}/$openfilename") { 179 if ( -e "${emailDirectory}/$openfilename") {
92 if ( -R "${emailDirectory}/$openfilename") { 180 if ( -R "${emailDirectory}/$openfilename") {
93 $input_file = $openfilename; 181 $input_file = $openfilename;
94 } else { 182 } else {
95 warn join("", 183 $self->addbadmessage(CGI::p(join("",
96 "The file ${emailDirectory}/$openfilename is not readable by the webserver.",CGI::br(), 184 "The file ${emailDirectory}/$openfilename is not readable by the webserver.",CGI::br(),
97 "Check that it's permissions are set correctly.", 185 "Check that it's permissions are set correctly.",
98 ); 186 )));
99 } 187 }
100 } else { 188 } else {
101 $input_file = $default_msg_file; 189 $input_file = $default_msg_file;
102 warn join("", 190 $self->addbadmessage(CGI::p(join("",
103 "The file ${emailDirectory}/$openfilename cannot be found.",CGI::br(), 191 "The file ${emailDirectory}/$openfilename cannot be found.",CGI::br(),
104 "Check whether it exists and whether the directory $emailDirectory can be read by the webserver.",CGI::br(), 192 "Check whether it exists and whether the directory $emailDirectory can be read by the webserver.",CGI::br(),
105 "Using contents of the default message $default_msg_file instead.", 193 "Using contents of the default message $default_msg_file instead.",
106 ); 194 )));
107 } 195 }
108 } else { 196 } else {
109 $input_file = $default_msg_file; 197 $input_file = $default_msg_file;
110 } 198 }
111 $self->{input_file} =$input_file; 199 $self->{input_file} =$input_file;
… …
114# Determine the file name to save message into 202# Determine the file name to save message into
115################################################################# 203#################################################################
116 my $output_file = 'FIXME no output file specified'; 204 my $output_file = 'FIXME no output file specified';
117 if (defined($action) and $action eq 'Save as Default') { 205 if (defined($action) and $action eq 'Save as Default') {
118 $output_file = $default_msg_file; 206 $output_file = $default_msg_file;
119 } elsif ( defined($action) and ($action =~/save/i) and defined($savefilename) ){ 207 } elsif ( defined($action) and ($action =~/save/i)) {
208 if (defined($savefilename) and $savefilename ) {
120 $output_file = $savefilename; 209 $output_file = $savefilename;
210 } else {
211 $self->addbadmessage(CGI::p("No filename was specified for saving! The message was not saved."));
212 }
121 } elsif ( defined($input_file) ) { 213 } elsif ( defined($input_file) ) {
122 $output_file = $input_file; 214 $output_file = $input_file;
123 } 215 }
124# warn "FIXME savefilename $savefilename output file $output_file"; 216
125 ################################################################# 217 #################################################################
126 # Sanity check on save file name 218 # Sanity check on save file name
127 ################################################################# 219 #################################################################
128 220
129 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) { 221 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) {
130 $self->submission_error("For security reasons, you cannot specify a merge file from a directory", 222 $self->addbadmessage(CGI::p("For security reasons, you cannot specify a message file from a directory",
131 "higher than the email directory (you can't use ../blah/blah). ", 223 "higher than the email directory (you can't use ../blah/blah for example). ",
132 "Please specify a different file or move the needed file to the email directory", 224 "Please specify a different file or move the needed file to the email directory",));
133 );
134 } 225 }
135 unless ($output_file =~ m|\.msg$| ) { 226 unless ($output_file =~ m|\.msg$| ) {
136 $self->submission_error("Invalid file name.", 227 $self->addbadmessage(CGI::p("Invalid file name.",
137 "The file name \"$output_file\" does not have a \".msg\" extension", 228 "The file name \"$output_file\" does not have a \".msg\" extension",
138 "All email file names must end in the extension \".msg\"", 229 "All email file names must end in the extension \".msg\"",
139 "choose a file name with a \".msg\" extension.", 230 "choose a file name with a \".msg\" extension.",
140 "The message was not saved.", 231 "The message was not saved.",));
141 );
142 } 232 }
233
143 $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing. 234 $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing.
144 # FIXME $output_file can be blank if there was no savefilename 235
145 236
146############################################################################################# 237#############################################################################################
147# Determine input source 238# Determine input source
148############################################################################################# 239#############################################################################################
240 #warn "Action = $action";
241 my $input_source;
242 if ($action){
149 my $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file'; 243 $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file';}
150# warn "FIXME input source is $input_source from $input_file"; 244 else { $input_source = ( defined($r->param('body')) ) ? 'form' : 'file';}
245
151############################################################################################# 246#############################################################################################
152# Get inputs 247# Get inputs
153############################################################################################# 248#############################################################################################
154 my($from, $replyTo, $r_text, $subject); 249 my($from, $replyTo, $r_text, $subject);
155 if ($input_source eq 'file') { 250 if ($input_source eq 'file') {
156# warn "FIXME obtaining source from $emailDirectory/$input_file"; 251
157 ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file"); 252 ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file");
158# warn "FIXME Done reading source"; 253
159 254
160 } elsif ($input_source eq 'form') { 255 } elsif ($input_source eq 'form') {
161 # read info from the form 256 # read info from the form
162 # bail if there is no message body 257 # bail if there is no message body
163 258
164 $from = $r->param('from'); 259 $from = $r->param('from');
165 $replyTo = $r->param('replyTo'); 260 $replyTo = $r->param('replyTo');
166 $subject = $r->param('subject'); 261 $subject = $r->param('subject');
167 my $body = $r->param('body'); 262 my $body = $r->param('body');
168 # Sanity check: body must contain non-white space 263 # Sanity check: body must contain non-white space
169 $self->submission_error('You didn\'t enter any message.') unless ($r->param('body') =~ /\S/); 264 $self->addbadmessage(CGI::p('You didn\'t enter any message.')) unless ($r->param('body') =~ /\S/);
170 $r_text = \$body; 265 $r_text = \$body;
171 266
172 } 267 }
173 # store data 268 # store data
174 $self->{from} = $from; 269 $self->{from} = $from;
… …
206############################################################################################# 301#############################################################################################
207 my $to = $r->param('To'); 302 my $to = $r->param('To');
208 my $script_action = ''; 303 my $script_action = '';
209 304
210 305
211 if(not defined($action) or $action eq 'Open' or $action eq 'Resize message window' 306 if(not defined($action) or $action eq 'Open' or $action eq $REFRESH_RESIZE_BUTTON or $action eq 'Sort by'
212 or $action eq 'Set merge file to:' ){ 307 or $action eq 'Set merge file to:' ){
213# warn "FIXME action is |$action| no further initialization required"; 308
214 return ''; 309 return '';
215 } 310 }
216 311
217 312
218 313
… …
240# warn "FIXME from $from | subject $subject |reply $replyTo|msg $temp_body"; 335# warn "FIXME from $from | subject $subject |reply $replyTo|msg $temp_body";
241 ################################################################# 336 #################################################################
242 # overwrite protection 337 # overwrite protection
243 ################################################################# 338 #################################################################
244 if ($action eq 'Save as:' and -e "$emailDirectory/$output_file") { 339 if ($action eq 'Save as:' and -e "$emailDirectory/$output_file") {
245 $self->submission_error("The file $emailDirectory/$output_file already exists and cannot be overwritten", 340 $self->addbadmessage(CGI::p("The file $emailDirectory/$output_file already exists and cannot be overwritten",
246 "The message was not saved"); 341 "The message was not saved"));
247 return; 342 return;
248 } 343 }
249 344
250 ################################################################# 345 #################################################################
251 # Back up existing file? 346 # Back up existing file?
252 ################################################################# 347 #################################################################
253 if ($action eq 'Save as Default' and -e "$emailDirectory/$default_msg_file") { 348 if ($action eq 'Save as Default' and -e "$emailDirectory/$default_msg_file") {
254 rename("$emailDirectory/$default_msg_file","$emailDirectory/$old_default_msg_file") or 349 rename("$emailDirectory/$default_msg_file","$emailDirectory/$old_default_msg_file") or
255 die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ", 350 die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ",
256 "Check permissions for webserver on directory $emailDirectory. $!"; 351 "Check permissions for webserver on directory $emailDirectory. $!";
257 $self->{message} .= "Backup file <code>$emailDirectory/$old_default_msg_file</code> created.".CGI::br(); 352 $self->addgoodmessage(CGI::p("Backup file <code>$emailDirectory/$old_default_msg_file</code> created." . CGI::br()));
258 } 353 }
259 ################################################################# 354 #################################################################
260 # Save the message 355 # Save the message
261 ################################################################# 356 #################################################################
262 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ); 357 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ) unless ($output_file =~ /^[~.]/ || $output_file =~ /\.\./ || not $output_file =~ m|\.msg$|);
358 unless ( $self->{submit_message} or not -w "${emailDirectory}/$output_file" ) { # if there are no errors report success
263 $self->{message} .= "Message saved to file <code>${emailDirectory}/$output_file</code>."; 359 $self->addgoodmessage(CGI::p("Message saved to file <code>${emailDirectory}/$output_file</code>."));
264# warn "FIXME saving to ${emailDirectory}/$output_file"; 360 }
361
265 } elsif ($action eq 'Preview') { 362 } elsif ($action eq 'Preview message') {
266 $self->{response} = 'preview'; 363 $self->{response} = 'preview';
267 364
268 } elsif ($action eq 'Send Email') { 365 } elsif ($action eq 'Send Email') {
269 $self->{response} = 'send_email'; 366 $self->{response} = 'send_email';
270 367
271 my @recipients = @{$self->{ra_send_to}}; 368 my @recipients = @{$self->{ra_send_to}};
272 warn "No recipients selected " unless @recipients; 369 $self->addbadmessage(CGI::p("No recipients selected ")) unless @recipients;
273 # get merge file 370 # get merge file
274 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 371 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
275 my $delimiter = ','; 372 my $delimiter = ',';
276 my $rh_merge_data = $self->read_merge_file("$merge_file", "$delimiter"); 373 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
277 unless (ref($rh_merge_data) ) { 374 unless (ref($rh_merge_data) ) {
278 warn "no merge data file"; 375 $self->addbadmessage(CGI::p("No merge data file"));
279 $self->submission_error("Can't read merge file $merge_file. No message sent"); 376 $self->addbadmessage(CGI::p("Can't read merge file $merge_file. No message sent"));
280 return; 377 return;
281 } ; 378 } ;
282 379
283 380
284 foreach my $recipient (@recipients) { 381 foreach my $recipient (@recipients) {
285 #warn "FIXME sending email to $recipient"; 382 #warn "FIXME sending email to $recipient";
286 my $ur = $self->{db}->getUser($recipient); 383 my $ur = $self->{db}->getUser($recipient); #checked
384 die "record for user $recipient not found" unless $ur;
385 unless ($ur->email_address) {
386 $self->addbadmessage(CGI::p("user $recipient does not have an email address -- skipping"));
387 next;
388 }
287 my ($msg, $preview_header); 389 my ($msg, $preview_header);
288 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); }; 390 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); };
289 warn "There were errors in processing user $ur, merge file $merge_file. $@" if $@; 391 $self->addbadmessage(CGI::p("There were errors in processing user $ur, merge file $merge_file. $@")) if $@;
290 my $mailer = Mail::Sender->new({ 392 my $mailer = Mail::Sender->new({
291 from => $from, 393 from => $from,
292 to => $ur->email_address, 394 to => $ur->email_address,
293 smtp => $ce->{mail}->{smtpServer}, 395 smtp => $ce->{mail}->{smtpServer},
294 subject => $subject, 396 subject => $subject,
295 headers => "X-Remote-Host: ".$r->get_remote_host(), 397 headers => "X-Remote-Host: ".$r->get_remote_host(),
296 }); 398 });
297 unless (ref $mailer) { 399 unless (ref $mailer) {
298 warn "Failed to create a mailer: $Mail::Sender::Error"; 400 $self->addbadmessage(CGI::p("Failed to create a mailer for user $recipient: $Mail::Sender::Error"));
299 next; 401 next;
300 } 402 }
301 unless (ref $mailer->Open()) { 403 unless (ref $mailer->Open()) {
302 warn "Failed to open the mailer: $Mail::Sender::Error"; 404 $self->addbadmessage(CGI::p("Failed to open the mailer for user $recipient: $Mail::Sender::Error"));
303 next; 405 next;
304 } 406 }
305 my $MAIL = $mailer->GetHandle() or warn "Couldn't get handle"; 407 my $MAIL = $mailer->GetHandle() or $self->addbadmessage(CGI::p("Couldn't get handle"));
306 print $MAIL $msg || warn "Couldn't print to $MAIL"; 408 print $MAIL $msg || $self->addbadmessage(CGI::p("Couldn't print to $MAIL"));
307 close $MAIL || warn "Couldn't close $MAIL"; 409 close $MAIL || $self->addbadmessage(CGI::p("Couldn't close $MAIL"));
308 #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject"; 410 #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject";
309 411
310 } 412 }
311 413
312 } else { 414 } else {
313 warn "Didn't recognize button $action"; 415 $self->addbadmessage(CGI::p("Didn't recognize button $action"));
314 } 416 }
315 417
316 418
317 419
318} #end initialize 420} #end initialize
319 421
320 422
321sub title {
322 my $self = shift;
323 return 'Send mail to ' .$self->{ce}->{courseName};
324}
325 423
326sub path { 424
327 my $self = shift;
328 my $args = $_[-1];
329
330 my $ce = $self->{ce};
331 my $root = $ce->{webworkURLs}->{root};
332 my $courseName = $ce->{courseName};
333 return $self->pathMacro($args,
334 "Home" => "$root",
335 $courseName => "$root/$courseName",
336 'instructor' => "$root/$courseName/instructor",
337 "Send Mail to: $courseName" => '',
338 );
339}
340 425
341sub body { 426sub body {
342 my ($self, $setID) = @_; 427 my ($self) = @_;
428 my $r = $self->r;
429 my $urlpath = $r->urlpath;
430 my $authz = $r->authz;
431 my $setID = $urlpath->arg("setID");
343 my $response = (defined($self->{response}))? $self->{response} : ''; 432 my $response = (defined($self->{response}))? $self->{response} : '';
433 my $user = $r->param('user');
434
435 # Check permissions
436 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to access instructor tools"))
437 unless $authz->hasPermissions($user, "access_instructor_tools");
438
439 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to send mail to students"))
440 unless $authz->hasPermissions($user, "send_mail");
441
344 if ($response eq 'preview') { 442 if ($response eq 'preview') {
345 $self->print_preview($setID); 443 $self->print_preview($setID);
346 } elsif (($response eq 'send_email')){ 444 } elsif (($response eq 'send_email')){
445 $self->addgoodmessage(CGI::p("Email sent to ". scalar(@{$self->{ra_send_to}})." students."));
347 $self->{message} .= CGI::h3("Email sent to "). join(" ", @{$self->{ra_send_to}}); 446 $self->{message} .= CGI::i("Email sent to ". scalar(@{$self->{ra_send_to}})." students.");
348 $self->print_form($setID); 447 $self->print_form($setID);
349 } else { 448 } else {
350 $self->print_form($setID); 449 $self->print_form($setID);
351 } 450 }
352 451
353} 452}
354sub print_preview { 453sub print_preview {
355 my ($self, $setID) = @_; 454 my ($self) = @_;
455 my $r = $self->r;
456 my $urlpath = $r->urlpath;
457 my $setID = $urlpath->arg("setID");
458
356 # get preview user 459 # get preview user
357 my $ur = $self->{db}->getUser($self->{preview_user}); 460 my $ur = $r->db->getUser($self->{preview_user}); #checked
461 die "record for preview user ".$self->{preview_user}. " not found." unless $ur;
358 462
359 # get merge file 463 # get merge file
360 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 464 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
361 my $delimiter = ','; 465 my $delimiter = ',';
362 my $rh_merge_data = $self->read_merge_file("$merge_file", "$delimiter"); 466 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
363 467
364 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data); 468 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data);
365 469
366 my $recipients = join(" ",@{$self->{ra_send_to} }); 470 my $recipients = join(" ",@{$self->{ra_send_to} });
367 my $errorMessage = defined($self->{submitError}) ? CGI::h3($self->{submitError} ) : '' ; 471 my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ;
368 $msg = join("", 472 $msg = join("",
369 $errorMessage, 473 $errorMessage,
370 $preview_header, 474 $preview_header,
371 "To: " , $ur->email_address,"\n", 475 "To: " , $ur->email_address,"\n",
372 "From: " , $self->{from} , "\n" , 476 "From: " , $self->{from} , "\n" ,
… …
383 487
384 ); 488 );
385 489
386} 490}
387sub print_form { 491sub print_form {
388 my ($self, $setID) = @_; 492 my ($self) = @_;
389 my $r = $self->{r}; 493 my $r = $self->r;
390 my $authz = $self->{authz}; 494 my $urlpath = $r->urlpath;
495 my $authz = $r->authz;
496 my $db = $r->db;
497 my $ce = $r->ce;
498 my $courseName = $urlpath->arg("courseID");
499 my $setID = $urlpath->arg("setID");
391 my $user = $r->param('user'); 500 my $user = $r->param('user');
392 my $db = $self->{db}; 501
393 my $ce = $self->{ce};
394 my $root = $ce->{webworkURLs}->{root}; 502 my $root = $ce->{webworkURLs}->{root};
395 my $courseName = $ce->{courseName}; 503 my $sendMailPage = $urlpath->newFromModule($urlpath->module,courseID=>$courseName);
504 my $sendMailURL = $self->systemLink($sendMailPage, authen => 0);
396 505
397 return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); 506 return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools");
398 507
399 my $userTemplate = $db->newUser; 508 my $userTemplate = $db->newUser;
400 my $permissionLevelTemplate = $db->newPermissionLevel; 509 my $permissionLevelTemplate = $db->newPermissionLevel;
… …
402 # This code will require changing if the permission and user tables ever have different keys. 511 # This code will require changing if the permission and user tables ever have different keys.
403 my @users = @{ $self->{ra_users} }; 512 my @users = @{ $self->{ra_users} };
404 my $ra_user_records = $self->{ra_user_records}; 513 my $ra_user_records = $self->{ra_user_records};
405 my %classlistLabels = ();# %$hr_classlistLabels; 514 my %classlistLabels = ();# %$hr_classlistLabels;
406 foreach my $ur (@{ $ra_user_records }) { 515 foreach my $ur (@{ $ra_user_records }) {
407 $classlistLabels{$ur->user_id} = $ur->user_id.' '.$ur->last_name. ', '. $ur->first_name.' - '.$ur->section; 516 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation;
408 } 517 }
409 518
519## Mark edit define scrolling list
520 my $scrolling_user_list = scrollingRecordList({
521 name => "classList", ## changed from classList to action
522 request => $r,
523 default_sort => "lnfn",
524 default_format => "lnfn_uid",
525 default_filters => ["all"],
526 size => 5,
527 multiple => 1,
528 }, @{$ra_user_records});
410 529
411############################################################################################################## 530##############################################################################################################
412 531
413 532
414 my $from = $self->{from}; 533 my $from = $self->{from};
… …
421 my $output_file = $self->{output_file}; 540 my $output_file = $self->{output_file};
422 my @sorted_messages = $self->get_message_file_names; 541 my @sorted_messages = $self->get_message_file_names;
423 my @sorted_merge_files = $self->get_merge_file_names; 542 my @sorted_merge_files = $self->get_merge_file_names;
424 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 543 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
425 my $delimiter = ','; 544 my $delimiter = ',';
426 my $rh_merge_data = $self->read_merge_file("$merge_file", "$delimiter"); 545 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
427 my @merge_keys = keys %$rh_merge_data; 546 my @merge_keys = keys %$rh_merge_data;
428 my $preview_user = $self->{preview_user}; 547 my $preview_user = $self->{preview_user};
429 my $preview_record = $db->getUser($preview_user); 548 my $preview_record = $db->getUser($preview_user); # checked
549 die "record for preview user ".$self->{preview_user}. " not found." unless $preview_record;
550
430 551
431############################################################################################# 552#############################################################################################
432 553
433 print CGI::start_form({method=>"post", action=>$r->uri()}); 554 print CGI::start_form({method=>"post", action=>$sendMailURL});
434 print $self->hidden_authen_fields(); 555 print $self->hidden_authen_fields();
435############################################################################################# 556#############################################################################################
436# begin upper table 557# begin upper table
437############################################################################################# 558#############################################################################################
438 559
439 print CGI::start_table({-border=>'2', -cellpadding=>'4'}); 560 print CGI::start_table({-border=>'2', -cellpadding=>'4'});
440 print CGI::Tr({-align=>'left',-valign=>'VCENTER'}, 561 print CGI::Tr({-align=>'left',-valign=>'top'},
441############################################################################################# 562#############################################################################################
442# first column 563# first column
443############################################################################################# 564#############################################################################################
444 565
445 CGI::td("Message file: $input_file","\n",CGI::br(), 566 CGI::td(CGI::strong("Message file: $input_file"),"\n",CGI::br(),
446 CGI::submit(-name=>'action', -value=>'Open'), '&nbsp;&nbsp;&nbsp;&nbsp;',"\n", 567 CGI::submit(-name=>'action', -value=>'Open'), '&nbsp;&nbsp;&nbsp;&nbsp;',"\n",
447 CGI::popup_menu(-name=>'openfilename', 568 CGI::popup_menu(-name=>'openfilename',
448 -values=>\@sorted_messages, 569 -values=>\@sorted_messages,
449 -default=>$input_file 570 -default=>$input_file
450 ), "\n",CGI::br(), 571 ), "\n",CGI::br(),
… …
455 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>30, -override=>1), 576 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>30, -override=>1),
456 ), 577 ),
457############################################################################################# 578#############################################################################################
458# second column 579# second column
459############################################################################################# 580#############################################################################################
460 CGI::td({-align=>'left'}, 581# CGI::td({-align=>'left',style=>'font-size:smaller'},
582#
583# CGI::strong("Send to:"),
461 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], 584# CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'],
462 -labels=>{all_students=>'All active students',studentID => 'Select recipients'}, 585# -labels=>{all_students=>'All students in course',studentID => 'Selected'},
463 -default=>'studentID', 586# -default=>'studentID',
464 -linebreak=>1), 587# -linebreak=>0
465 CGI::br(), 588# ), CGI::br(),CGI::br(),
589## Edit by Mark to insert scrolling list
590 CGI::td({-style=>"width:33%"},CGI::strong("Send to:"),
591 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'],
592 -labels=>{all_students=>'All students in course',studentID => 'Selected students'},
593 -default=>'studentID', -linebreak=>0),
594 CGI::br(),$scrolling_user_list),
595## Edit here to insert filtering
596## be sure to fail GRACEFULLY!
597#
598#
599# CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),,
600# CGI::radio_group(-name=>'sort_by', -values=>['id','alphabetical','section','recitation'],
601# -labels=>{id=>'Login',alphabetical=>'Alph.',section => 'Sec.',recitation=>'Rec.'},
602# -default=>defined($r->param("sort_by")) ? $r->param("sort_by") : 'id',
603# -linebreak=>0
604# ),
605#
606# CGI::br(),CGI::br(),
466 CGI::popup_menu(-name=>'classList', 607# CGI::popup_menu(-name=>'classList',
467 -values=>\@users, 608# -values=>\@users,
468 -labels=>\%classlistLabels, 609# -labels=>\%classlistLabels,
469 -size => 10, 610# -size => 10,
470 -multiple => 1, 611# -multiple => 1,
471 -default=>$user 612# -default=>$user
472 ), 613# ),
614# ),
615
473 616
474 617
475 ), 618
476############################################################################################# 619#############################################################################################
477# third column 620# third column
478############################################################################################# 621#############################################################################################
479 CGI::td({align=>'left'}, 622 CGI::td({align=>'left'},
480 "Merge file is: $merge_file", CGI::br(), 623 "<b>Merge file:</b> $merge_file", CGI::br(),
481 CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(), 624 CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(),
482 CGI::popup_menu(-name=>'merge_file', 625 CGI::popup_menu(-name=>'merge_file',
483 -values=>\@sorted_merge_files, 626 -values=>\@sorted_merge_files,
484 -default=>$merge_file, 627 -default=>$merge_file,
485 ), "\n",CGI::hr(),CGI::br(), 628 ), "\n",CGI::hr(),
486 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview')," email to ", 629 CGI::b("Viewing email for: "), "$preview_user",CGI::br(),
630 CGI::submit(-name=>'action', -value=>'resize', -label=>$REFRESH_RESIZE_BUTTON),'&nbsp;',
487 CGI::popup_menu(-name=>'preview_user', 631 CGI::popup_menu(-name=>'preview_user',
488 -values=>\@users, 632 -values=>\@users,
489 #-labels=>\%classlistLabels, 633 #-labels=>\%classlistLabels,
490 -default=>$preview_user, 634 -default=>$preview_user,
491 ), 635 ),
636 CGI::br(),
637 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview message'),'&nbsp;&nbsp;',
638
639 CGI::br(),
640
492 CGI::hr(), 641 CGI::hr(),
493 CGI::submit(-name=>'action', -value=>'resize', -label=>'Resize message window'),CGI::br(),
494 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), 642 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows),
495 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), 643 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns),
496 CGI::br(),CGI::br(), 644 CGI::br(),CGI::i('Press any action button to update display'),CGI::br(),
497 #show available macros 645 #show available macros
498 CGI::popup_menu( 646 CGI::popup_menu(
499 -name=>'dummyName', 647 -name=>'dummyName',
500 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'], 648 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'],
501 -labels=>{''=>'list of insertable macros', 649 -labels=>{''=>'list of insertable macros',
… …
532# warn "merge keys ", join( " ",@merge_keys); 680# warn "merge keys ", join( " ",@merge_keys);
533############################################################################################# 681#############################################################################################
534# merge file fragment and message text area field 682# merge file fragment and message text area field
535############################################################################################# 683#############################################################################################
536 my @tmp2; 684 my @tmp2;
537 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; 685 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; # checked
538 if ($@) { 686 if ($@ and $merge_file ne 'None') {
539 print CGI::p( "Couldn't get merge data for $preview_user", CGI::br(), $@) ; 687 print "No merge data for $preview_user in merge file: &lt;$merge_file&gt;",CGI::br();
540 } else { 688 } else {
541 print CGI::pre("",data_format(0..($#tmp2)),"\n", data_format(@tmp2)); 689 print CGI::pre("",data_format(1..($#tmp2+1)),"<br>", data_format2(@tmp2));
542 } 690 }
543#create a textbox with the subject and a textarea with the message 691#create a textbox with the subject and a textarea with the message
544#print actual body of message 692#print actual body of message
545 693
546 print "\n", CGI::p( $self->{message}) if defined($self->{message}); 694 print "\n", CGI::p( $self->{message}) if defined($self->{message});
… …
569############################################################################## 717##############################################################################
570# Utility methods 718# Utility methods
571############################################################################## 719##############################################################################
572sub submission_error { 720sub submission_error {
573 my $self = shift; 721 my $self = shift;
574 my $msg = join( " ", @_); 722 my $msg = join( " ", @_);
575 $self->{submitError} .= CGI::br().$msg; #CGI::b(HTML::Entities::encode($msg)); 723 $self->{submitError} .= CGI::br().$msg;
576# qq{Please hit the &quot;<B>Back</B>&quot; button on your browser to 724 return;
577# try again, or notify your web master
578# if you believe this message is in error.
579# };
580 return;
581} 725}
582 726
583sub saveProblem { 727sub saveProblem {
584 my $self = shift; 728 my $self = shift;
585 my ($body, $probFileName)= @_; 729 my ($body, $probFileName)= @_;
586 local(*PROBLEM); 730 local(*PROBLEM);
587 open (PROBLEM, ">$probFileName") || 731 open (PROBLEM, ">$probFileName") ||
588 $self->submission_error("Could not open $probFileName for writing. 732 $self->addbadmessage(CGI::p("Could not open $probFileName for writing.
589 Check that the permissions for this problem are 660 (-rw-rw----)"); 733 Check that the permissions for this problem are 660 (-rw-rw----)"));
590 print PROBLEM $body; 734 print PROBLEM $body if -w $probFileName;
591 close PROBLEM; 735 close PROBLEM;
592 chmod 0660, "$probFileName" || 736 chmod 0660, "$probFileName" ||
593 $self->submission_error("
594 CAN'T CHANGE PERMISSIONS ON FILE $probFileName"); 737 $self->addbadmessage(CGI::p("CAN'T CHANGE PERMISSIONS ON FILE $probFileName"));
595} 738}
596 739
597sub read_input_file { 740sub read_input_file {
598 my $self = shift; 741 my $self = shift;
599 my $filePath = shift; 742 my $filePath = shift;
600 my ($text, @text); 743 my ($text, @text);
601 my $header = ''; 744 my $header = '';
602 my ($subject, $from, $replyTo); 745 my ($subject, $from, $replyTo);
603 local(*FILE); 746 local(*FILE);
604 if (-e "$filePath" and -r "$filePath") { 747 if (-e "$filePath" and -r "$filePath") {
605 open FILE, "$filePath" || do { $self->submission_error("Can't open $filePath"); return}; 748 open FILE, "$filePath" || do { $self->addbadmessage(CGI::p("Can't open $filePath")); return};
606 while ($header !~ s/Message:\s*$//m and not eof(FILE)) { 749 while ($header !~ s/Message:\s*$//m and not eof(FILE)) {
607 $header .= <FILE>; 750 $header .= <FILE>;
608 } 751 }
609 $text = join( '', <FILE>); 752 $text = join( '', <FILE>);
610 $text =~ s/^\s*//; # remove initial white space if any. 753 $text =~ s/^\s*//; # remove initial white space if any.
… …
619 762
620 } else { 763 } else {
621 $from = $self->{defaultFrom}; 764 $from = $self->{defaultFrom};
622 $replyTo = $self->{defaultReply}; 765 $replyTo = $self->{defaultReply};
623 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist"; 766 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist";
624 $subject = "FIXME default subject"; 767 $subject = $self->{defaultSubject};
625 } 768 }
626 return ($from, $replyTo, $subject, \$text); 769 return ($from, $replyTo, $subject, \$text);
627} 770}
628 771
772
629sub get_message_file_names { 773sub get_message_file_names {
630 my $self = shift; 774 my $self = shift;
631 my $emailDirectory = $self->{ce}->{courseDirs}->{email}; 775 return $self->read_dir($self->{ce}->{courseDirs}->{email}, '\\.msg$');
632 #get all message files and create a list
633 local(*EMAILDIR);
634 opendir( EMAILDIR, $emailDirectory )|| die "Can't access directory $emailDirectory. Please check that webserver has permission to read this directory.";
635 my @messageFiles = grep /\.msg$/, readdir EMAILDIR; #all message files
636 closedir EMAILDIR;
637
638 return sort @messageFiles;
639} 776}
640sub get_merge_file_names { 777sub get_merge_file_names {
641 my $self = shift;
642 my $scoringDirectory = $self->{ce}->{courseDirs}->{scoring};
643 #get all message files and create a list
644 local(*SCORINGDIR);
645 opendir( SCORINGDIR, $scoringDirectory )|| die "Can't access directory $scoringDirectory.",
646 "Please check that webserver has permission to read this directory.";
647 my @mergeFiles = grep( /\.csv$/, readdir SCORINGDIR); #all message files
648 closedir SCORINGDIR;
649 @mergeFiles = sort @mergeFiles;
650# warn "FIXME scoring directory $scoringDirectory merge Files", join(" ", @mergeFiles);
651 unshift(@mergeFiles, 'None');
652 return @mergeFiles;
653}
654
655sub read_merge_file {
656 my $self = shift; 778 my $self = shift;
657 my $fileName = shift; 779 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed.
658 my $delimiter = shift;
659 $delimiter = ',' unless defined($delimiter);
660 my $scoringDirectory= $self->{ce}->{courseDirs}->{scoring};
661 my $filePath = "$scoringDirectory/$fileName";
662 # Takes a delimited file as a parameter and returns an
663 # associative array with the first field as the key.
664 # Blank lines are skipped. White space is removed
665 my(@dbArray,$key,$dbString);
666 my %assocArray = ();
667 local(*FILE);
668 if ($fileName eq 'None') {
669 # do nothing
670 } elsif ( open(FILE, "$filePath") ) {
671 my $index=0;
672 while (<FILE>){
673 unless ($_ =~ /\S/) {next;} ## skip blank lines
674 chomp;
675 @{$dbArray[$index]} =$self->getRecord($_,$delimiter);
676 $key =$dbArray[$index][0];
677 #@dbArray = map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} @dbArray;
678 #$dbString = join(" | ",@dbArray);
679 $assocArray{$key}=$dbArray[$index];
680 $index++;
681 }
682 close(FILE);
683 } else {
684 warn "Couldn't read file $filePath";
685 }
686 return \%assocArray;
687} 780}
781
782
688sub getRecord { 783sub getRecord {
689 my $self = shift; 784 my $self = shift;
690 my $line = shift; 785 my $line = shift;
691 my $delimiter = shift; 786 my $delimiter = shift;
692 $delimiter = ',' unless defined($delimiter); 787 $delimiter = ',' unless defined($delimiter);
… …
696 # last field is empty, the last element of the returned 791 # last field is empty, the last element of the returned
697 # array is also empty (unlike what the perl split command 792 # array is also empty (unlike what the perl split command
698 # would return). E.G. @lineArray=&getRecord(\$delimitedLine). 793 # would return). E.G. @lineArray=&getRecord(\$delimitedLine).
699 794
700 my(@lineArray); 795 my(@lineArray);
701 $line.=$delimiter; # add 'A' to end of line so that 796 $line.="${delimiter}___"; # add final field which must be non-empty
702 # last field is never empty
703 @lineArray = split(/\s*${delimiter}\s*/,$line); 797 @lineArray = split(/\s*${delimiter}\s*/,$line); # split line into fields
704 $lineArray[0] =~s/^\s*//; # remove white space from first element 798 $lineArray[0] =~s/^\s*//; # remove white space from first element
799 pop @lineArray; # remove the last artificial field
705 @lineArray; 800 @lineArray;
706} 801}
707 802
708sub process_message { 803sub process_message {
709 my $self = shift; 804 my $self = shift;
710 my $ur = shift; 805 my $ur = shift;
711 my $rh_merge_data = shift; 806 my $rh_merge_data = shift;
712 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 807 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }:
713 'FIXME no text was produced by initialization!!'; 808 'FIXME no text was produced by initialization!!';
809 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
714 #user macros that can be used in the email message 810 #user macros that can be used in the email message
715 my $SID = $ur->student_id; 811 my $SID = $ur->student_id;
716 my $FN = $ur->first_name; 812 my $FN = $ur->first_name;
717 my $LN = $ur->last_name; 813 my $LN = $ur->last_name;
718 my $SECTION = $ur->section; 814 my $SECTION = $ur->section;
719 my $RECITATION = $ur->recitation; 815 my $RECITATION = $ur->recitation;
720 my $STATUS = $ur->status; 816 my $STATUS = $ur->status;
721 my $EMAIL = $ur->email_address; 817 my $EMAIL = $ur->email_address;
722 my $LOGIN = $ur->user_id; 818 my $LOGIN = $ur->user_id;
819
723 # get record from merge file 820 # get record from merge file
724 # FIXME this is inefficient. The info should be cached 821 # FIXME this is inefficient. The info should be cached
725 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); 822 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : ();
726 $self->submission_error( "No merge data for $SID $FN $LN $LOGIN") unless defined($rh_merge_data->{$SID}); 823 if ($merge_file ne 'None' && not defined($rh_merge_data->{$SID}) ) {
727 824 $self->addbadmessage(CGI::p("No merge data for student id:$SID; name:$FN $LN; login:$LOGIN"));
825 }
826 unshift(@COL,""); ## this makes COL[1] the first column
728 my $endCol = @COL; 827 my $endCol = @COL;
729 # for safety, only evaluate special variables 828 # for safety, only evaluate special variables
730 my $msg = $text; 829 my $msg = $text;
731 $msg =~ s/(\$SID)/eval($1)/ge; 830 $msg =~ s/(\$SID)/eval($1)/ge;
732 $msg =~ s/(\$LN)/eval($1)/ge; 831 $msg =~ s/(\$LN)/eval($1)/ge;
… …
734 $msg =~ s/(\$STATUS)/eval($1)/ge; 833 $msg =~ s/(\$STATUS)/eval($1)/ge;
735 $msg =~ s/(\$SECTION)/eval($1)/ge; 834 $msg =~ s/(\$SECTION)/eval($1)/ge;
736 $msg =~ s/(\$RECITATION)/eval($1)/ge; 835 $msg =~ s/(\$RECITATION)/eval($1)/ge;
737 $msg =~ s/(\$EMAIL)/eval($1)/ge; 836 $msg =~ s/(\$EMAIL)/eval($1)/ge;
738 $msg =~ s/(\$LOGIN)/eval($1)/ge; 837 $msg =~ s/(\$LOGIN)/eval($1)/ge;
739 $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g; 838# $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g; ## Perl handles negative indexes correctly, so there is no need to do this
740 $msg =~ s/(\$COL\[.*?\])/eval($1)/ge; 839 $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1]/ge if defined($COL[1]); # prevents extraneous error messages.
741 840
742 $msg =~ s/\r//g; 841 $msg =~ s/\r//g;
743 842
843 my @preview_COL = @COL;
844 shift @preview_COL; ## shift back for preview
744 my $preview_header = CGI::pre("",data_format(0..($#COL)),"\n", data_format(@COL)). 845 my $preview_header = CGI::pre("",data_format(1..($#COL)),"<br>", data_format2(@preview_COL)).
745 CGI::h3( "This sample mail would be sent to $EMAIL"); 846 CGI::h3( "This sample mail would be sent to $EMAIL");
746 847
747
748 return $msg, $preview_header; 848 return $msg, $preview_header;
749} 849}
850
851
852# Ê sub data_format {
853#
854# Ê Ê Ê Ê Êmap {$_ =~s/\s/\./g;$_} Ê Ê map {sprintf('%-8.8s',$_);} Ê@_;
750 sub data_format { 855 sub data_format {
856 map {"COL[$_]".'&nbsp;'x(3-length($_));} @_; # problems if $_ has length bigger than 4
857 }
858 sub data_format2 {
751 map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} @_; 859 map {$_ =~s/\s/&nbsp;/g;$_} map {sprintf('%-8.8s',$_);} @_;
752 } 860 }
7531; 8611;
Legend:
Removed from v.1376  
changed lines
  Added in v.2786
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9