Parent Directory
| 
Revision Log
Mail merge does not report error when the merge file selected is "None". --Mike
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.16 2004/01/17 19:30:22 gage Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::ContentGenerator::Instructor::SendMail; 18 use base qw(WeBWorK::ContentGenerator::Instructor); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Instructor::SendMail - Entry point for User-specific data editing 23 24 =cut 25 26 use strict; 27 use warnings; 28 use CGI qw(); 29 #use HTML::Entities; 30 use Mail::Sender; 31 32 my $REFRESH_RESIZE_BUTTON = "Reorder, Resize and Update"; # handle submit value idiocy 33 sub initialize { 34 my ($self) = @_; 35 my $r = $self->{r}; 36 my $db = $self->{db}; 37 my $ce = $self->{ce}; 38 my $authz = $self->{authz}; 39 my $user = $r->param('user'); 40 41 unless ($authz->hasPermissions($user, "send_mail")) { 42 $self->{submitError} = "You are not authorized to send mail to students."; 43 return; 44 } 45 ############################################################################################# 46 # gather directory data 47 ############################################################################################# 48 my $emailDirectory = $ce->{courseDirs}->{email}; 49 my $scoringDirectory = $ce->{courseDirs}->{scoring}; 50 my $templateDirectory = $ce->{courseDirs}->{templates}; 51 52 my $action = $r->param('action'); 53 my $openfilename = $r->param('openfilename'); 54 my $savefilename = $r->param('savefilename'); 55 56 57 #FIXME get these values from global course environment (see subroutines as well) 58 my $default_msg_file = 'default.msg'; 59 my $old_default_msg_file = 'old_default.msg'; 60 61 62 # store data 63 $self->{defaultFrom} = 'FIXME from'; 64 $self->{defaultReply} = 'FIXME reply'; 65 $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}; 67 $self->{default_msg_file} = $default_msg_file; 68 $self->{old_default_msg_file} = $old_default_msg_file; 69 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None'; 70 $self->{preview_user} = (defined($r->param('preview_user'))) ? $r->param('preview_user') : $user; 71 72 73 ############################################################################################# 74 # gather database data 75 ############################################################################################# 76 # FIXME this might be better done in body? We don't always need all of this data. or do we? 77 my @users = sort $db->listUsers; 78 my @user_records = (); 79 foreach my $userName (@users) { 80 my $userRecord = $db->getUser($userName); # checked 81 die "record for user $userName not found" unless $userRecord; 82 push(@user_records, $userRecord); 83 } 84 ########################### 85 # Sort the users for presentation in the select list 86 ########################### 87 if (defined $r->param("sort_by") ) { 88 my $sort_method = $r->param("sort_by"); 89 if ($sort_method eq 'section') { 90 @user_records = sort { (lc($a->section) cmp lc($b->section)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records; 91 } elsif ($sort_method eq 'recitation') { 92 @user_records = sort { (lc($a->recitation) cmp lc($b->recitation)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records; 93 } elsif ($sort_method eq 'alphabetical') { 94 @user_records = sort { (lc($a->last_name) cmp lc($b->last_name)) } @user_records; 95 } 96 } 97 98 99 # replace the user names by a sorted version. 100 @users = map {$_->user_id} @user_records; 101 # store data 102 $self->{ra_users} = \@users; 103 $self->{ra_user_records} = \@user_records; 104 105 ############################################################################################# 106 # gather list of recipients 107 ############################################################################################# 108 my @send_to = (); 109 #FIXME this (radio) is a lousy name 110 my $recipients = $r->param('radio'); 111 if (defined($recipients) and $recipients eq 'all_students') { #only active students #FIXME status check?? 112 foreach my $ur (@user_records) { 113 push(@send_to,$ur->user_id) if $ur->status eq 'C' and not($ur->user_id =~ /practice/); 114 } 115 } elsif (defined($recipients) and $recipients eq 'studentID' ) { 116 @send_to = $r->param('classList'); 117 } else { 118 # no recipients have been defined -- probably the first time on the page 119 } 120 $self->{ra_send_to} = \@send_to; 121 ################################################################# 122 # Check the validity of the input file name 123 ################################################################# 124 my $input_file = ''; 125 #make sure an input message file was submitted and exists 126 #else use the default message 127 if ( defined($openfilename) ) { 128 if ( -e "${emailDirectory}/$openfilename") { 129 if ( -R "${emailDirectory}/$openfilename") { 130 $input_file = $openfilename; 131 } else { 132 warn join("", 133 "The file ${emailDirectory}/$openfilename is not readable by the webserver.",CGI::br(), 134 "Check that it's permissions are set correctly.", 135 ); 136 } 137 } else { 138 $input_file = $default_msg_file; 139 warn join("", 140 "The file ${emailDirectory}/$openfilename cannot be found.",CGI::br(), 141 "Check whether it exists and whether the directory $emailDirectory can be read by the webserver.",CGI::br(), 142 "Using contents of the default message $default_msg_file instead.", 143 ); 144 } 145 } else { 146 $input_file = $default_msg_file; 147 } 148 $self->{input_file} =$input_file; 149 150 ################################################################# 151 # Determine the file name to save message into 152 ################################################################# 153 my $output_file = 'FIXME no output file specified'; 154 if (defined($action) and $action eq 'Save as Default') { 155 $output_file = $default_msg_file; 156 } elsif ( defined($action) and ($action =~/save/i) and defined($savefilename) ){ 157 $output_file = $savefilename; 158 } elsif ( defined($input_file) ) { 159 $output_file = $input_file; 160 } 161 # warn "FIXME savefilename $savefilename output file $output_file"; 162 ################################################################# 163 # Sanity check on save file name 164 ################################################################# 165 166 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) { 167 $self->submission_error("For security reasons, you cannot specify a message file from a directory", 168 "higher than the email directory (you can't use ../blah/blah for example). ", 169 "Please specify a different file or move the needed file to the email directory", 170 ); 171 } 172 unless ($output_file =~ m|\.msg$| ) { 173 $self->submission_error("Invalid file name.", 174 "The file name \"$output_file\" does not have a \".msg\" extension", 175 "All email file names must end in the extension \".msg\"", 176 "choose a file name with a \".msg\" extension.", 177 "The message was not saved.", 178 ); 179 } 180 $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing. 181 # FIXME $output_file can be blank if there was no savefilename 182 183 ############################################################################################# 184 # Determine input source 185 ############################################################################################# 186 my $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file'; 187 # warn "FIXME input source is $input_source from $input_file"; 188 ############################################################################################# 189 # Get inputs 190 ############################################################################################# 191 my($from, $replyTo, $r_text, $subject); 192 if ($input_source eq 'file') { 193 # warn "FIXME obtaining source from $emailDirectory/$input_file"; 194 ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file"); 195 # warn "FIXME Done reading source"; 196 197 } elsif ($input_source eq 'form') { 198 # read info from the form 199 # bail if there is no message body 200 201 $from = $r->param('from'); 202 $replyTo = $r->param('replyTo'); 203 $subject = $r->param('subject'); 204 my $body = $r->param('body'); 205 # Sanity check: body must contain non-white space 206 $self->submission_error('You didn\'t enter any message.') unless ($r->param('body') =~ /\S/); 207 $r_text = \$body; 208 209 } 210 # store data 211 $self->{from} = $from; 212 $self->{replyTo} = $replyTo; 213 $self->{subject} = $subject; 214 $self->{r_text} = $r_text; 215 216 217 218 ################################################################################### 219 #Determine the appropriate script action from the buttons 220 ################################################################################### 221 # first time actions 222 # open new file 223 # open default file 224 # choose merge file actions 225 # chose merge button 226 # option actions 227 # 'reset rows' 228 229 # save actions 230 # "save" button 231 # "save as" button 232 # "save as default" button 233 # preview actions 234 # 'preview' button 235 # email actions 236 # 'entire class' 237 # 'selected studentIDs' 238 # error actions (various) 239 240 241 ############################################################################################# 242 # if no form is submitted, gather data needed to produce the mail form and return 243 ############################################################################################# 244 my $to = $r->param('To'); 245 my $script_action = ''; 246 247 248 if(not defined($action) or $action eq 'Open' or $action eq $REFRESH_RESIZE_BUTTON 249 or $action eq 'Set merge file to:' ){ 250 # warn "FIXME action is |$action| no further initialization required"; 251 return ''; 252 } 253 254 255 256 257 258 ############################################################################################# 259 # If form is submitted deal with filled out forms 260 # and various actions resulting from different buttons 261 ############################################################################################# 262 263 264 if ($action eq 'Save' or $action eq 'Save as:' or $action eq 'Save as Default') { 265 266 # warn "FIXME Saving files action = $action outputFileName=$output_file"; 267 268 ################################################################# 269 # construct message body 270 ################################################################# 271 my $temp_body = ${ $r_text }; 272 $temp_body =~ s/\r\n/\n/g; 273 $temp_body = join("", 274 "From: $from \nReply-To: $replyTo\n" , 275 "Subject: $subject\n" , 276 "Message: \n $temp_body"); 277 # warn "FIXME from $from | subject $subject |reply $replyTo|msg $temp_body"; 278 ################################################################# 279 # overwrite protection 280 ################################################################# 281 if ($action eq 'Save as:' and -e "$emailDirectory/$output_file") { 282 $self->submission_error("The file $emailDirectory/$output_file already exists and cannot be overwritten", 283 "The message was not saved"); 284 return; 285 } 286 287 ################################################################# 288 # Back up existing file? 289 ################################################################# 290 if ($action eq 'Save as Default' and -e "$emailDirectory/$default_msg_file") { 291 rename("$emailDirectory/$default_msg_file","$emailDirectory/$old_default_msg_file") or 292 die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ", 293 "Check permissions for webserver on directory $emailDirectory. $!"; 294 $self->{message} .= "Backup file <code>$emailDirectory/$old_default_msg_file</code> created.".CGI::br(); 295 } 296 ################################################################# 297 # Save the message 298 ################################################################# 299 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ); 300 $self->{message} .= "Message saved to file <code>${emailDirectory}/$output_file</code>."; 301 # warn "FIXME saving to ${emailDirectory}/$output_file"; 302 } elsif ($action eq 'Preview') { 303 $self->{response} = 'preview'; 304 305 } elsif ($action eq 'Send Email') { 306 $self->{response} = 'send_email'; 307 308 my @recipients = @{$self->{ra_send_to}}; 309 warn "No recipients selected " unless @recipients; 310 # get merge file 311 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 312 my $delimiter = ','; 313 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 314 unless (ref($rh_merge_data) ) { 315 warn "no merge data file"; 316 $self->submission_error("Can't read merge file $merge_file. No message sent"); 317 return; 318 } ; 319 320 321 foreach my $recipient (@recipients) { 322 #warn "FIXME sending email to $recipient"; 323 my $ur = $self->{db}->getUser($recipient); #checked 324 die "record for user $recipient not found" unless $ur; 325 unless ($ur->email_address) { 326 warn "user $recipient does not have an email address -- skipping"; 327 next; 328 } 329 my ($msg, $preview_header); 330 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); }; 331 warn "There were errors in processing user $ur, merge file $merge_file. $@" if $@; 332 my $mailer = Mail::Sender->new({ 333 from => $from, 334 to => $ur->email_address, 335 smtp => $ce->{mail}->{smtpServer}, 336 subject => $subject, 337 headers => "X-Remote-Host: ".$r->get_remote_host(), 338 }); 339 unless (ref $mailer) { 340 warn "Failed to create a mailer for user $recipient: $Mail::Sender::Error"; 341 next; 342 } 343 unless (ref $mailer->Open()) { 344 warn "Failed to open the mailer for user $recipient: $Mail::Sender::Error"; 345 next; 346 } 347 my $MAIL = $mailer->GetHandle() or warn "Couldn't get handle"; 348 print $MAIL $msg || warn "Couldn't print to $MAIL"; 349 close $MAIL || warn "Couldn't close $MAIL"; 350 #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject"; 351 352 } 353 354 } else { 355 warn "Didn't recognize button $action"; 356 } 357 358 359 360 } #end initialize 361 362 363 sub title { 364 my $self = shift; 365 return 'Mail Merge'; 366 } 367 368 sub path { 369 my $self = shift; 370 my $args = $_[-1]; 371 372 my $ce = $self->{ce}; 373 my $root = $ce->{webworkURLs}->{root}; 374 my $courseName = $ce->{courseName}; 375 return $self->pathMacro($args, 376 "Home" => "$root", 377 $courseName => "$root/$courseName", 378 'Instructor Tools' => "$root/$courseName/instructor", 379 "Mail Merge" => '', # "$root/$courseName/instructor/send_mail", 380 ); 381 } 382 383 sub body { 384 my ($self, $setID) = @_; 385 my $response = (defined($self->{response}))? $self->{response} : ''; 386 if ($response eq 'preview') { 387 $self->print_preview($setID); 388 } elsif (($response eq 'send_email')){ 389 $self->{message} .= CGI::h3("Email sent to "). join(" ", @{$self->{ra_send_to}}); 390 $self->print_form($setID); 391 } else { 392 $self->print_form($setID); 393 } 394 395 } 396 sub print_preview { 397 my ($self, $setID) = @_; 398 # get preview user 399 my $ur = $self->{db}->getUser($self->{preview_user}); #checked 400 die "record for preview user ".$self->{preview_user}. " not found." unless $ur; 401 402 # get merge file 403 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 404 my $delimiter = ','; 405 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 406 407 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data); 408 409 my $recipients = join(" ",@{$self->{ra_send_to} }); 410 my $errorMessage = defined($self->{submitError}) ? CGI::h3($self->{submitError} ) : '' ; 411 $msg = join("", 412 $errorMessage, 413 $preview_header, 414 "To: " , $ur->email_address,"\n", 415 "From: " , $self->{from} , "\n" , 416 "Reply-To: " , $self->{replyTo} , "\n" , 417 "Subject: " , $self->{subject} , "\n" ,"\n" , 418 $msg , "\n" 419 ); 420 421 return join("", '<pre>',$msg,"\n","\n", 422 '</pre>', 423 CGI::p('Use browser back button to return from preview mode'), 424 CGI::h3('Emails to be sent to the following:'), 425 $recipients, "\n", 426 427 ); 428 429 } 430 sub print_form { 431 my ($self, $setID) = @_; 432 my $r = $self->{r}; 433 my $authz = $self->{authz}; 434 my $user = $r->param('user'); 435 my $db = $self->{db}; 436 my $ce = $self->{ce}; 437 my $root = $ce->{webworkURLs}->{root}; 438 my $courseName = $ce->{courseName}; 439 440 return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); 441 442 my $userTemplate = $db->newUser; 443 my $permissionLevelTemplate = $db->newPermissionLevel; 444 445 # This code will require changing if the permission and user tables ever have different keys. 446 my @users = @{ $self->{ra_users} }; 447 my $ra_user_records = $self->{ra_user_records}; 448 my %classlistLabels = ();# %$hr_classlistLabels; 449 foreach my $ur (@{ $ra_user_records }) { 450 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation; 451 } 452 453 454 ############################################################################################################## 455 456 457 my $from = $self->{from}; 458 my $subject = $self->{subject}; 459 my $replyTo = $self->{replyTo}; 460 my $columns = $self->{columns}; 461 my $rows = $self->{rows}; 462 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 'FIXME no text was produced by initialization!!'; 463 my $input_file = $self->{input_file}; 464 my $output_file = $self->{output_file}; 465 my @sorted_messages = $self->get_message_file_names; 466 my @sorted_merge_files = $self->get_merge_file_names; 467 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 468 my $delimiter = ','; 469 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 470 my @merge_keys = keys %$rh_merge_data; 471 my $preview_user = $self->{preview_user}; 472 my $preview_record = $db->getUser($preview_user); # checked 473 die "record for preview user ".$self->{preview_user}. " not found." unless $preview_record; 474 475 476 ############################################################################################# 477 478 print CGI::start_form({method=>"post", action=>$r->uri()}); 479 print $self->hidden_authen_fields(); 480 ############################################################################################# 481 # begin upper table 482 ############################################################################################# 483 484 print CGI::start_table({-border=>'2', -cellpadding=>'4'}); 485 print CGI::Tr({-align=>'left',-valign=>'top'}, 486 ############################################################################################# 487 # first column 488 ############################################################################################# 489 490 CGI::td(CGI::strong("Message file: $input_file"),"\n",CGI::br(), 491 CGI::submit(-name=>'action', -value=>'Open'), ' ',"\n", 492 CGI::popup_menu(-name=>'openfilename', 493 -values=>\@sorted_messages, 494 -default=>$input_file 495 ), "\n",CGI::br(), 496 497 "Save file to: $output_file","\n",CGI::br(), 498 "\n", 'From:',' ', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1), 499 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1), 500 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>30, -override=>1), 501 ), 502 ############################################################################################# 503 # second column 504 ############################################################################################# 505 CGI::td({-align=>'center'}, 506 CGI::start_table({-border=>'0', -cellpadding=>'1',-width=>"100%"}), 507 CGI::Tr( 508 CGI::td({valign => 'top'}, 509 CGI::strong("Send to:"),CGI::br(), 510 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], 511 -labels=>{all_students=>'All',studentID => 'Selected'}, 512 -default=>'studentID', 513 -linebreak=>1 514 ), 515 ), 516 CGI::td({valign => 'top'}, 517 CGI::strong("Sort by:"), 518 CGI::radio_group(-name=>'sort_by', -values=>['id','alphabetical','section','recitation'], 519 -labels=>{id=>'Id',alphabetical=>'Alph.',section => 'Sec.',recitation=>'Rec.'}, 520 -default=>defined($r->param("sort_by")) ? $r->param("sort_by") : 'id', 521 -linebreak=>1 522 ), 523 524 ), 525 ), 526 CGI::end_table(), 527 CGI::popup_menu(-name=>'classList', 528 -values=>\@users, 529 -labels=>\%classlistLabels, 530 -size => 10, 531 -multiple => 1, 532 -default=>$user 533 ), 534 ), 535 536 537 ############################################################################################# 538 # third column 539 ############################################################################################# 540 CGI::td({align=>'left'}, 541 "<b>Merge file:</b> $merge_file", CGI::br(), 542 CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(), 543 CGI::popup_menu(-name=>'merge_file', 544 -values=>\@sorted_merge_files, 545 -default=>$merge_file, 546 ), "\n",CGI::hr(),CGI::br(), 547 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview')," email to ", 548 CGI::popup_menu(-name=>'preview_user', 549 -values=>\@users, 550 #-labels=>\%classlistLabels, 551 -default=>$preview_user, 552 ), 553 CGI::hr(), 554 CGI::submit(-name=>'action', -value=>'resize', -label=>$REFRESH_RESIZE_BUTTON),CGI::br(), 555 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), 556 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), 557 CGI::br(),CGI::br(), 558 #show available macros 559 CGI::popup_menu( 560 -name=>'dummyName', 561 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'], 562 -labels=>{''=>'list of insertable macros', 563 '$SID'=>'$SID - Student ID', 564 '$FN'=>'$FN - First name', 565 '$LN'=>'$LN - Last name', 566 '$SECTION'=>'$SECTION', 567 '$RECITATION'=>'$RECITATION', 568 '$STATUS'=>'$STATUS - C, Audit, Drop, etc.', 569 '$EMAIL'=>'$EMAIL - Email address', 570 '$LOGIN'=>'$LOGIN - Login', 571 '$COL[3]'=>'$COL[3] - 3rd col', 572 '$COL[-1]'=>'$COL[-1] - Last column' 573 } 574 ), "\n", 575 ), 576 577 ); # end Tr 578 print CGI::end_table(); 579 ############################################################################################# 580 # end upper table 581 ############################################################################################# 582 583 # show merge file 584 # print "<pre>",(map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} 0..8),"</pre>"; 585 # print CGI::popup_menu( 586 # -name=>'dummyName2', 587 # -values=>\@merge_keys, 588 # -labels=>$rh_merge_data, 589 # -multiple=>1, 590 # -size =>2, 591 # 592 # ), "\n",CGI::br(); 593 # warn "merge keys ", join( " ",@merge_keys); 594 ############################################################################################# 595 # merge file fragment and message text area field 596 ############################################################################################# 597 my @tmp2; 598 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; # checked 599 if ($@ and $merge_file ne 'None') { 600 print "No merge data for $preview_user in merge file: <$merge_file>",CGI::br(); 601 } else { 602 print CGI::pre("",data_format(0..($#tmp2)),"\n", data_format(@tmp2)); 603 } 604 #create a textbox with the subject and a textarea with the message 605 #print actual body of message 606 607 print "\n", CGI::p( $self->{message}) if defined($self->{message}); 608 print "\n", CGI::p( CGI::textarea(-name=>'body', -default=>$text, -rows=>$rows, -columns=>$columns, -override=>1)); 609 610 ############################################################################################# 611 # action button table 612 ############################################################################################# 613 print CGI::table( { -border=>2,-cellpadding=>4}, 614 CGI::Tr( 615 CGI::td( CGI::submit(-name=>'action', -value=>'Send Email') ), "\n", 616 CGI::td(CGI::submit(-name=>'action', -value=>'Save')," to $output_file"), " \n", 617 CGI::td(CGI::submit(-name=>'action', -value=>'Save as:'), 618 CGI::textfield(-name=>'savefilename', -size => 20, -value=> "$output_file", -override=>1) 619 ), "\n", 620 CGI::td(CGI::submit(-name=>'action', -value=>'Save as Default')), 621 ) 622 ); 623 624 ############################################################################################################## 625 626 print CGI::end_form(); 627 return ""; 628 } 629 630 ############################################################################## 631 # Utility methods 632 ############################################################################## 633 sub submission_error { 634 my $self = shift; 635 my $msg = join( " ", @_); 636 $self->{submitError} .= CGI::br().$msg; 637 return; 638 } 639 640 sub saveProblem { 641 my $self = shift; 642 my ($body, $probFileName)= @_; 643 local(*PROBLEM); 644 open (PROBLEM, ">$probFileName") || 645 $self->submission_error("Could not open $probFileName for writing. 646 Check that the permissions for this problem are 660 (-rw-rw----)"); 647 print PROBLEM $body; 648 close PROBLEM; 649 chmod 0660, "$probFileName" || 650 $self->submission_error(" 651 CAN'T CHANGE PERMISSIONS ON FILE $probFileName"); 652 } 653 654 sub read_input_file { 655 my $self = shift; 656 my $filePath = shift; 657 my ($text, @text); 658 my $header = ''; 659 my ($subject, $from, $replyTo); 660 local(*FILE); 661 if (-e "$filePath" and -r "$filePath") { 662 open FILE, "$filePath" || do { $self->submission_error("Can't open $filePath"); return}; 663 while ($header !~ s/Message:\s*$//m and not eof(FILE)) { 664 $header .= <FILE>; 665 } 666 $text = join( '', <FILE>); 667 $text =~ s/^\s*//; # remove initial white space if any. 668 $header =~ /^From:\s(.*)$/m; 669 $from = $1 or $from = $self->{defaultFrom}; 670 671 $header =~ /^Reply-To:\s(.*)$/m; 672 $replyTo = $1 or $replyTo = $self->{defaultReply}; 673 674 $header =~ /^Subject:\s(.*)$/m; 675 $subject = $1; 676 677 } else { 678 $from = $self->{defaultFrom}; 679 $replyTo = $self->{defaultReply}; 680 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist"; 681 $subject = "FIXME default subject"; 682 } 683 return ($from, $replyTo, $subject, \$text); 684 } 685 686 687 sub get_message_file_names { 688 my $self = shift; 689 return $self->read_dir($self->{ce}->{courseDirs}->{email}, '\\.msg$'); 690 } 691 sub get_merge_file_names { 692 my $self = shift; 693 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed. 694 } 695 696 697 sub getRecord { 698 my $self = shift; 699 my $line = shift; 700 my $delimiter = shift; 701 $delimiter = ',' unless defined($delimiter); 702 703 # Takes a delimited line as a parameter and returns an 704 # array. Note that all white space is removed. If the 705 # last field is empty, the last element of the returned 706 # array is also empty (unlike what the perl split command 707 # would return). E.G. @lineArray=&getRecord(\$delimitedLine). 708 709 my(@lineArray); 710 $line.=$delimiter; # add 'A' to end of line so that 711 # last field is never empty 712 @lineArray = split(/\s*${delimiter}\s*/,$line); 713 $lineArray[0] =~s/^\s*//; # remove white space from first element 714 @lineArray; 715 } 716 717 sub process_message { 718 my $self = shift; 719 my $ur = shift; 720 my $rh_merge_data = shift; 721 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 722 'FIXME no text was produced by initialization!!'; 723 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 724 #user macros that can be used in the email message 725 my $SID = $ur->student_id; 726 my $FN = $ur->first_name; 727 my $LN = $ur->last_name; 728 my $SECTION = $ur->section; 729 my $RECITATION = $ur->recitation; 730 my $STATUS = $ur->status; 731 my $EMAIL = $ur->email_address; 732 my $LOGIN = $ur->user_id; 733 734 # get record from merge file 735 # FIXME this is inefficient. The info should be cached 736 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); 737 if ($merge_file ne 'None' && not defined($rh_merge_data->{$SID}) ) { 738 $self->submission_error( "No merge data for $SID $FN $LN $LOGIN"); 739 } 740 741 my $endCol = @COL; 742 # for safety, only evaluate special variables 743 my $msg = $text; 744 $msg =~ s/(\$SID)/eval($1)/ge; 745 $msg =~ s/(\$LN)/eval($1)/ge; 746 $msg =~ s/(\$FN)/eval($1)/ge; 747 $msg =~ s/(\$STATUS)/eval($1)/ge; 748 $msg =~ s/(\$SECTION)/eval($1)/ge; 749 $msg =~ s/(\$RECITATION)/eval($1)/ge; 750 $msg =~ s/(\$EMAIL)/eval($1)/ge; 751 $msg =~ s/(\$LOGIN)/eval($1)/ge; 752 $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g; 753 $msg =~ s/(\$COL\[.*?\])/eval($1)/ge; 754 755 $msg =~ s/\r//g; 756 757 my $preview_header = CGI::pre("",data_format(0..($#COL)),"\n", data_format(@COL)). 758 CGI::h3( "This sample mail would be sent to $EMAIL"); 759 760 761 return $msg, $preview_header; 762 } 763 sub data_format { 764 map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} @_; 765 } 766 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |