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