Parent Directory
| 
Revision Log
backport (sh002i): wrap message for preview. resolves bug #1147.
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 # catch exceptions generated during the sending process 436 my $result_message = eval { $self->mail_message_to_recipients() }; 437 if ($@) { 438 # add the die message to the result message 439 $result_message = "An error occurred while trying to send email.\n" 440 . "The error message is:\n\n$@\n\n"; 441 # and also write it to the apache log 442 $self->r->log->error("An error occurred while trying to send email: $@"); 443 } 444 # this could fail too... 445 eval { $self->email_notification($result_message) }; 446 if ($@) { 447 $self->r->log->error("An error occured while trying to send the email notification: $@"); 448 } 449 }; 450 if (MP2) { 451 $r->connection->pool->cleanup_register($post_connection_action); 452 } else { 453 $r->post_connection($post_connection_action); 454 } 455 # foreach my $recipient (@recipients) { 456 # #warn "FIXME sending email to $recipient"; 457 # my $ur = $self->{db}->getUser($recipient); #checked 458 # die "record for user $recipient not found" unless $ur; 459 # unless ($ur->email_address) { 460 # $self->addbadmessage(CGI::p("user $recipient does not have an email address -- skipping")); 461 # next; 462 # } 463 # my ($msg, $preview_header); 464 # eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); }; 465 # $self->addbadmessage(CGI::p("There were errors in processing user $ur, merge file $merge_file. $@")) if $@; 466 # my $mailer = Mail::Sender->new({ 467 # from => $from, 468 # to => $ur->email_address, 469 # smtp => $ce->{mail}->{smtpServer}, 470 # subject => $subject, 471 # headers => "X-Remote-Host: ".$r->get_remote_host(), 472 # }); 473 # unless (ref $mailer) { 474 # $self->addbadmessage(CGI::p("Failed to create a mailer for user $recipient: $Mail::Sender::Error")); 475 # next; 476 # } 477 # unless (ref $mailer->Open()) { 478 # $self->addbadmessage(CGI::p("Failed to open the mailer for user $recipient: $Mail::Sender::Error")); 479 # next; 480 # } 481 # my $MAIL = $mailer->GetHandle() or $self->addbadmessage(CGI::p("Couldn't get handle")); 482 # print $MAIL $msg || $self->addbadmessage(CGI::p("Couldn't print to $MAIL")); 483 # close $MAIL || $self->addbadmessage(CGI::p("Couldn't close $MAIL")); 484 # #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject"; 485 # 486 # } 487 488 } else { 489 $self->addbadmessage(CGI::p("Didn't recognize button $action")); 490 } 491 492 493 494 } #end initialize 495 496 497 498 499 500 sub body { 501 my ($self) = @_; 502 my $r = $self->r; 503 my $urlpath = $r->urlpath; 504 my $authz = $r->authz; 505 my $setID = $urlpath->arg("setID"); 506 my $response = (defined($self->{response}))? $self->{response} : ''; 507 my $user = $r->param('user'); 508 509 # Check permissions 510 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to access instructor tools")) 511 unless $authz->hasPermissions($user, "access_instructor_tools"); 512 513 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to send mail to students")) 514 unless $authz->hasPermissions($user, "send_mail"); 515 516 if ($response eq 'preview') { 517 $self->print_preview($setID); 518 } elsif ($response eq 'send_email' and $self->{ra_send_to} and @{$self->{ra_send_to}}){ 519 my $message = CGI::i("Email is being sent to ". scalar(@{$self->{ra_send_to}})." recipient(s). You will be notified" 520 ." by email when the task is completed. This may take several minutes if the class is large." 521 ); 522 $self->addgoodmessage($message); 523 $self->{message} .= $message; 524 525 $self->print_form($setID); 526 } else { 527 $self->print_form($setID); 528 } 529 530 } 531 sub print_preview { 532 my ($self) = @_; 533 my $r = $self->r; 534 my $urlpath = $r->urlpath; 535 my $setID = $urlpath->arg("setID"); 536 537 # get preview user 538 my $ur = $r->db->getUser($self->{preview_user}); #checked 539 die "record for preview user ".$self->{preview_user}. " not found." unless $ur; 540 541 # get merge file 542 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 543 my $delimiter = ','; 544 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 545 546 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data,1); # 1 == for preview 547 548 my $recipients = join(" ",@{$self->{ra_send_to} }); 549 my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ; 550 $msg = join("", 551 $errorMessage, 552 $preview_header, 553 "To: " , $ur->email_address,"\n", 554 "From: " , $self->{from} , "\n" , 555 "Reply-To: " , $self->{replyTo} , "\n" , 556 "Subject: " , $self->{subject} , "\n" ,"\n" , 557 $msg , "\n" 558 ); 559 560 return join("", '<pre>',wrap("","",$msg),"\n","\n", 561 '</pre>', 562 CGI::p('Use browser back button to return from preview mode'), 563 CGI::h3('Emails to be sent to the following:'), 564 $recipients, "\n", 565 566 ); 567 568 } 569 sub print_form { 570 my ($self) = @_; 571 my $r = $self->r; 572 my $urlpath = $r->urlpath; 573 my $authz = $r->authz; 574 my $db = $r->db; 575 my $ce = $r->ce; 576 my $courseName = $urlpath->arg("courseID"); 577 my $setID = $urlpath->arg("setID"); 578 my $user = $r->param('user'); 579 580 my $root = $ce->{webworkURLs}->{root}; 581 my $sendMailPage = $urlpath->newFromModule($urlpath->module,courseID=>$courseName); 582 my $sendMailURL = $self->systemLink($sendMailPage, authen => 0); 583 584 return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); 585 586 my $userTemplate = $db->newUser; 587 my $permissionLevelTemplate = $db->newPermissionLevel; 588 589 # This code will require changing if the permission and user tables ever have different keys. 590 my @users = sort @{ $self->{ra_users} }; 591 my $ra_user_records = $self->{ra_user_records}; 592 my %classlistLabels = ();# %$hr_classlistLabels; 593 foreach my $ur (@{ $ra_user_records }) { 594 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation; 595 } 596 597 ## Mark edit define scrolling list 598 my $scrolling_user_list = scrollingRecordList({ 599 name => "classList", ## changed from classList to action 600 request => $r, 601 default_sort => "lnfn", 602 default_format => "lnfn_uid", 603 default_filters => ["all"], 604 size => 5, 605 multiple => 1, 606 refresh_button_name =>'Update settings and refresh page', 607 }, @{$ra_user_records}); 608 609 ############################################################################################################## 610 611 612 my $from = $self->{from}; 613 my $subject = $self->{subject}; 614 my $replyTo = $self->{replyTo}; 615 my $columns = $self->{columns}; 616 my $rows = $self->{rows}; 617 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 'FIXME no text was produced by initialization!!'; 618 my $input_file = $self->{input_file}; 619 my $output_file = $self->{output_file}; 620 my @sorted_messages = $self->get_message_file_names; 621 my @sorted_merge_files = $self->get_merge_file_names; 622 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 623 my $delimiter = ','; 624 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 625 my @merge_keys = keys %$rh_merge_data; 626 my $preview_user = $self->{preview_user}; 627 my $preview_record = $db->getUser($preview_user); # checked 628 die "record for preview user ".$self->{preview_user}. " not found." unless $preview_record; 629 630 631 ############################################################################################# 632 633 print CGI::start_form({method=>"post", action=>$sendMailURL}); 634 print $self->hidden_authen_fields(); 635 ############################################################################################# 636 # begin upper table 637 ############################################################################################# 638 639 print CGI::start_table({-border=>'2', -cellpadding=>'4'}); 640 print CGI::Tr({-align=>'left',-valign=>'top'}, 641 ############################################################################################# 642 # first column 643 ############################################################################################# 644 645 CGI::td({}, 646 CGI::strong("Message file: "), $input_file,"\n",CGI::br(), 647 CGI::submit(-name=>'action', -value=>'Open'), ' ',"\n", 648 CGI::popup_menu(-name=>'openfilename', 649 -values=>\@sorted_messages, 650 -default=>$input_file 651 ), 652 "\n",CGI::br(), 653 CGI::strong("Save file to: "), $output_file, 654 "\n",CGI::br(), 655 CGI::strong('Merge file: '), $merge_file, 656 CGI::br(), 657 CGI::popup_menu(-name=>'merge_file', 658 -values=>\@sorted_merge_files, 659 -default=>$merge_file, 660 ), "\n", 661 "\n", 662 #CGI::hr(), 663 CGI::div({style=>"background-color: #CCCCCC"}, 664 "\n", 'From:',' ', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1), 665 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1), 666 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-cols=>30, -override=>1), 667 ), 668 #CGI::hr(), 669 CGI::submit(-name=>'action', -value=>$UPDATE_SETTINGS_BUTTON), 670 671 ), 672 ############################################################################################# 673 # second column 674 ############################################################################################# 675 676 ## Edit by Mark to insert scrolling list 677 CGI::td({-style=>"width:33%"}, 678 CGI::strong("Send to:"), 679 CGI::radio_group(-name=>'radio', 680 -values=>['all_students','studentID'], 681 -labels=>{all_students=>'All students in course',studentID => 'Selected students'}, 682 -default=>'studentID', -linebreak=>0), 683 CGI::br(),$scrolling_user_list, 684 CGI::i("Preview set to: "), $preview_record->last_name, 685 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview message'),' ', 686 ), 687 688 ## Edit here to insert filtering 689 ## be sure to fail GRACEFULLY! 690 # 691 # 692 # CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),, 693 # CGI::radio_group(-name=>'sort_by', -values=>['id','alphabetical','section','recitation'], 694 # -labels=>{id=>'Login',alphabetical=>'Alph.',section => 'Sec.',recitation=>'Rec.'}, 695 # -default=>defined($r->param("sort_by")) ? $r->param("sort_by") : 'id', 696 # -linebreak=>0 697 # ), 698 # 699 # CGI::br(),CGI::br(), 700 # CGI::popup_menu(-name=>'classList', 701 # -values=>\@users, 702 # -labels=>\%classlistLabels, 703 # -size => 10, 704 # -multiple => 1, 705 # -default=>$user 706 # ), 707 # ), 708 709 710 711 712 ############################################################################################# 713 # third column 714 ############################################################################################# 715 CGI::td({align=>'left'}, 716 717 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), 718 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), 719 CGI::br(), 720 # CGI::i('Press any action button to update display'),CGI::br(), 721 #show available macros 722 CGI::popup_menu( 723 -name=>'dummyName', 724 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'], 725 -labels=>{''=>'list of insertable macros', 726 '$SID'=>'$SID - Student ID', 727 '$FN'=>'$FN - First name', 728 '$LN'=>'$LN - Last name', 729 '$SECTION'=>'$SECTION', 730 '$RECITATION'=>'$RECITATION', 731 '$STATUS'=>'$STATUS - C, Audit, Drop, etc.', 732 '$EMAIL'=>'$EMAIL - Email address', 733 '$LOGIN'=>'$LOGIN - Login', 734 '$COL[3]'=>'$COL[3] - 3rd col', 735 '$COL[-1]'=>'$COL[-1] - Last column' 736 } 737 ), "\n", 738 ), 739 740 ); # end Tr 741 print CGI::end_table(); 742 ############################################################################################# 743 # end upper table 744 ############################################################################################# 745 746 # show merge file 747 # print "<pre>",(map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} 0..8),"</pre>"; 748 # print CGI::popup_menu( 749 # -name=>'dummyName2', 750 # -values=>\@merge_keys, 751 # -labels=>$rh_merge_data, 752 # -multiple=>1, 753 # -size =>2, 754 # 755 # ), "\n",CGI::br(); 756 # warn "merge keys ", join( " ",@merge_keys); 757 ############################################################################################# 758 # merge file fragment and message text area field 759 ############################################################################################# 760 my @tmp2; 761 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; # checked 762 if ($@ and $merge_file ne 'None') { 763 print "No merge data for $preview_user in merge file: <$merge_file>",CGI::br(); 764 } else { 765 print CGI::pre("",data_format(1..($#tmp2+1)),"<br>", data_format2(@tmp2)); 766 } 767 #create a textbox with the subject and a textarea with the message 768 #print actual body of message 769 770 print "\n", CGI::p( $self->{message}) if defined($self->{message}); 771 print "\n", CGI::p( CGI::textarea(-name=>'body', -default=>$text, -rows=>$rows, -cols=>$columns, -override=>1)); 772 773 ############################################################################################# 774 # action button table 775 ############################################################################################# 776 print CGI::table( { -border=>2,-cellpadding=>4}, 777 CGI::Tr( {}, 778 CGI::td({}, CGI::submit(-name=>'action', -value=>'Send Email') ), "\n", 779 CGI::td({}, CGI::submit(-name=>'action', -value=>'Save')," to $output_file"), " \n", 780 CGI::td({}, CGI::submit(-name=>'action', -value=>'Save as:'), 781 CGI::textfield(-name=>'savefilename', -size => 20, -value=> "$output_file", -override=>1) 782 ), "\n", 783 CGI::td(CGI::submit(-name=>'action', -value=>'Save as Default')), 784 ) 785 ); 786 787 ############################################################################################################## 788 789 print CGI::end_form(); 790 return ""; 791 } 792 793 ############################################################################## 794 # Utility methods 795 ############################################################################## 796 797 sub saveProblem { 798 my $self = shift; 799 my ($body, $probFileName)= @_; 800 local(*PROBLEM); 801 open (PROBLEM, ">$probFileName") || 802 $self->addbadmessage(CGI::p("Could not open $probFileName for writing. 803 Check that the permissions for this problem are 660 (-rw-rw----)")); 804 print PROBLEM $body if -w $probFileName; 805 close PROBLEM; 806 chmod 0660, "$probFileName" || 807 $self->addbadmessage(CGI::p("CAN'T CHANGE PERMISSIONS ON FILE $probFileName")); 808 } 809 810 sub read_input_file { 811 my $self = shift; 812 my $filePath = shift; 813 my ($text, @text); 814 my $header = ''; 815 my ($subject, $from, $replyTo); 816 local(*FILE); 817 if (-e "$filePath" and -r "$filePath") { 818 open FILE, "$filePath" || do { $self->addbadmessage(CGI::p("Can't open $filePath")); return}; 819 while ($header !~ s/Message:\s*$//m and not eof(FILE)) { 820 $header .= <FILE>; 821 } 822 $text = join( '', <FILE>); 823 $text =~ s/^\s*//; # remove initial white space if any. 824 $header =~ /^From:\s(.*)$/m; 825 $from = $1 or $from = $self->{defaultFrom}; 826 827 $header =~ /^Reply-To:\s(.*)$/m; 828 $replyTo = $1 or $replyTo = $self->{defaultReply}; 829 830 $header =~ /^Subject:\s(.*)$/m; 831 $subject = $1; 832 833 } else { 834 $from = $self->{defaultFrom}; 835 $replyTo = $self->{defaultReply}; 836 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist"; 837 $subject = $self->{defaultSubject}; 838 } 839 return ($from, $replyTo, $subject, \$text); 840 } 841 842 843 sub get_message_file_names { 844 my $self = shift; 845 return $self->read_dir($self->{ce}->{courseDirs}->{email}, '\\.msg$'); 846 } 847 sub get_merge_file_names { 848 my $self = shift; 849 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed. 850 } 851 852 sub mail_message_to_recipients { 853 my $self = shift; 854 my $r = $self->r; 855 my $ce = $r->ce; 856 my $subject = $self->{subject}; 857 my $from = $self->{from}; 858 my @recipients = @{$self->{ra_send_to}}; 859 my $rh_merge_data = $self->{rh_merge_data}; 860 my $merge_file = $self->{merge_file}; 861 my $result_message = ''; 862 my $failed_messages = 0; 863 864 foreach my $recipient (@recipients) { 865 # warn "FIXME sending email to $recipient"; 866 my $error_messages = ''; 867 my $ur = $self->{db}->getUser($recipient); #checked 868 unless ($ur) { 869 $error_messages .= "Record for user $recipient not found\n"; 870 next; 871 } 872 unless ($ur->email_address) { 873 $error_messages .="User $recipient does not have an email address -- skipping\n"; 874 next; 875 } 876 my $msg = eval { $self->process_message($ur,$rh_merge_data) }; 877 $error_messages .= "There were errors in processing user $recipient, merge file $merge_file. \n$@\n" if $@; 878 my $mailer = Mail::Sender->new({ 879 from => $ce->{mail}{smtpSender}, 880 fake_from => $from, 881 to => $ur->email_address, 882 smtp => $self->{smtpServer}, 883 subject => $subject, 884 headers => "X-Remote-Host: ".$self->{remote_host}, 885 }); 886 unless (ref $mailer) { 887 $error_messages .= "Failed to create a mailer for user $recipient: $Mail::Sender::Error\n"; 888 next; 889 } 890 unless (ref $mailer->Open()) { 891 $error_messages .= "Failed to open the mailer for user $recipient: $Mail::Sender::Error\n"; 892 next; 893 } 894 my $MAIL = $mailer->GetHandle() || ($error_messages .= "Couldn't get mailer handle \n"); 895 print $MAIL $msg || ($error_messages .= "Couldn't print to $MAIL"); 896 close $MAIL || ($error_messages .= "Couldn't close $MAIL"); 897 #warn "FIXME mailed to $recipient: ", $ur->email_address, " from $from subject $subject Errors: $error_messages"; 898 $failed_messages++ if $error_messages; 899 $result_message .= $error_messages; 900 } 901 my $courseName = $self->r->urlpath->arg("courseID"); 902 my $number_of_recipients = scalar(@recipients) - $failed_messages; 903 $result_message = <<EndText.$result_message; 904 905 A message with the subject line 906 $subject 907 has been sent to 908 $number_of_recipients recipient(s) in the class $courseName. 909 There were $failed_messages message(s) that could not be delivered. 910 911 EndText 912 913 } 914 sub email_notification { 915 my $self = shift; 916 my $result_message = shift; 917 # find info on mailer and sender 918 # use the defaultFrom address. 919 920 # find info on instructor recipient and message 921 my $subject="WeBWorK email sent"; 922 923 my $mailing_errors = ""; 924 # open MAIL handle 925 my $mailer = Mail::Sender->new({ 926 from => $self->{defaultFrom}, 927 to => $self->{defaultFrom}, 928 smtp => $self->{smtpServer}, 929 subject => $subject, 930 headers => "X-Remote-Host: ".$self->{remote_host}, 931 }); 932 unless (ref $mailer) { 933 $mailing_errors .= "Failed to create a mailer: $Mail::Sender::Error"; 934 return ""; 935 } 936 unless (ref $mailer->Open()) { 937 $mailing_errors .= "Failed to open the mailer: $Mail::Sender::Error"; 938 return ""; 939 } 940 my $MAIL = $mailer->GetHandle(); 941 # print message 942 print $MAIL $result_message; 943 # clean up 944 close $MAIL; 945 946 warn "instructor message sent to ", $self->{defaultFrom}; 947 948 } 949 sub getRecord { 950 my $self = shift; 951 my $line = shift; 952 my $delimiter = shift; 953 $delimiter = ',' unless defined($delimiter); 954 955 # Takes a delimited line as a parameter and returns an 956 # array. Note that all white space is removed. If the 957 # last field is empty, the last element of the returned 958 # array is also empty (unlike what the perl split command 959 # would return). E.G. @lineArray=&getRecord(\$delimitedLine). 960 961 my(@lineArray); 962 $line.="${delimiter}___"; # add final field which must be non-empty 963 @lineArray = split(/\s*${delimiter}\s*/,$line); # split line into fields 964 $lineArray[0] =~s/^\s*//; # remove white space from first element 965 pop @lineArray; # remove the last artificial field 966 @lineArray; 967 } 968 969 sub process_message { 970 my $self = shift; 971 my $ur = shift; 972 my $rh_merge_data = shift; 973 my $for_preview = shift; 974 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 975 'FIXME no text was produced by initialization!!'; 976 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 977 978 my $status_name = $self->r->ce->status_abbrev_to_name($ur->status); 979 $status_name = $ur->status unless defined $status_name; 980 981 #user macros that can be used in the email message 982 my $SID = $ur->student_id; 983 my $FN = $ur->first_name; 984 my $LN = $ur->last_name; 985 my $SECTION = $ur->section; 986 my $RECITATION = $ur->recitation; 987 my $STATUS = $status_name; 988 my $EMAIL = $ur->email_address; 989 my $LOGIN = $ur->user_id; 990 991 # get record from merge file 992 # FIXME this is inefficient. The info should be cached 993 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); 994 if ($merge_file ne 'None' and not defined($rh_merge_data->{$SID}) and $for_preview) { 995 $self->addbadmessage(CGI::p("No merge data for student id:$SID; name:$FN $LN; login:$LOGIN")); 996 } 997 unshift(@COL,""); ## this makes COL[1] the first column 998 my $endCol = @COL; 999 # for safety, only evaluate special variables 1000 my $msg = $text; 1001 $msg =~ s/\$SID/$SID/ge; 1002 $msg =~ s/\$LN/$LN/ge; 1003 $msg =~ s/\$FN/$FN/ge; 1004 $msg =~ s/\$STATUS/$STATUS/ge; 1005 $msg =~ s/\$SECTION/$SECTION/ge; 1006 $msg =~ s/\$RECITATION/$RECITATION/ge; 1007 $msg =~ s/\$EMAIL/$EMAIL/ge; 1008 $msg =~ s/\$LOGIN/$LOGIN/ge; 1009 if (defined($COL[1])) { # prevents extraneous error messages. 1010 $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1]/ge 1011 } 1012 else { # prevents extraneous $COL's in email message 1013 $msg =~ s/\$COL\[(\-?\d+)\]//g 1014 } 1015 1016 $msg =~ s/\r//g; 1017 1018 if ($for_preview) { 1019 my @preview_COL = @COL; 1020 shift @preview_COL; ## shift back for preview 1021 my $preview_header = CGI::pre({},data_format(1..($#COL)),"<br>", data_format2(@preview_COL)). 1022 CGI::h3( "This sample mail would be sent to $EMAIL"); 1023 return $msg, $preview_header; 1024 } else { 1025 return $msg; 1026 } 1027 } 1028 1029 1030 # Ý sub data_format { 1031 # 1032 # Ý Ý Ý Ý Ýmap {$_ =~s/\s/\./g;$_} Ý Ý map {sprintf('%-8.8s',$_);} Ý@_; 1033 sub data_format { 1034 map {"COL[$_]".' 'x(3-length($_));} @_; # problems if $_ has length bigger than 4 1035 } 1036 sub data_format2 { 1037 map {$_ =~s/\s/ /g;$_} map {sprintf('%-8.8s',$_);} @_; 1038 } 1039 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |