Parent Directory
| 
Revision Log
backport (sh002i): added check on the number of addresses in the From and Reply-to fields. this resolves bug #1131. THIS CHANGE REQUIRES THE PERL MODULE Email::Address. See TWiki topic WeBWorKRelease2pt3pt2.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader$ 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(-nosticky ); 29 use WeBWorK::CGI; 30 use Email::Address; 31 use HTML::Entities; 32 use Mail::Sender; 33 use Socket qw/unpack_sockaddr_in inet_ntoa/; # for remote host/port info 34 use Text::Wrap qw(wrap); 35 use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; 36 use WeBWorK::Utils::FilterRecords qw/filterRecords/; 37 38 use mod_perl; 39 use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ); 40 41 #my $REFRESH_RESIZE_BUTTON = "Set preview to: "; # handle submit value idiocy 42 my $UPDATE_SETTINGS_BUTTON = "Update settings and refresh page"; # handle submit value idiocy 43 sub initialize { 44 my ($self) = @_; 45 my $r = $self->r; 46 my $db = $r->db; 47 my $ce = $r->ce; 48 my $authz = $r->authz; 49 my $user = $r->param('user'); 50 51 my @selected_filters; 52 if (defined ($r->param('classList!filter'))){ @selected_filters = $r->param('classList!filter');} 53 else {@selected_filters = ("all");} 54 55 56 # Check permissions 57 return unless $authz->hasPermissions($user, "access_instructor_tools"); 58 return unless $authz->hasPermissions($user, "send_mail"); 59 60 ############################################################################################# 61 # gather directory data 62 ############################################################################################# 63 my $emailDirectory = $ce->{courseDirs}->{email}; 64 my $scoringDirectory = $ce->{courseDirs}->{scoring}; 65 my $templateDirectory = $ce->{courseDirs}->{templates}; 66 67 my $action = $r->param('action') ; 68 my $openfilename = $r->param('openfilename'); 69 my $savefilename = $r->param('savefilename'); 70 71 72 #FIXME get these values from global course environment (see subroutines as well) 73 my $default_msg_file = 'default.msg'; 74 my $old_default_msg_file = 'old_default.msg'; 75 76 77 # get user record 78 my $ur = $self->{db}->getUser($user); 79 80 # store data 81 $self->{defaultFrom} = $ur->rfc822_mailbox; 82 $self->{defaultReply} = $ur->rfc822_mailbox; 83 $self->{defaultSubject} = $self->r->urlpath->arg("courseID") . " notice"; 84 85 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows}; 86 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns}; 87 $self->{default_msg_file} = $default_msg_file; 88 $self->{old_default_msg_file} = $old_default_msg_file; 89 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None'; 90 #$self->{preview_user} = (defined($r->param('preview_user'))) ? $r->param('preview_user') : $user; 91 # an expermiment -- share the scrolling list for preivew and sendTo actions. 92 my @classList = (defined($r->param('classList'))) ? $r->param('classList') : ($user); 93 $self->{preview_user} = $classList[0] || $user; 94 95 ############################################################################################# 96 # gather database data 97 ############################################################################################# 98 # FIXME this might be better done in body? We don't always need all of this data. or do we? 99 my @users = $db->listUsers; 100 my @Users = $db->getUsers(@users); 101 # filter out users who don't get included in email (fixes bug #938) 102 @Users = grep { $ce->status_abbrev_has_behavior($_->status, "include_in_email") } @Users; 103 my @user_records = (); 104 105 ## Mark's code to prefilter userlist 106 107 108 my (@viewable_sections,@viewable_recitations); 109 110 if (defined @{$ce->{viewable_sections}->{$user}}) 111 {@viewable_sections = @{$ce->{viewable_sections}->{$user}};} 112 if (defined @{$ce->{viewable_recitations}->{$user}}) 113 {@viewable_recitations = @{$ce->{viewable_recitations}->{$user}};} 114 115 if (@viewable_sections or @viewable_recitations){ 116 foreach my $student (@Users){ 117 my $keep = 0; 118 foreach my $sec (@viewable_sections){ 119 if ($student->section() eq $sec){$keep = 1;} 120 } 121 foreach my $rec (@viewable_recitations){ 122 if ($student->recitation() eq $rec){$keep = 1;} 123 } 124 if ($keep) {push @user_records, $student;} 125 } 126 } 127 else {@user_records = @Users;} 128 129 ## End Mark's code 130 131 # foreach my $userName (@users) { 132 # my $userRecord = $db->getUser($userName); # checked 133 # die "record for user $userName not found" unless $userRecord; 134 # push(@user_records, $userRecord); 135 # } 136 ########################### 137 # Sort the users for presentation in the select list 138 ########################### 139 # if (defined $r->param("sort_by") ) { 140 # my $sort_method = $r->param("sort_by"); 141 # if ($sort_method eq 'section') { 142 # @user_records = sort { (lc($a->section) cmp lc($b->section)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records; 143 # } elsif ($sort_method eq 'recitation') { 144 # @user_records = sort { (lc($a->recitation) cmp lc($b->recitation)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records; 145 # } elsif ($sort_method eq 'alphabetical') { 146 # @user_records = sort { (lc($a->last_name) cmp lc($b->last_name)) } @user_records; 147 # } elsif ($sort_method eq 'id' ) { 148 # @user_records = sort { $a->user_id cmp $b->user_id } @user_records; 149 # } 150 # } else { 151 # @user_records = sort { $a->user_id cmp $b->user_id } @user_records; 152 # } 153 154 155 # replace the user names by a sorted version. 156 @users = map {$_->user_id} @user_records; 157 # store data 158 $self->{ra_users} = \@users; 159 $self->{ra_user_records} = \@user_records; 160 161 ############################################################################################# 162 # gather list of recipients 163 ############################################################################################# 164 my @send_to = (); 165 #FIXME this (radio) is a lousy name 166 my $recipients = $r->param('radio'); 167 if (defined($recipients) and $recipients eq 'all_students') { #only active students #FIXME status check?? 168 169 ## Add code so that only people who pass the current filters are added to our list of recipients. 170 # @user_records = filterRecords({filter=\@selected_filters},@user_records); 171 # I wasn't able to make this work 172 # I edited the selection button to make that clear. 173 # 174 175 foreach my $ur (@user_records) { 176 push(@send_to,$ur->user_id) 177 if $ce->status_abbrev_has_behavior($ur->status, "include_in_email") 178 and not $ur->user_id =~ /practice/; 179 } 180 } elsif (defined($recipients) and $recipients eq 'studentID' ) { 181 @send_to = $r->param('classList'); 182 } else { 183 # no recipients have been defined -- probably the first time on the page 184 } 185 $self->{ra_send_to} = \@send_to; 186 ################################################################# 187 # Check the validity of the input file name 188 ################################################################# 189 my $input_file = ''; 190 #make sure an input message file was submitted and exists 191 #else use the default message 192 if ( defined($openfilename) ) { 193 if ( -e "${emailDirectory}/$openfilename") { 194 if ( -R "${emailDirectory}/$openfilename") { 195 $input_file = $openfilename; 196 } else { 197 $self->addbadmessage(CGI::p(join("", 198 "The file ${emailDirectory}/$openfilename is not readable by the webserver.",CGI::br(), 199 "Check that it's permissions are set correctly.", 200 ))); 201 } 202 } else { 203 $input_file = $default_msg_file; 204 $self->addbadmessage(CGI::p(join("", 205 "The file ${emailDirectory}/$openfilename cannot be found.",CGI::br(), 206 "Check whether it exists and whether the directory $emailDirectory can be read by the webserver.",CGI::br(), 207 "Using contents of the default message $default_msg_file instead.", 208 ))); 209 } 210 } else { 211 $input_file = $default_msg_file; 212 } 213 $self->{input_file} =$input_file; 214 215 ################################################################# 216 # Determine the file name to save message into 217 ################################################################# 218 my $output_file = 'FIXME no output file specified'; 219 if (defined($action) and $action eq 'Save as Default') { 220 $output_file = $default_msg_file; 221 } elsif ( defined($action) and ($action =~/save/i)) { 222 if (defined($savefilename) and $savefilename ) { 223 $output_file = $savefilename; 224 } else { 225 $self->addbadmessage(CGI::p("No filename was specified for saving! The message was not saved.")); 226 } 227 } elsif ( defined($input_file) ) { 228 $output_file = $input_file; 229 } 230 231 ################################################################# 232 # Sanity check on save file name 233 ################################################################# 234 235 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) { 236 $self->addbadmessage(CGI::p("For security reasons, you cannot specify a message file from a directory", 237 "higher than the email directory (you can't use ../blah/blah for example). ", 238 "Please specify a different file or move the needed file to the email directory",)); 239 } 240 unless ($output_file =~ m|\.msg$| ) { 241 $self->addbadmessage(CGI::p("Invalid file name.", 242 "The file name \"$output_file\" does not have a \".msg\" extension", 243 "All email file names must end in the extension \".msg\"", 244 "choose a file name with a \".msg\" extension.", 245 "The message was not saved.",)); 246 } 247 248 $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing. 249 250 251 ############################################################################################# 252 # Determine input source 253 ############################################################################################# 254 #warn "Action = $action"; 255 my $input_source; 256 if ($action){ 257 $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file';} 258 else { $input_source = ( defined($r->param('body')) ) ? 'form' : 'file';} 259 260 ############################################################################################# 261 # Get inputs 262 ############################################################################################# 263 my($from, $replyTo, $r_text, $subject); 264 if ($input_source eq 'file') { 265 266 ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file"); 267 268 269 } elsif ($input_source eq 'form') { 270 # read info from the form 271 # bail if there is no message body 272 273 $from = $r->param('from'); 274 $replyTo = $r->param('replyTo'); 275 $subject = $r->param('subject'); 276 my $body = $r->param('body'); 277 # Sanity check: body must contain non-white space 278 $self->addbadmessage(CGI::p('You didn\'t enter any message.')) unless ($r->param('body') =~ /\S/); 279 $r_text = \$body; 280 281 } 282 283 my $remote_host; 284 if (MP2) { 285 $remote_host = $r->connection->remote_addr->ip_get || "UNKNOWN"; 286 } else { 287 (undef, $remote_host) = unpack_sockaddr_in($r->connection->remote_addr); 288 $remote_host = defined $remote_host ? inet_ntoa($remote_host) : "UNKNOWN"; 289 } 290 291 # store data 292 $self->{from} = $from; 293 $self->{replyTo} = $replyTo; 294 $self->{subject} = $subject; 295 $self->{remote_host} = $remote_host; 296 $self->{r_text} = $r_text; 297 298 299 300 ################################################################################### 301 #Determine the appropriate script action from the buttons 302 ################################################################################### 303 # first time actions 304 # open new file 305 # open default file 306 # choose merge file actions 307 # chose merge button 308 # option actions 309 # 'reset rows' 310 311 # save actions 312 # "save" button 313 # "save as" button 314 # "save as default" button 315 # preview actions 316 # 'preview' button 317 # email actions 318 # 'entire class' 319 # 'selected studentIDs' 320 # error actions (various) 321 322 323 ############################################################################################# 324 # if no form is submitted, gather data needed to produce the mail form and return 325 ############################################################################################# 326 my $to = $r->param('To'); 327 my $script_action = ''; 328 329 330 if(not defined($action) or $action eq 'Open' 331 or $action eq $UPDATE_SETTINGS_BUTTON ){ 332 333 return ''; 334 } 335 336 337 338 339 340 ############################################################################################# 341 # If form is submitted deal with filled out forms 342 # and various actions resulting from different buttons 343 ############################################################################################# 344 345 346 if ($action eq 'Save' or $action eq 'Save as:' or $action eq 'Save as Default') { 347 348 # warn "FIXME Saving files action = $action outputFileName=$output_file"; 349 350 ################################################################# 351 # construct message body 352 ################################################################# 353 my $temp_body = ${ $r_text }; 354 $temp_body =~ s/\r\n/\n/g; 355 $temp_body = join("", 356 "From: $from \nReply-To: $replyTo\n" , 357 "Subject: $subject\n" , 358 "Message: \n $temp_body"); 359 # warn "FIXME from $from | subject $subject |reply $replyTo|msg $temp_body"; 360 ################################################################# 361 # overwrite protection 362 ################################################################# 363 if ($action eq 'Save as:' and -e "$emailDirectory/$output_file") { 364 $self->addbadmessage(CGI::p("The file $emailDirectory/$output_file already exists and cannot be overwritten", 365 "The message was not saved")); 366 return; 367 } 368 369 ################################################################# 370 # Back up existing file? 371 ################################################################# 372 if ($action eq 'Save as Default' and -e "$emailDirectory/$default_msg_file") { 373 rename("$emailDirectory/$default_msg_file","$emailDirectory/$old_default_msg_file") or 374 die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ", 375 "Check permissions for webserver on directory $emailDirectory. $!"; 376 $self->addgoodmessage(CGI::p("Backup file <code>$emailDirectory/$old_default_msg_file</code> created." . CGI::br())); 377 } 378 ################################################################# 379 # Save the message 380 ################################################################# 381 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ) unless ($output_file =~ /^[~.]/ || $output_file =~ /\.\./ || not $output_file =~ m|\.msg$|); 382 unless ( $self->{submit_message} or not -w "${emailDirectory}/$output_file" ) { # if there are no errors report success 383 $self->addgoodmessage(CGI::p("Message saved to file <code>${emailDirectory}/$output_file</code>.")); 384 } 385 386 } elsif ($action eq 'Preview message') { 387 $self->{response} = 'preview'; 388 389 } elsif ($action eq 'Send Email') { 390 # verify format of From address (one valid rfc2822 address) 391 my @parsed_from_addrs = Email::Address->parse($self->{from}); 392 unless (@parsed_from_addrs == 1) { 393 $self->addbadmessage("From field must contain one valid email address."); 394 return; 395 } 396 397 # verify format of Reply-to address (zero or more valid rfc2822 addresses) 398 if (defined $self->{replyTo} and $self->{replyTo} ne "") { 399 my @parsed_replyto_addrs = Email::Address->parse($self->{replyTo}); 400 unless (@parsed_replyto_addrs > 0) { 401 $self->addbadmessage("Invalid Reply-to address."); 402 return; 403 } 404 } 405 406 # check that recipients have been selected. 407 my @recipients = @{$self->{ra_send_to}}; 408 unless (@recipients) { 409 $self->addbadmessage(CGI::p("No recipients selected. Please select one or more recipients from the list below.")); 410 return; 411 } 412 413 # get merge file 414 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 415 my $delimiter = ','; 416 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 417 unless (ref($rh_merge_data) ) { 418 $self->addbadmessage(CGI::p("No merge data file")); 419 $self->addbadmessage(CGI::p("Can't read merge file $merge_file. No message sent")); 420 return; 421 } ; 422 $self->{rh_merge_data} = $rh_merge_data; 423 424 # we don't set the response until we're sure that email can be sent 425 $self->{response} = 'send_email'; 426 427 # FIXME i'm not sure why we're pulling this out here -- mail_message_to_recipients does have 428 # access to the course environment and should just grab it directly 429 $self->{smtpServer} = $ce->{mail}->{smtpServer}; 430 431 # do actual mailing in the cleanup phase, since it could take a long time 432 # FIXME we need to do a better job providing status notifications for long-running email jobs 433 my $post_connection_action = sub { 434 my $r = shift; 435 my $result_message = $self->mail_message_to_recipients(); 436 $self->email_notification($result_message); 437 }; 438 if (MP2) { 439 $r->connection->pool->cleanup_register($post_connection_action); 440 } else { 441 $r->post_connection($post_connection_action); 442 } 443 # foreach my $recipient (@recipients) { 444 # #warn "FIXME sending email to $recipient"; 445 # my $ur = $self->{db}->getUser($recipient); #checked 446 # die "record for user $recipient not found" unless $ur; 447 # unless ($ur->email_address) { 448 # $self->addbadmessage(CGI::p("user $recipient does not have an email address -- skipping")); 449 # next; 450 # } 451 # my ($msg, $preview_header); 452 # eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); }; 453 # $self->addbadmessage(CGI::p("There were errors in processing user $ur, merge file $merge_file. $@")) if $@; 454 # my $mailer = Mail::Sender->new({ 455 # from => $from, 456 # to => $ur->email_address, 457 # smtp => $ce->{mail}->{smtpServer}, 458 # subject => $subject, 459 # headers => "X-Remote-Host: ".$r->get_remote_host(), 460 # }); 461 # unless (ref $mailer) { 462 # $self->addbadmessage(CGI::p("Failed to create a mailer for user $recipient: $Mail::Sender::Error")); 463 # next; 464 # } 465 # unless (ref $mailer->Open()) { 466 # $self->addbadmessage(CGI::p("Failed to open the mailer for user $recipient: $Mail::Sender::Error")); 467 # next; 468 # } 469 # my $MAIL = $mailer->GetHandle() or $self->addbadmessage(CGI::p("Couldn't get handle")); 470 # print $MAIL $msg || $self->addbadmessage(CGI::p("Couldn't print to $MAIL")); 471 # close $MAIL || $self->addbadmessage(CGI::p("Couldn't close $MAIL")); 472 # #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject"; 473 # 474 # } 475 476 } else { 477 $self->addbadmessage(CGI::p("Didn't recognize button $action")); 478 } 479 480 481 482 } #end initialize 483 484 485 486 487 488 sub body { 489 my ($self) = @_; 490 my $r = $self->r; 491 my $urlpath = $r->urlpath; 492 my $authz = $r->authz; 493 my $setID = $urlpath->arg("setID"); 494 my $response = (defined($self->{response}))? $self->{response} : ''; 495 my $user = $r->param('user'); 496 497 # Check permissions 498 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to access instructor tools")) 499 unless $authz->hasPermissions($user, "access_instructor_tools"); 500 501 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to send mail to students")) 502 unless $authz->hasPermissions($user, "send_mail"); 503 504 if ($response eq 'preview') { 505 $self->print_preview($setID); 506 } elsif ($response eq 'send_email' and $self->{ra_send_to} and @{$self->{ra_send_to}}){ 507 my $message = CGI::i("Email is being sent to ". scalar(@{$self->{ra_send_to}})." recipient(s). You will be notified" 508 ." by email when the task is completed. This may take several minutes if the class is large." 509 ); 510 $self->addgoodmessage($message); 511 $self->{message} .= $message; 512 513 $self->print_form($setID); 514 } else { 515 $self->print_form($setID); 516 } 517 518 } 519 sub print_preview { 520 my ($self) = @_; 521 my $r = $self->r; 522 my $urlpath = $r->urlpath; 523 my $setID = $urlpath->arg("setID"); 524 525 # get preview user 526 my $ur = $r->db->getUser($self->{preview_user}); #checked 527 die "record for preview user ".$self->{preview_user}. " not found." unless $ur; 528 529 # get merge file 530 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 531 my $delimiter = ','; 532 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 533 534 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data,1); # 1 == for preview 535 536 my $recipients = join(" ",@{$self->{ra_send_to} }); 537 my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ; 538 $msg = join("", 539 $errorMessage, 540 $preview_header, 541 "To: " , $ur->email_address,"\n", 542 "From: " , $self->{from} , "\n" , 543 "Reply-To: " , $self->{replyTo} , "\n" , 544 "Subject: " , $self->{subject} , "\n" ,"\n" , 545 $msg , "\n" 546 ); 547 548 return join("", '<pre>',$msg,"\n","\n", 549 '</pre>', 550 CGI::p('Use browser back button to return from preview mode'), 551 CGI::h3('Emails to be sent to the following:'), 552 $recipients, "\n", 553 554 ); 555 556 } 557 sub print_form { 558 my ($self) = @_; 559 my $r = $self->r; 560 my $urlpath = $r->urlpath; 561 my $authz = $r->authz; 562 my $db = $r->db; 563 my $ce = $r->ce; 564 my $courseName = $urlpath->arg("courseID"); 565 my $setID = $urlpath->arg("setID"); 566 my $user = $r->param('user'); 567 568 my $root = $ce->{webworkURLs}->{root}; 569 my $sendMailPage = $urlpath->newFromModule($urlpath->module,courseID=>$courseName); 570 my $sendMailURL = $self->systemLink($sendMailPage, authen => 0); 571 572 return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); 573 574 my $userTemplate = $db->newUser; 575 my $permissionLevelTemplate = $db->newPermissionLevel; 576 577 # This code will require changing if the permission and user tables ever have different keys. 578 my @users = sort @{ $self->{ra_users} }; 579 my $ra_user_records = $self->{ra_user_records}; 580 my %classlistLabels = ();# %$hr_classlistLabels; 581 foreach my $ur (@{ $ra_user_records }) { 582 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation; 583 } 584 585 ## Mark edit define scrolling list 586 my $scrolling_user_list = scrollingRecordList({ 587 name => "classList", ## changed from classList to action 588 request => $r, 589 default_sort => "lnfn", 590 default_format => "lnfn_uid", 591 default_filters => ["all"], 592 size => 5, 593 multiple => 1, 594 refresh_button_name =>'Update settings and refresh page', 595 }, @{$ra_user_records}); 596 597 ############################################################################################################## 598 599 600 my $from = $self->{from}; 601 my $subject = $self->{subject}; 602 my $replyTo = $self->{replyTo}; 603 my $columns = $self->{columns}; 604 my $rows = $self->{rows}; 605 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 'FIXME no text was produced by initialization!!'; 606 my $input_file = $self->{input_file}; 607 my $output_file = $self->{output_file}; 608 my @sorted_messages = $self->get_message_file_names; 609 my @sorted_merge_files = $self->get_merge_file_names; 610 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 611 my $delimiter = ','; 612 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 613 my @merge_keys = keys %$rh_merge_data; 614 my $preview_user = $self->{preview_user}; 615 my $preview_record = $db->getUser($preview_user); # checked 616 die "record for preview user ".$self->{preview_user}. " not found." unless $preview_record; 617 618 619 ############################################################################################# 620 621 print CGI::start_form({method=>"post", action=>$sendMailURL}); 622 print $self->hidden_authen_fields(); 623 ############################################################################################# 624 # begin upper table 625 ############################################################################################# 626 627 print CGI::start_table({-border=>'2', -cellpadding=>'4'}); 628 print CGI::Tr({-align=>'left',-valign=>'top'}, 629 ############################################################################################# 630 # first column 631 ############################################################################################# 632 633 CGI::td({}, 634 CGI::strong("Message file: "), $input_file,"\n",CGI::br(), 635 CGI::submit(-name=>'action', -value=>'Open'), ' ',"\n", 636 CGI::popup_menu(-name=>'openfilename', 637 -values=>\@sorted_messages, 638 -default=>$input_file 639 ), 640 "\n",CGI::br(), 641 CGI::strong("Save file to: "), $output_file, 642 "\n",CGI::br(), 643 CGI::strong('Merge file: '), $merge_file, 644 CGI::br(), 645 CGI::popup_menu(-name=>'merge_file', 646 -values=>\@sorted_merge_files, 647 -default=>$merge_file, 648 ), "\n", 649 "\n", 650 #CGI::hr(), 651 CGI::div({style=>"background-color: #CCCCCC"}, 652 "\n", 'From:',' ', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1), 653 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1), 654 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-cols=>30, -override=>1), 655 ), 656 #CGI::hr(), 657 CGI::submit(-name=>'action', -value=>$UPDATE_SETTINGS_BUTTON), 658 659 ), 660 ############################################################################################# 661 # second column 662 ############################################################################################# 663 664 ## Edit by Mark to insert scrolling list 665 CGI::td({-style=>"width:33%"}, 666 CGI::strong("Send to:"), 667 CGI::radio_group(-name=>'radio', 668 -values=>['all_students','studentID'], 669 -labels=>{all_students=>'All students in course',studentID => 'Selected students'}, 670 -default=>'studentID', -linebreak=>0), 671 CGI::br(),$scrolling_user_list, 672 CGI::i("Preview set to: "), $preview_record->last_name, 673 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview message'),' ', 674 ), 675 676 ## Edit here to insert filtering 677 ## be sure to fail GRACEFULLY! 678 # 679 # 680 # CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),, 681 # CGI::radio_group(-name=>'sort_by', -values=>['id','alphabetical','section','recitation'], 682 # -labels=>{id=>'Login',alphabetical=>'Alph.',section => 'Sec.',recitation=>'Rec.'}, 683 # -default=>defined($r->param("sort_by")) ? $r->param("sort_by") : 'id', 684 # -linebreak=>0 685 # ), 686 # 687 # CGI::br(),CGI::br(), 688 # CGI::popup_menu(-name=>'classList', 689 # -values=>\@users, 690 # -labels=>\%classlistLabels, 691 # -size => 10, 692 # -multiple => 1, 693 # -default=>$user 694 # ), 695 # ), 696 697 698 699 700 ############################################################################################# 701 # third column 702 ############################################################################################# 703 CGI::td({align=>'left'}, 704 705 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), 706 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), 707 CGI::br(), 708 # CGI::i('Press any action button to update display'),CGI::br(), 709 #show available macros 710 CGI::popup_menu( 711 -name=>'dummyName', 712 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'], 713 -labels=>{''=>'list of insertable macros', 714 '$SID'=>'$SID - Student ID', 715 '$FN'=>'$FN - First name', 716 '$LN'=>'$LN - Last name', 717 '$SECTION'=>'$SECTION', 718 '$RECITATION'=>'$RECITATION', 719 '$STATUS'=>'$STATUS - C, Audit, Drop, etc.', 720 '$EMAIL'=>'$EMAIL - Email address', 721 '$LOGIN'=>'$LOGIN - Login', 722 '$COL[3]'=>'$COL[3] - 3rd col', 723 '$COL[-1]'=>'$COL[-1] - Last column' 724 } 725 ), "\n", 726 ), 727 728 ); # end Tr 729 print CGI::end_table(); 730 ############################################################################################# 731 # end upper table 732 ############################################################################################# 733 734 # show merge file 735 # print "<pre>",(map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} 0..8),"</pre>"; 736 # print CGI::popup_menu( 737 # -name=>'dummyName2', 738 # -values=>\@merge_keys, 739 # -labels=>$rh_merge_data, 740 # -multiple=>1, 741 # -size =>2, 742 # 743 # ), "\n",CGI::br(); 744 # warn "merge keys ", join( " ",@merge_keys); 745 ############################################################################################# 746 # merge file fragment and message text area field 747 ############################################################################################# 748 my @tmp2; 749 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; # checked 750 if ($@ and $merge_file ne 'None') { 751 print "No merge data for $preview_user in merge file: <$merge_file>",CGI::br(); 752 } else { 753 print CGI::pre("",data_format(1..($#tmp2+1)),"<br>", data_format2(@tmp2)); 754 } 755 #create a textbox with the subject and a textarea with the message 756 #print actual body of message 757 758 print "\n", CGI::p( $self->{message}) if defined($self->{message}); 759 print "\n", CGI::p( CGI::textarea(-name=>'body', -default=>$text, -rows=>$rows, -cols=>$columns, -override=>1)); 760 761 ############################################################################################# 762 # action button table 763 ############################################################################################# 764 print CGI::table( { -border=>2,-cellpadding=>4}, 765 CGI::Tr( {}, 766 CGI::td({}, CGI::submit(-name=>'action', -value=>'Send Email') ), "\n", 767 CGI::td({}, CGI::submit(-name=>'action', -value=>'Save')," to $output_file"), " \n", 768 CGI::td({}, CGI::submit(-name=>'action', -value=>'Save as:'), 769 CGI::textfield(-name=>'savefilename', -size => 20, -value=> "$output_file", -override=>1) 770 ), "\n", 771 CGI::td(CGI::submit(-name=>'action', -value=>'Save as Default')), 772 ) 773 ); 774 775 ############################################################################################################## 776 777 print CGI::end_form(); 778 return ""; 779 } 780 781 ############################################################################## 782 # Utility methods 783 ############################################################################## 784 785 sub saveProblem { 786 my $self = shift; 787 my ($body, $probFileName)= @_; 788 local(*PROBLEM); 789 open (PROBLEM, ">$probFileName") || 790 $self->addbadmessage(CGI::p("Could not open $probFileName for writing. 791 Check that the permissions for this problem are 660 (-rw-rw----)")); 792 print PROBLEM $body if -w $probFileName; 793 close PROBLEM; 794 chmod 0660, "$probFileName" || 795 $self->addbadmessage(CGI::p("CAN'T CHANGE PERMISSIONS ON FILE $probFileName")); 796 } 797 798 sub read_input_file { 799 my $self = shift; 800 my $filePath = shift; 801 my ($text, @text); 802 my $header = ''; 803 my ($subject, $from, $replyTo); 804 local(*FILE); 805 if (-e "$filePath" and -r "$filePath") { 806 open FILE, "$filePath" || do { $self->addbadmessage(CGI::p("Can't open $filePath")); return}; 807 while ($header !~ s/Message:\s*$//m and not eof(FILE)) { 808 $header .= <FILE>; 809 } 810 $text = join( '', <FILE>); 811 $text =~ s/^\s*//; # remove initial white space if any. 812 $header =~ /^From:\s(.*)$/m; 813 $from = $1 or $from = $self->{defaultFrom}; 814 815 $header =~ /^Reply-To:\s(.*)$/m; 816 $replyTo = $1 or $replyTo = $self->{defaultReply}; 817 818 $header =~ /^Subject:\s(.*)$/m; 819 $subject = $1; 820 821 } else { 822 $from = $self->{defaultFrom}; 823 $replyTo = $self->{defaultReply}; 824 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist"; 825 $subject = $self->{defaultSubject}; 826 } 827 return ($from, $replyTo, $subject, \$text); 828 } 829 830 831 sub get_message_file_names { 832 my $self = shift; 833 return $self->read_dir($self->{ce}->{courseDirs}->{email}, '\\.msg$'); 834 } 835 sub get_merge_file_names { 836 my $self = shift; 837 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed. 838 } 839 840 sub mail_message_to_recipients { 841 my $self = shift; 842 my $r = $self->r; 843 my $ce = $r->ce; 844 my $subject = $self->{subject}; 845 my $from = $self->{from}; 846 my @recipients = @{$self->{ra_send_to}}; 847 my $rh_merge_data = $self->{rh_merge_data}; 848 my $merge_file = $self->{merge_file}; 849 my $result_message = ''; 850 my $failed_messages = 0; 851 foreach my $recipient (@recipients) { 852 # warn "FIXME sending email to $recipient"; 853 my $error_messages = ''; 854 my $ur = $self->{db}->getUser($recipient); #checked 855 unless ($ur) { 856 $error_messages .= "Record for user $recipient not found\n"; 857 next; 858 } 859 unless ($ur->email_address) { 860 $error_messages .="User $recipient does not have an email address -- skipping\n"; 861 next; 862 } 863 my $msg = eval { $self->process_message($ur,$rh_merge_data) }; 864 $error_messages .= "There were errors in processing user $recipient, merge file $merge_file. \n$@\n" if $@; 865 my $mailer = Mail::Sender->new({ 866 from => $ce->{mail}{smtpSender}, 867 fake_from => $from, 868 to => $ur->email_address, 869 smtp => $self->{smtpServer}, 870 subject => $subject, 871 headers => "X-Remote-Host: ".$self->{remote_host}, 872 }); 873 unless (ref $mailer) { 874 $error_messages .= "Failed to create a mailer for user $recipient: $Mail::Sender::Error\n"; 875 next; 876 } 877 unless (ref $mailer->Open()) { 878 $error_messages .= "Failed to open the mailer for user $recipient: $Mail::Sender::Error\n"; 879 next; 880 } 881 my $MAIL = $mailer->GetHandle() || ($error_messages .= "Couldn't get mailer handle \n"); 882 print $MAIL $msg || ($error_messages .= "Couldn't print to $MAIL"); 883 close $MAIL || ($error_messages .= "Couldn't close $MAIL"); 884 #warn "FIXME mailed to $recipient: ", $ur->email_address, " from $from subject $subject Errors: $error_messages"; 885 $failed_messages++ if $error_messages; 886 $result_message .= $error_messages; 887 } 888 my $courseName = $self->r->urlpath->arg("courseID"); 889 my $number_of_recipients = scalar(@recipients) - $failed_messages; 890 $result_message = <<EndText.$result_message; 891 892 A message with the subject line 893 $subject 894 has been sent to 895 $number_of_recipients recipient(s) in the class $courseName. 896 There were $failed_messages message(s) that could not be delivered. 897 898 EndText 899 900 } 901 sub email_notification { 902 my $self = shift; 903 my $result_message = shift; 904 # find info on mailer and sender 905 # use the defaultFrom address. 906 907 # find info on instructor recipient and message 908 my $subject="WeBWorK email sent"; 909 910 my $mailing_errors = ""; 911 # open MAIL handle 912 my $mailer = Mail::Sender->new({ 913 from => $self->{defaultFrom}, 914 to => $self->{defaultFrom}, 915 smtp => $self->{smtpServer}, 916 subject => $subject, 917 headers => "X-Remote-Host: ".$self->{remote_host}, 918 }); 919 unless (ref $mailer) { 920 $mailing_errors .= "Failed to create a mailer: $Mail::Sender::Error"; 921 return ""; 922 } 923 unless (ref $mailer->Open()) { 924 $mailing_errors .= "Failed to open the mailer: $Mail::Sender::Error"; 925 return ""; 926 } 927 my $MAIL = $mailer->GetHandle(); 928 # print message 929 print $MAIL $result_message; 930 # clean up 931 close $MAIL; 932 933 warn "instructor message sent to ", $self->{defaultFrom}; 934 935 } 936 sub getRecord { 937 my $self = shift; 938 my $line = shift; 939 my $delimiter = shift; 940 $delimiter = ',' unless defined($delimiter); 941 942 # Takes a delimited line as a parameter and returns an 943 # array. Note that all white space is removed. If the 944 # last field is empty, the last element of the returned 945 # array is also empty (unlike what the perl split command 946 # would return). E.G. @lineArray=&getRecord(\$delimitedLine). 947 948 my(@lineArray); 949 $line.="${delimiter}___"; # add final field which must be non-empty 950 @lineArray = split(/\s*${delimiter}\s*/,$line); # split line into fields 951 $lineArray[0] =~s/^\s*//; # remove white space from first element 952 pop @lineArray; # remove the last artificial field 953 @lineArray; 954 } 955 956 sub process_message { 957 my $self = shift; 958 my $ur = shift; 959 my $rh_merge_data = shift; 960 my $for_preview = shift; 961 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 962 'FIXME no text was produced by initialization!!'; 963 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 964 965 my $status_name = $self->r->ce->status_abbrev_to_name($ur->status); 966 $status_name = $ur->status unless defined $status_name; 967 968 #user macros that can be used in the email message 969 my $SID = $ur->student_id; 970 my $FN = $ur->first_name; 971 my $LN = $ur->last_name; 972 my $SECTION = $ur->section; 973 my $RECITATION = $ur->recitation; 974 my $STATUS = $status_name; 975 my $EMAIL = $ur->email_address; 976 my $LOGIN = $ur->user_id; 977 978 # get record from merge file 979 # FIXME this is inefficient. The info should be cached 980 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); 981 if ($merge_file ne 'None' and not defined($rh_merge_data->{$SID}) and $for_preview) { 982 $self->addbadmessage(CGI::p("No merge data for student id:$SID; name:$FN $LN; login:$LOGIN")); 983 } 984 unshift(@COL,""); ## this makes COL[1] the first column 985 my $endCol = @COL; 986 # for safety, only evaluate special variables 987 my $msg = $text; 988 $msg =~ s/\$SID/$SID/ge; 989 $msg =~ s/\$LN/$LN/ge; 990 $msg =~ s/\$FN/$FN/ge; 991 $msg =~ s/\$STATUS/$STATUS/ge; 992 $msg =~ s/\$SECTION/$SECTION/ge; 993 $msg =~ s/\$RECITATION/$RECITATION/ge; 994 $msg =~ s/\$EMAIL/$EMAIL/ge; 995 $msg =~ s/\$LOGIN/$LOGIN/ge; 996 if (defined($COL[1])) { # prevents extraneous error messages. 997 $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1]/ge 998 } 999 else { # prevents extraneous $COL's in email message 1000 $msg =~ s/\$COL\[(\-?\d+)\]//g 1001 } 1002 1003 $msg =~ s/\r//g; 1004 1005 if ($for_preview) { 1006 my @preview_COL = @COL; 1007 shift @preview_COL; ## shift back for preview 1008 my $preview_header = CGI::pre({},data_format(1..($#COL)),"<br>", data_format2(@preview_COL)). 1009 CGI::h3( "This sample mail would be sent to $EMAIL"); 1010 return $msg, $preview_header; 1011 } else { 1012 return $msg; 1013 } 1014 } 1015 1016 1017 # Ý sub data_format { 1018 # 1019 # Ý Ý Ý Ý Ýmap {$_ =~s/\s/\./g;$_} Ý Ý map {sprintf('%-8.8s',$_);} Ý@_; 1020 sub data_format { 1021 map {"COL[$_]".' 'x(3-length($_));} @_; # problems if $_ has length bigger than 4 1022 } 1023 sub data_format2 { 1024 map {$_ =~s/\s/ /g;$_} map {sprintf('%-8.8s',$_);} @_; 1025 } 1026 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |