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