Parent Directory
| 
Revision Log
forward-port from rel-2-2-dev: (update copyright date range -- 2000-2006. this is probably overkill, since there are some files that were created after 2000 and some files that were last modified before 2006.)
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm,v 1.45 2005/12/18 22:37:18 sh002i 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) 169 if $ce->status_abbrev_has_behavior($ur->status, "include_in_email") 170 and not $ur->user_id =~ /practice/; 171 } 172 } elsif (defined($recipients) and $recipients eq 'studentID' ) { 173 @send_to = $r->param('classList'); 174 } else { 175 # no recipients have been defined -- probably the first time on the page 176 } 177 $self->{ra_send_to} = \@send_to; 178 ################################################################# 179 # Check the validity of the input file name 180 ################################################################# 181 my $input_file = ''; 182 #make sure an input message file was submitted and exists 183 #else use the default message 184 if ( defined($openfilename) ) { 185 if ( -e "${emailDirectory}/$openfilename") { 186 if ( -R "${emailDirectory}/$openfilename") { 187 $input_file = $openfilename; 188 } else { 189 $self->addbadmessage(CGI::p(join("", 190 "The file ${emailDirectory}/$openfilename is not readable by the webserver.",CGI::br(), 191 "Check that it's permissions are set correctly.", 192 ))); 193 } 194 } else { 195 $input_file = $default_msg_file; 196 $self->addbadmessage(CGI::p(join("", 197 "The file ${emailDirectory}/$openfilename cannot be found.",CGI::br(), 198 "Check whether it exists and whether the directory $emailDirectory can be read by the webserver.",CGI::br(), 199 "Using contents of the default message $default_msg_file instead.", 200 ))); 201 } 202 } else { 203 $input_file = $default_msg_file; 204 } 205 $self->{input_file} =$input_file; 206 207 ################################################################# 208 # Determine the file name to save message into 209 ################################################################# 210 my $output_file = 'FIXME no output file specified'; 211 if (defined($action) and $action eq 'Save as Default') { 212 $output_file = $default_msg_file; 213 } elsif ( defined($action) and ($action =~/save/i)) { 214 if (defined($savefilename) and $savefilename ) { 215 $output_file = $savefilename; 216 } else { 217 $self->addbadmessage(CGI::p("No filename was specified for saving! The message was not saved.")); 218 } 219 } elsif ( defined($input_file) ) { 220 $output_file = $input_file; 221 } 222 223 ################################################################# 224 # Sanity check on save file name 225 ################################################################# 226 227 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) { 228 $self->addbadmessage(CGI::p("For security reasons, you cannot specify a message file from a directory", 229 "higher than the email directory (you can't use ../blah/blah for example). ", 230 "Please specify a different file or move the needed file to the email directory",)); 231 } 232 unless ($output_file =~ m|\.msg$| ) { 233 $self->addbadmessage(CGI::p("Invalid file name.", 234 "The file name \"$output_file\" does not have a \".msg\" extension", 235 "All email file names must end in the extension \".msg\"", 236 "choose a file name with a \".msg\" extension.", 237 "The message was not saved.",)); 238 } 239 240 $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing. 241 242 243 ############################################################################################# 244 # Determine input source 245 ############################################################################################# 246 #warn "Action = $action"; 247 my $input_source; 248 if ($action){ 249 $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file';} 250 else { $input_source = ( defined($r->param('body')) ) ? 'form' : 'file';} 251 252 ############################################################################################# 253 # Get inputs 254 ############################################################################################# 255 my($from, $replyTo, $r_text, $subject); 256 if ($input_source eq 'file') { 257 258 ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file"); 259 260 261 } elsif ($input_source eq 'form') { 262 # read info from the form 263 # bail if there is no message body 264 265 $from = $r->param('from'); 266 $replyTo = $r->param('replyTo'); 267 $subject = $r->param('subject'); 268 my $body = $r->param('body'); 269 # Sanity check: body must contain non-white space 270 $self->addbadmessage(CGI::p('You didn\'t enter any message.')) unless ($r->param('body') =~ /\S/); 271 $r_text = \$body; 272 273 } 274 # store data 275 $self->{from} = $from; 276 $self->{replyTo} = $replyTo; 277 $self->{subject} = $subject; 278 $self->{r_text} = $r_text; 279 280 281 282 ################################################################################### 283 #Determine the appropriate script action from the buttons 284 ################################################################################### 285 # first time actions 286 # open new file 287 # open default file 288 # choose merge file actions 289 # chose merge button 290 # option actions 291 # 'reset rows' 292 293 # save actions 294 # "save" button 295 # "save as" button 296 # "save as default" button 297 # preview actions 298 # 'preview' button 299 # email actions 300 # 'entire class' 301 # 'selected studentIDs' 302 # error actions (various) 303 304 305 ############################################################################################# 306 # if no form is submitted, gather data needed to produce the mail form and return 307 ############################################################################################# 308 my $to = $r->param('To'); 309 my $script_action = ''; 310 311 312 if(not defined($action) or $action eq 'Open' 313 or $action eq $UPDATE_SETTINGS_BUTTON ){ 314 315 return ''; 316 } 317 318 319 320 321 322 ############################################################################################# 323 # If form is submitted deal with filled out forms 324 # and various actions resulting from different buttons 325 ############################################################################################# 326 327 328 if ($action eq 'Save' or $action eq 'Save as:' or $action eq 'Save as Default') { 329 330 # warn "FIXME Saving files action = $action outputFileName=$output_file"; 331 332 ################################################################# 333 # construct message body 334 ################################################################# 335 my $temp_body = ${ $r_text }; 336 $temp_body =~ s/\r\n/\n/g; 337 $temp_body = join("", 338 "From: $from \nReply-To: $replyTo\n" , 339 "Subject: $subject\n" , 340 "Message: \n $temp_body"); 341 # warn "FIXME from $from | subject $subject |reply $replyTo|msg $temp_body"; 342 ################################################################# 343 # overwrite protection 344 ################################################################# 345 if ($action eq 'Save as:' and -e "$emailDirectory/$output_file") { 346 $self->addbadmessage(CGI::p("The file $emailDirectory/$output_file already exists and cannot be overwritten", 347 "The message was not saved")); 348 return; 349 } 350 351 ################################################################# 352 # Back up existing file? 353 ################################################################# 354 if ($action eq 'Save as Default' and -e "$emailDirectory/$default_msg_file") { 355 rename("$emailDirectory/$default_msg_file","$emailDirectory/$old_default_msg_file") or 356 die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ", 357 "Check permissions for webserver on directory $emailDirectory. $!"; 358 $self->addgoodmessage(CGI::p("Backup file <code>$emailDirectory/$old_default_msg_file</code> created." . CGI::br())); 359 } 360 ################################################################# 361 # Save the message 362 ################################################################# 363 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ) unless ($output_file =~ /^[~.]/ || $output_file =~ /\.\./ || not $output_file =~ m|\.msg$|); 364 unless ( $self->{submit_message} or not -w "${emailDirectory}/$output_file" ) { # if there are no errors report success 365 $self->addgoodmessage(CGI::p("Message saved to file <code>${emailDirectory}/$output_file</code>.")); 366 } 367 368 } elsif ($action eq 'Preview message') { 369 $self->{response} = 'preview'; 370 371 } elsif ($action eq 'Send Email') { 372 $self->{response} = 'send_email'; 373 374 # check that recipients have been selected. 375 my @recipients = @{$self->{ra_send_to}}; 376 $self->addbadmessage(CGI::p("No recipients selected ")) unless @recipients; 377 # get merge file 378 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 379 my $delimiter = ','; 380 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 381 unless (ref($rh_merge_data) ) { 382 $self->addbadmessage(CGI::p("No merge data file")); 383 $self->addbadmessage(CGI::p("Can't read merge file $merge_file. No message sent")); 384 return; 385 } ; 386 if (@recipients) { 387 $self->{rh_merge_data} = $rh_merge_data; 388 $self->{smtpServer} = $ce->{mail}->{smtpServer}; 389 my $post_connection_action = sub { 390 my $r = shift; 391 my $result_message = $self->mail_message_to_recipients(); 392 $self->email_notification($result_message); 393 }; 394 $r->post_connection($post_connection_action) ; 395 } 396 # foreach my $recipient (@recipients) { 397 # #warn "FIXME sending email to $recipient"; 398 # my $ur = $self->{db}->getUser($recipient); #checked 399 # die "record for user $recipient not found" unless $ur; 400 # unless ($ur->email_address) { 401 # $self->addbadmessage(CGI::p("user $recipient does not have an email address -- skipping")); 402 # next; 403 # } 404 # my ($msg, $preview_header); 405 # eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); }; 406 # $self->addbadmessage(CGI::p("There were errors in processing user $ur, merge file $merge_file. $@")) if $@; 407 # my $mailer = Mail::Sender->new({ 408 # from => $from, 409 # to => $ur->email_address, 410 # smtp => $ce->{mail}->{smtpServer}, 411 # subject => $subject, 412 # headers => "X-Remote-Host: ".$r->get_remote_host(), 413 # }); 414 # unless (ref $mailer) { 415 # $self->addbadmessage(CGI::p("Failed to create a mailer for user $recipient: $Mail::Sender::Error")); 416 # next; 417 # } 418 # unless (ref $mailer->Open()) { 419 # $self->addbadmessage(CGI::p("Failed to open the mailer for user $recipient: $Mail::Sender::Error")); 420 # next; 421 # } 422 # my $MAIL = $mailer->GetHandle() or $self->addbadmessage(CGI::p("Couldn't get handle")); 423 # print $MAIL $msg || $self->addbadmessage(CGI::p("Couldn't print to $MAIL")); 424 # close $MAIL || $self->addbadmessage(CGI::p("Couldn't close $MAIL")); 425 # #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject"; 426 # 427 # } 428 429 } else { 430 $self->addbadmessage(CGI::p("Didn't recognize button $action")); 431 } 432 433 434 435 } #end initialize 436 437 438 439 440 441 sub body { 442 my ($self) = @_; 443 my $r = $self->r; 444 my $urlpath = $r->urlpath; 445 my $authz = $r->authz; 446 my $setID = $urlpath->arg("setID"); 447 my $response = (defined($self->{response}))? $self->{response} : ''; 448 my $user = $r->param('user'); 449 450 # Check permissions 451 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to access instructor tools")) 452 unless $authz->hasPermissions($user, "access_instructor_tools"); 453 454 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to send mail to students")) 455 unless $authz->hasPermissions($user, "send_mail"); 456 457 if ($response eq 'preview') { 458 $self->print_preview($setID); 459 } elsif (($response eq 'send_email')){ 460 my $message = CGI::i("Email is being sent to ". scalar(@{$self->{ra_send_to}})." recipients. You will be notified" 461 ." by email when the task is completed. This may take several minutes if the class is large." 462 ); 463 $self->addgoodmessage($message); 464 $self->{message} .= $message; 465 466 $self->print_form($setID); 467 } else { 468 $self->print_form($setID); 469 } 470 471 } 472 sub print_preview { 473 my ($self) = @_; 474 my $r = $self->r; 475 my $urlpath = $r->urlpath; 476 my $setID = $urlpath->arg("setID"); 477 478 # get preview user 479 my $ur = $r->db->getUser($self->{preview_user}); #checked 480 die "record for preview user ".$self->{preview_user}. " not found." unless $ur; 481 482 # get merge file 483 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 484 my $delimiter = ','; 485 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 486 487 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data); 488 489 my $recipients = join(" ",@{$self->{ra_send_to} }); 490 my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ; 491 $msg = join("", 492 $errorMessage, 493 $preview_header, 494 "To: " , $ur->email_address,"\n", 495 "From: " , $self->{from} , "\n" , 496 "Reply-To: " , $self->{replyTo} , "\n" , 497 "Subject: " , $self->{subject} , "\n" ,"\n" , 498 $msg , "\n" 499 ); 500 501 return join("", '<pre>',$msg,"\n","\n", 502 '</pre>', 503 CGI::p('Use browser back button to return from preview mode'), 504 CGI::h3('Emails to be sent to the following:'), 505 $recipients, "\n", 506 507 ); 508 509 } 510 sub print_form { 511 my ($self) = @_; 512 my $r = $self->r; 513 my $urlpath = $r->urlpath; 514 my $authz = $r->authz; 515 my $db = $r->db; 516 my $ce = $r->ce; 517 my $courseName = $urlpath->arg("courseID"); 518 my $setID = $urlpath->arg("setID"); 519 my $user = $r->param('user'); 520 521 my $root = $ce->{webworkURLs}->{root}; 522 my $sendMailPage = $urlpath->newFromModule($urlpath->module,courseID=>$courseName); 523 my $sendMailURL = $self->systemLink($sendMailPage, authen => 0); 524 525 return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); 526 527 my $userTemplate = $db->newUser; 528 my $permissionLevelTemplate = $db->newPermissionLevel; 529 530 # This code will require changing if the permission and user tables ever have different keys. 531 my @users = sort @{ $self->{ra_users} }; 532 my $ra_user_records = $self->{ra_user_records}; 533 my %classlistLabels = ();# %$hr_classlistLabels; 534 foreach my $ur (@{ $ra_user_records }) { 535 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation; 536 } 537 538 ## Mark edit define scrolling list 539 my $scrolling_user_list = scrollingRecordList({ 540 name => "classList", ## changed from classList to action 541 request => $r, 542 default_sort => "lnfn", 543 default_format => "lnfn_uid", 544 default_filters => ["all"], 545 size => 5, 546 multiple => 1, 547 refresh_button_name =>'Update settings and refresh page', 548 }, @{$ra_user_records}); 549 550 ############################################################################################################## 551 552 553 my $from = $self->{from}; 554 my $subject = $self->{subject}; 555 my $replyTo = $self->{replyTo}; 556 my $columns = $self->{columns}; 557 my $rows = $self->{rows}; 558 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 'FIXME no text was produced by initialization!!'; 559 my $input_file = $self->{input_file}; 560 my $output_file = $self->{output_file}; 561 my @sorted_messages = $self->get_message_file_names; 562 my @sorted_merge_files = $self->get_merge_file_names; 563 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 564 my $delimiter = ','; 565 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 566 my @merge_keys = keys %$rh_merge_data; 567 my $preview_user = $self->{preview_user}; 568 my $preview_record = $db->getUser($preview_user); # checked 569 die "record for preview user ".$self->{preview_user}. " not found." unless $preview_record; 570 571 572 ############################################################################################# 573 574 print CGI::start_form({method=>"post", action=>$sendMailURL}); 575 print $self->hidden_authen_fields(); 576 ############################################################################################# 577 # begin upper table 578 ############################################################################################# 579 580 print CGI::start_table({-border=>'2', -cellpadding=>'4'}); 581 print CGI::Tr({-align=>'left',-valign=>'top'}, 582 ############################################################################################# 583 # first column 584 ############################################################################################# 585 586 CGI::td(CGI::strong("Message file: "), $input_file,"\n",CGI::br(), 587 CGI::submit(-name=>'action', -value=>'Open'), ' ',"\n", 588 CGI::popup_menu(-name=>'openfilename', 589 -values=>\@sorted_messages, 590 -default=>$input_file 591 ), 592 "\n",CGI::br(), 593 CGI::strong("Save file to: "), $output_file, 594 "\n",CGI::br(), 595 CGI::strong('Merge file: '), $merge_file, 596 CGI::br(), 597 CGI::popup_menu(-name=>'merge_file', 598 -values=>\@sorted_merge_files, 599 -default=>$merge_file, 600 ), "\n", 601 "\n", 602 #CGI::hr(), 603 CGI::div({style=>"background-color: #CCCCCC"}, 604 "\n", 'From:',' ', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1), 605 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1), 606 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>30, -override=>1), 607 ), 608 #CGI::hr(), 609 CGI::submit(-name=>'action', -value=>$UPDATE_SETTINGS_BUTTON), 610 611 ), 612 ############################################################################################# 613 # second column 614 ############################################################################################# 615 # CGI::td({-align=>'left',style=>'font-size:smaller'}, 616 # 617 # CGI::strong("Send to:"), 618 # CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], 619 # -labels=>{all_students=>'All students in course',studentID => 'Selected'}, 620 # -default=>'studentID', 621 # -linebreak=>0 622 # ), CGI::br(),CGI::br(), 623 ## Edit by Mark to insert scrolling list 624 CGI::td({-style=>"width:33%"},CGI::strong("Send to:"), 625 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], 626 -labels=>{all_students=>'All students in course',studentID => 'Selected students'}, 627 -default=>'studentID', -linebreak=>0), 628 CGI::br(),$scrolling_user_list, 629 CGI::i("Preview set to: "), $preview_record->last_name, 630 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview message'),' ', 631 ), 632 633 ## Edit here to insert filtering 634 ## be sure to fail GRACEFULLY! 635 # 636 # 637 # CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),, 638 # CGI::radio_group(-name=>'sort_by', -values=>['id','alphabetical','section','recitation'], 639 # -labels=>{id=>'Login',alphabetical=>'Alph.',section => 'Sec.',recitation=>'Rec.'}, 640 # -default=>defined($r->param("sort_by")) ? $r->param("sort_by") : 'id', 641 # -linebreak=>0 642 # ), 643 # 644 # CGI::br(),CGI::br(), 645 # CGI::popup_menu(-name=>'classList', 646 # -values=>\@users, 647 # -labels=>\%classlistLabels, 648 # -size => 10, 649 # -multiple => 1, 650 # -default=>$user 651 # ), 652 # ), 653 654 655 656 657 ############################################################################################# 658 # third column 659 ############################################################################################# 660 CGI::td({align=>'left'}, 661 # "<b>Merge file:</b> $merge_file", CGI::br(), 662 # CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(), 663 # CGI::popup_menu(-name=>'merge_file', 664 # -values=>\@sorted_merge_files, 665 # -default=>$merge_file, 666 # ), "\n", 667 # CGI::hr(), 668 # CGI::b("Viewing email for: "), "$preview_user",CGI::br(), 669 # CGI::submit(-name=>'action', -value=>'resize', -label=>$REFRESH_RESIZE_BUTTON),' ', 670 # CGI::popup_menu(-name=>'preview_user', 671 # -values=>\@users, 672 # #-labels=>\%classlistLabels, 673 # -default=>$preview_user, 674 # ), 675 # CGI::br(), 676 # CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview message'),' ', 677 # 678 # CGI::br(), 679 # 680 # CGI::hr(), 681 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), 682 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), 683 CGI::br(), 684 # CGI::i('Press any action button to update display'),CGI::br(), 685 #show available macros 686 CGI::popup_menu( 687 -name=>'dummyName', 688 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'], 689 -labels=>{''=>'list of insertable macros', 690 '$SID'=>'$SID - Student ID', 691 '$FN'=>'$FN - First name', 692 '$LN'=>'$LN - Last name', 693 '$SECTION'=>'$SECTION', 694 '$RECITATION'=>'$RECITATION', 695 '$STATUS'=>'$STATUS - C, Audit, Drop, etc.', 696 '$EMAIL'=>'$EMAIL - Email address', 697 '$LOGIN'=>'$LOGIN - Login', 698 '$COL[3]'=>'$COL[3] - 3rd col', 699 '$COL[-1]'=>'$COL[-1] - Last column' 700 } 701 ), "\n", 702 ), 703 704 ); # end Tr 705 print CGI::end_table(); 706 ############################################################################################# 707 # end upper table 708 ############################################################################################# 709 710 # show merge file 711 # print "<pre>",(map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} 0..8),"</pre>"; 712 # print CGI::popup_menu( 713 # -name=>'dummyName2', 714 # -values=>\@merge_keys, 715 # -labels=>$rh_merge_data, 716 # -multiple=>1, 717 # -size =>2, 718 # 719 # ), "\n",CGI::br(); 720 # warn "merge keys ", join( " ",@merge_keys); 721 ############################################################################################# 722 # merge file fragment and message text area field 723 ############################################################################################# 724 my @tmp2; 725 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; # checked 726 if ($@ and $merge_file ne 'None') { 727 print "No merge data for $preview_user in merge file: <$merge_file>",CGI::br(); 728 } else { 729 print CGI::pre("",data_format(1..($#tmp2+1)),"<br>", data_format2(@tmp2)); 730 } 731 #create a textbox with the subject and a textarea with the message 732 #print actual body of message 733 734 print "\n", CGI::p( $self->{message}) if defined($self->{message}); 735 print "\n", CGI::p( CGI::textarea(-name=>'body', -default=>$text, -rows=>$rows, -columns=>$columns, -override=>1)); 736 737 ############################################################################################# 738 # action button table 739 ############################################################################################# 740 print CGI::table( { -border=>2,-cellpadding=>4}, 741 CGI::Tr( 742 CGI::td( CGI::submit(-name=>'action', -value=>'Send Email') ), "\n", 743 CGI::td(CGI::submit(-name=>'action', -value=>'Save')," to $output_file"), " \n", 744 CGI::td(CGI::submit(-name=>'action', -value=>'Save as:'), 745 CGI::textfield(-name=>'savefilename', -size => 20, -value=> "$output_file", -override=>1) 746 ), "\n", 747 CGI::td(CGI::submit(-name=>'action', -value=>'Save as Default')), 748 ) 749 ); 750 751 ############################################################################################################## 752 753 print CGI::end_form(); 754 return ""; 755 } 756 757 ############################################################################## 758 # Utility methods 759 ############################################################################## 760 761 sub saveProblem { 762 my $self = shift; 763 my ($body, $probFileName)= @_; 764 local(*PROBLEM); 765 open (PROBLEM, ">$probFileName") || 766 $self->addbadmessage(CGI::p("Could not open $probFileName for writing. 767 Check that the permissions for this problem are 660 (-rw-rw----)")); 768 print PROBLEM $body if -w $probFileName; 769 close PROBLEM; 770 chmod 0660, "$probFileName" || 771 $self->addbadmessage(CGI::p("CAN'T CHANGE PERMISSIONS ON FILE $probFileName")); 772 } 773 774 sub read_input_file { 775 my $self = shift; 776 my $filePath = shift; 777 my ($text, @text); 778 my $header = ''; 779 my ($subject, $from, $replyTo); 780 local(*FILE); 781 if (-e "$filePath" and -r "$filePath") { 782 open FILE, "$filePath" || do { $self->addbadmessage(CGI::p("Can't open $filePath")); return}; 783 while ($header !~ s/Message:\s*$//m and not eof(FILE)) { 784 $header .= <FILE>; 785 } 786 $text = join( '', <FILE>); 787 $text =~ s/^\s*//; # remove initial white space if any. 788 $header =~ /^From:\s(.*)$/m; 789 $from = $1 or $from = $self->{defaultFrom}; 790 791 $header =~ /^Reply-To:\s(.*)$/m; 792 $replyTo = $1 or $replyTo = $self->{defaultReply}; 793 794 $header =~ /^Subject:\s(.*)$/m; 795 $subject = $1; 796 797 } else { 798 $from = $self->{defaultFrom}; 799 $replyTo = $self->{defaultReply}; 800 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist"; 801 $subject = $self->{defaultSubject}; 802 } 803 return ($from, $replyTo, $subject, \$text); 804 } 805 806 807 sub get_message_file_names { 808 my $self = shift; 809 return $self->read_dir($self->{ce}->{courseDirs}->{email}, '\\.msg$'); 810 } 811 sub get_merge_file_names { 812 my $self = shift; 813 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed. 814 } 815 816 sub mail_message_to_recipients { 817 my $self = shift; 818 my $subject = $self->{subject}; 819 my $from = $self->{from}; 820 my @recipients = @{$self->{ra_send_to}}; 821 my $rh_merge_data = $self->{rh_merge_data}; 822 my $merge_file = $self->{merge_file}; 823 my $result_message = ''; 824 my $failed_messages = 0; 825 foreach my $recipient (@recipients) { 826 # warn "FIXME sending email to $recipient"; 827 my $error_messages = ''; 828 my $ur = $self->{db}->getUser($recipient); #checked 829 unless ($ur) { 830 $error_messages .= "Record for user $recipient not found\n"; 831 next; 832 } 833 unless ($ur->email_address) { 834 $error_messages .="User $recipient does not have an email address -- skipping\n"; 835 next; 836 } 837 my ($msg, $preview_header); 838 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); }; 839 $error_messages .= "There were errors in processing user $ur, merge file $merge_file. \n$@\n" if $@; 840 my $mailer = Mail::Sender->new({ 841 from => $from, 842 to => $ur->email_address, 843 smtp => $self->{smtpServer}, 844 subject => $subject, 845 headers => "X-Remote-Host: ".$self->r->get_remote_host(), 846 }); 847 unless (ref $mailer) { 848 $error_messages .= "Failed to create a mailer for user $recipient: $Mail::Sender::Error\n"; 849 next; 850 } 851 unless (ref $mailer->Open()) { 852 $error_messages .= "Failed to open the mailer for user $recipient: $Mail::Sender::Error\n"; 853 next; 854 } 855 my $MAIL = $mailer->GetHandle() || ($error_messages .= "Couldn't get mailer handle \n"); 856 print $MAIL $msg || ($error_messages .= "Couldn't print to $MAIL"); 857 close $MAIL || ($error_messages .= "Couldn't close $MAIL"); 858 #warn "FIXME mailed to $recipient: ", $ur->email_address, " from $from subject $subject Errors: $error_messages"; 859 $failed_messages++ if $error_messages; 860 $result_message .= $error_messages; 861 } 862 my $courseName = $self->r->urlpath->arg("courseID"); 863 my $number_of_recipients = scalar(@recipients) - $failed_messages; 864 $result_message = <<EndText.$result_message; 865 866 A message with the subject line 867 $subject 868 has been sent to 869 $number_of_recipients recipient(s) in the class $courseName. 870 There were $failed_messages message(s) that could not be delivered. 871 872 EndText 873 874 } 875 sub email_notification { 876 my $self = shift; 877 my $result_message = shift; 878 # find info on mailer and sender 879 # use the defaultFrom address. 880 881 # find info on instructor recipient and message 882 my $subject="WeBWorK email sent"; 883 884 my $mailing_errors = ""; 885 # open MAIL handle 886 my $mailer = Mail::Sender->new({ 887 from => $self->{defaultFrom}, 888 to => $self->{defaultFrom}, 889 smtp => $self->{smtpServer}, 890 subject => $subject, 891 headers => "X-Remote-Host: ".$self->r->get_remote_host(), 892 }); 893 unless (ref $mailer) { 894 $mailing_errors .= "Failed to create a mailer: $Mail::Sender::Error"; 895 return ""; 896 } 897 unless (ref $mailer->Open()) { 898 $mailing_errors .= "Failed to open the mailer: $Mail::Sender::Error"; 899 return ""; 900 } 901 my $MAIL = $mailer->GetHandle(); 902 # print message 903 print $MAIL $result_message; 904 # clean up 905 close $MAIL; 906 907 warn "instructor message sent to ", $self->{defaultFrom}; 908 909 } 910 sub getRecord { 911 my $self = shift; 912 my $line = shift; 913 my $delimiter = shift; 914 $delimiter = ',' unless defined($delimiter); 915 916 # Takes a delimited line as a parameter and returns an 917 # array. Note that all white space is removed. If the 918 # last field is empty, the last element of the returned 919 # array is also empty (unlike what the perl split command 920 # would return). E.G. @lineArray=&getRecord(\$delimitedLine). 921 922 my(@lineArray); 923 $line.="${delimiter}___"; # add final field which must be non-empty 924 @lineArray = split(/\s*${delimiter}\s*/,$line); # split line into fields 925 $lineArray[0] =~s/^\s*//; # remove white space from first element 926 pop @lineArray; # remove the last artificial field 927 @lineArray; 928 } 929 930 sub process_message { 931 my $self = shift; 932 my $ur = shift; 933 my $rh_merge_data = shift; 934 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 935 'FIXME no text was produced by initialization!!'; 936 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 937 938 my $status_name = $self->r->ce->status_abbrev_to_name($ur->status); 939 $status_name = $ur->status unless defined $status_name; 940 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 = $status_name; 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 |