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