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