Parent Directory
| 
Revision Log
Fixed some bugs where defaults were not always initialized. --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 (defined($recipients) and $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 (defined($recipients) and $recipients eq 'studentID' ) { 79 @send_to = $r->param('classList'); 80 } else { 81 # no recipients have been defined -- probably the first time on the page 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 'Set merge file to:' ){ 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 } else { 358 $self->print_form($setID); 359 } 360 361 } 362 sub print_preview { 363 my ($self, $setID) = @_; 364 # get preview user 365 my $ur = $self->{db}->getUser($self->{preview_user}); 366 367 # get merge file 368 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 369 my $delimiter = ','; 370 my $rh_merge_data = $self->read_merge_file("$merge_file", "$delimiter"); 371 372 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data); 373 374 my $recipients = join(" ",@{$self->{ra_send_to} }); 375 my $errorMessage = defined($self->{submitError}) ? CGI::h3($self->{submitError} ) : '' ; 376 $msg = join("", 377 $errorMessage, 378 $preview_header, 379 "To: " , $ur->email_address,"\n", 380 "From: " , $self->{from} , "\n" , 381 "Reply-To: " , $self->{replyTo} , "\n" , 382 "Subject: " , $self->{subject} , "\n" ,"\n" , 383 $msg , "\n" 384 ); 385 386 return join("", '<pre>',$msg,"\n","\n", 387 '</pre>', 388 CGI::p('Use browser back button to return from preview mode'), 389 CGI::h3('Emails to be sent to the following:'), 390 $recipients, "\n", 391 392 ); 393 394 } 395 sub print_form { 396 my ($self, $setID) = @_; 397 my $r = $self->{r}; 398 my $authz = $self->{authz}; 399 my $user = $r->param('user'); 400 my $db = $self->{db}; 401 my $ce = $self->{ce}; 402 my $root = $ce->{webworkURLs}->{root}; 403 my $courseName = $ce->{courseName}; 404 405 return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); 406 407 my $userTemplate = $db->newUser; 408 my $permissionLevelTemplate = $db->newPermissionLevel; 409 410 # This code will require changing if the permission and user tables ever have different keys. 411 my @users = @{ $self->{ra_users} }; 412 my $ra_user_records = $self->{ra_user_records}; 413 my %classlistLabels = ();# %$hr_classlistLabels; 414 foreach my $ur (@{ $ra_user_records }) { 415 $classlistLabels{$ur->user_id} = $ur->user_id.' '.$ur->last_name. ', '. $ur->first_name.' - '.$ur->section; 416 } 417 418 419 ############################################################################################################## 420 421 422 my $from = $self->{from}; 423 my $subject = $self->{subject}; 424 my $replyTo = $self->{replyTo}; 425 my $columns = $self->{columns}; 426 my $rows = $self->{rows}; 427 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 'FIXME no text was produced by initialization!!'; 428 my $input_file = $self->{input_file}; 429 my $output_file = $self->{output_file}; 430 my @sorted_messages = $self->get_message_file_names; 431 my @sorted_merge_files = $self->get_merge_file_names; 432 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 433 my $delimiter = ','; 434 my $rh_merge_data = $self->read_merge_file("$merge_file", "$delimiter"); 435 my @merge_keys = keys %$rh_merge_data; 436 my $preview_user = $self->{preview_user}; 437 my $preview_record = $db->getUser($preview_user); 438 439 ############################################################################################# 440 441 print CGI::start_form({method=>"post", action=>$r->uri()}); 442 print $self->hidden_authen_fields(); 443 ############################################################################################# 444 # begin upper table 445 ############################################################################################# 446 447 print CGI::start_table({-border=>'2', -cellpadding=>'4'}); 448 print CGI::Tr({-align=>'left',-valign=>'VCENTER'}, 449 ############################################################################################# 450 # first column 451 ############################################################################################# 452 453 CGI::td("Message file: $input_file","\n",CGI::br(), 454 CGI::submit(-name=>'action', -value=>'Open'), ' ',"\n", 455 CGI::popup_menu(-name=>'openfilename', 456 -values=>\@sorted_messages, 457 -default=>$input_file 458 ), "\n",CGI::br(), 459 460 "Save file to: $output_file","\n",CGI::br(), 461 "\n", 'From:',' ', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1), 462 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1), 463 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>35, -override=>1), 464 ), 465 ############################################################################################# 466 # second column 467 ############################################################################################# 468 CGI::td({-align=>'left'}, 469 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], 470 -labels=>{all_students=>'All active students',studentID => 'Select recipients'}, 471 -default=>'studentID', 472 -linebreak=>1), 473 CGI::br(), 474 CGI::popup_menu(-name=>'classList', 475 -values=>\@users, 476 -labels=>\%classlistLabels, 477 -size => 10, 478 -multiple => 1, 479 -default=>$user 480 ), 481 482 483 ), 484 ############################################################################################# 485 # third column 486 ############################################################################################# 487 CGI::td({align=>'left'}, 488 "Merge file is: $merge_file", CGI::br(), 489 CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(), 490 CGI::popup_menu(-name=>'merge_file', 491 -values=>\@sorted_merge_files, 492 -default=>$merge_file, 493 ), "\n",CGI::hr(),CGI::br(), 494 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview')," email to ", 495 CGI::popup_menu(-name=>'preview_user', 496 -values=>\@users, 497 #-labels=>\%classlistLabels, 498 -default=>$preview_user, 499 ), 500 CGI::hr(), 501 CGI::submit(-name=>'action', -value=>'resize', -label=>'Resize message window'),CGI::br(), 502 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), 503 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), 504 CGI::br(),CGI::br(), 505 #show available macros 506 CGI::popup_menu( 507 -name=>'dummyName', 508 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'], 509 -labels=>{''=>'list of insertable macros', 510 '$SID'=>'$SID - Student ID', 511 '$FN'=>'$FN - First name', 512 '$LN'=>'$LN - Last name', 513 '$SECTION'=>'$SECTION', 514 '$RECITATION'=>'$RECITATION', 515 '$STATUS'=>'$STATUS - C, Audit, Drop, etc.', 516 '$EMAIL'=>'$EMAIL - Email address', 517 '$LOGIN'=>'$LOGIN - Login', 518 '$COL[3]'=>'$COL[3] - 3rd col', 519 '$COL[-1]'=>'$COL[-1] - Last column' 520 } 521 ), "\n", 522 ), 523 524 ); # end Tr 525 print CGI::end_table(); 526 ############################################################################################# 527 # end upper table 528 ############################################################################################# 529 530 # show merge file 531 # print "<pre>",(map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} 0..8),"</pre>"; 532 # print CGI::popup_menu( 533 # -name=>'dummyName2', 534 # -values=>\@merge_keys, 535 # -labels=>$rh_merge_data, 536 # -multiple=>1, 537 # -size =>2, 538 # 539 # ), "\n",CGI::br(); 540 # warn "merge keys ", join( " ",@merge_keys); 541 ############################################################################################# 542 # merge file fragment and message text area field 543 ############################################################################################# 544 my @tmp2; 545 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; 546 if ($@) { 547 print CGI::p( "Couldn't get merge data for $preview_user", CGI::br(), $@) ; 548 } else { 549 print CGI::pre("",data_format(0..($#tmp2)),"\n", data_format(@tmp2)); 550 } 551 #create a textbox with the subject and a textarea with the message 552 #print actual body of message 553 554 print "\n", CGI::p( $self->{message}) if defined($self->{message}); 555 print "\n", CGI::p( CGI::textarea(-name=>'body', -default=>$text, -rows=>$rows, -columns=>$columns, -override=>1)); 556 557 ############################################################################################# 558 # action button table 559 ############################################################################################# 560 print CGI::table( { -border=>2,-cellpadding=>4}, 561 CGI::Tr( 562 CGI::td( CGI::submit(-name=>'action', -value=>'Send Email') ), "\n", 563 CGI::td(CGI::submit(-name=>'action', -value=>'Save')," to $output_file"), " \n", 564 CGI::td(CGI::submit(-name=>'action', -value=>'Save as:'), 565 CGI::textfield(-name=>'savefilename', -size => 20, -value=> "$output_file", -override=>1) 566 ), "\n", 567 CGI::td(CGI::submit(-name=>'action', -value=>'Save as Default')), 568 ) 569 ); 570 571 ############################################################################################################## 572 573 print CGI::end_form(); 574 return ""; 575 } 576 577 ############################################################################## 578 # Utility methods 579 ############################################################################## 580 sub submission_error { 581 my $self = shift; 582 my $msg = join( " ", @_); 583 $self->{submitError}= $msg; #CGI::b(HTML::Entities::encode($msg)); 584 # qq{Please hit the "<B>Back</B>" button on your browser to 585 # try again, or notify your web master 586 # if you believe this message is in error. 587 # }; 588 return; 589 } 590 591 sub saveProblem { 592 my $self = shift; 593 my ($body, $probFileName)= @_; 594 local(*PROBLEM); 595 open (PROBLEM, ">$probFileName") || 596 $self->submission_error("Could not open $probFileName for writing. 597 Check that the permissions for this problem are 660 (-rw-rw----)"); 598 print PROBLEM $body; 599 close PROBLEM; 600 chmod 0660, "$probFileName" || 601 $self->submission_error(" 602 CAN'T CHANGE PERMISSIONS ON FILE $probFileName"); 603 } 604 605 sub read_input_file { 606 my $self = shift; 607 my $filePath = shift; 608 my ($text, @text); 609 my $header = ''; 610 my ($subject, $from, $replyTo); 611 local(*FILE); 612 if (-e "$filePath" and -r "$filePath") { 613 open FILE, "$filePath" || do { $self->submission_error("Can't open $filePath"); return}; 614 while ($header !~ s/Message:\s*$//m and not eof(FILE)) { 615 $header .= <FILE>; 616 } 617 $text = join( '', <FILE>); 618 $text =~ s/^\s*//; # remove initial white space if any. 619 $header =~ /^From:\s(.*)$/m; 620 $from = $1 or $from = $self->{defaultFrom}; 621 622 $header =~ /^Reply-To:\s(.*)$/m; 623 $replyTo = $1 or $replyTo = $self->{defaultReply}; 624 625 $header =~ /^Subject:\s(.*)$/m; 626 $subject = $1; 627 628 } else { 629 $from = $self->{defaultFrom}; 630 $replyTo = $self->{defaultReply}; 631 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist"; 632 $subject = "FIXME default subject"; 633 } 634 return ($from, $replyTo, $subject, \$text); 635 } 636 637 sub get_message_file_names { 638 my $self = shift; 639 my $emailDirectory = $self->{ce}->{courseDirs}->{email}; 640 #get all message files and create a list 641 local(*EMAILDIR); 642 opendir( EMAILDIR, $emailDirectory )|| die "Can't access directory $emailDirectory. Please check that webserver has permission to read this directory."; 643 my @messageFiles = grep /\.msg$/, readdir EMAILDIR; #all message files 644 closedir EMAILDIR; 645 646 return sort @messageFiles; 647 } 648 sub get_merge_file_names { 649 my $self = shift; 650 my $scoringDirectory = $self->{ce}->{courseDirs}->{scoring}; 651 #get all message files and create a list 652 local(*SCORINGDIR); 653 opendir( SCORINGDIR, $scoringDirectory )|| die "Can't access directory $scoringDirectory.", 654 "Please check that webserver has permission to read this directory."; 655 my @mergeFiles = grep( /\.csv$/, readdir SCORINGDIR); #all message files 656 closedir SCORINGDIR; 657 @mergeFiles = sort @mergeFiles; 658 # warn "FIXME scoring directory $scoringDirectory merge Files", join(" ", @mergeFiles); 659 unshift(@mergeFiles, 'None'); 660 return @mergeFiles; 661 } 662 663 sub read_merge_file { 664 my $self = shift; 665 my $fileName = shift; 666 my $delimiter = shift; 667 $delimiter = ',' unless defined($delimiter); 668 my $scoringDirectory= $self->{ce}->{courseDirs}->{scoring}; 669 my $filePath = "$scoringDirectory/$fileName"; 670 # Takes a delimited file as a parameter and returns an 671 # associative array with the first field as the key. 672 # Blank lines are skipped. White space is removed 673 my(@dbArray,$key,$dbString); 674 my %assocArray = (); 675 return 676 local(*FILE); 677 if ($fileName eq 'None') { 678 # do nothing 679 }elsif ( open(FILE, "$filePath") ) { 680 my $index=0; 681 while (<FILE>){ 682 unless ($_ =~ /\S/) {next;} ## skip blank lines 683 chomp; 684 @{$dbArray[$index]} =$self->getRecord($_,$delimiter); 685 $key =$dbArray[$index][0]; 686 #@dbArray = map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} @dbArray; 687 #$dbString = join(" | ",@dbArray); 688 $assocArray{$key}=$dbArray[$index]; 689 $index++; 690 } 691 close(FILE); 692 } else { 693 warn "Couldn't read file $filePath"; 694 } 695 return \%assocArray; 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 #user macros that can be used in the email message 724 my $SID = $ur->student_id; 725 my $FN = $ur->first_name; 726 my $LN = $ur->last_name; 727 my $SECTION = $ur->section; 728 my $RECITATION = $ur->recitation; 729 my $STATUS = $ur->status; 730 my $EMAIL = $ur->email_address; 731 my $LOGIN = $ur->user_id; 732 # get record from merge file 733 # FIXME this is inefficient. The info should be cached 734 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); 735 $self->submission_error( "No merge data for $SID $FN $LN $LOGIN") unless defined($rh_merge_data->{$SID}); 736 737 my $endCol = @COL; 738 # for safety, only evaluate special variables 739 my $msg = $text; 740 $msg =~ s/(\$SID)/eval($1)/ge; 741 $msg =~ s/(\$LN)/eval($1)/ge; 742 $msg =~ s/(\$FN)/eval($1)/ge; 743 $msg =~ s/(\$STATUS)/eval($1)/ge; 744 $msg =~ s/(\$SECTION)/eval($1)/ge; 745 $msg =~ s/(\$RECITATION)/eval($1)/ge; 746 $msg =~ s/(\$EMAIL)/eval($1)/ge; 747 $msg =~ s/(\$LOGIN)/eval($1)/ge; 748 $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g; 749 $msg =~ s/(\$COL\[.*?\])/eval($1)/ge; 750 751 $msg =~ s/\r//g; 752 753 my $preview_header = CGI::pre("",data_format(0..($#COL)),"\n", data_format(@COL)). 754 CGI::h3( "This sample mail would be sent to $EMAIL"); 755 756 757 return $msg, $preview_header; 758 } 759 sub data_format { 760 map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} @_; 761 } 762 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |