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