[system] / branches / rel-2-3-dev / webwork2 / lib / WeBWorK / ContentGenerator / Instructor / SendMail.pm Repository:
ViewVC logotype

Diff of /branches/rel-2-3-dev/webwork2/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/webwork2/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm Revision 2786 branches/rel-2-3-dev/webwork2/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm Revision 4934
1################################################################################ 1################################################################################
2# WeBWorK Online Homework Delivery System 2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm,v 1.36 2004/09/14 18:55:58 apizer Exp $ 4# $CVSHeader$
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 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 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 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. 9# version, or (b) the "Artistic License" which comes with this package.
… …
23 23
24=cut 24=cut
25 25
26use strict; 26use strict;
27use warnings; 27use warnings;
28use CGI qw(); 28#use CGI qw(-nosticky );
29use WeBWorK::CGI;
29#use HTML::Entities; 30use HTML::Entities;
30use Mail::Sender; 31use Mail::Sender;
32use Socket qw/unpack_sockaddr_in inet_ntoa/; # for remote host/port info
33use Text::Wrap qw(wrap);
31use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; 34use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/;
32use WeBWorK::Utils::FilterRecords qw/filterRecords/; 35use WeBWorK::Utils::FilterRecords qw/filterRecords/;
33 36
37use mod_perl;
38use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 );
39
34my $REFRESH_RESIZE_BUTTON = "Set preview to: "; # handle submit value idiocy 40#my $REFRESH_RESIZE_BUTTON = "Set preview to: "; # handle submit value idiocy
41my $UPDATE_SETTINGS_BUTTON = "Update settings and refresh page"; # handle submit value idiocy
35sub initialize { 42sub initialize {
36 my ($self) = @_; 43 my ($self) = @_;
37 my $r = $self->r; 44 my $r = $self->r;
38 my $db = $r->db; 45 my $db = $r->db;
39 my $ce = $r->ce; 46 my $ce = $r->ce;
… …
77 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows}; 84 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows};
78 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns}; 85 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns};
79 $self->{default_msg_file} = $default_msg_file; 86 $self->{default_msg_file} = $default_msg_file;
80 $self->{old_default_msg_file} = $old_default_msg_file; 87 $self->{old_default_msg_file} = $old_default_msg_file;
81 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None'; 88 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None';
82 $self->{preview_user} = (defined($r->param('preview_user'))) ? $r->param('preview_user') : $user; 89 #$self->{preview_user} = (defined($r->param('preview_user'))) ? $r->param('preview_user') : $user;
83 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;
84 93
85############################################################################################# 94#############################################################################################
86# gather database data 95# gather database data
87############################################################################################# 96#############################################################################################
88 # FIXME this might be better done in body? We don't always need all of this data. or do we? 97 # FIXME this might be better done in body? We don't always need all of this data. or do we?
89 my @users = $db->listUsers; 98 my @users = $db->listUsers;
90 my @Users = $db->getUsers(@users); 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;
91 my @user_records = (); 102 my @user_records = ();
92 103
93## Mark's code to prefilter userlist 104## Mark's code to prefilter userlist
94 105
95 106
… …
159# I wasn't able to make this work 170# I wasn't able to make this work
160# I edited the selection button to make that clear. 171# I edited the selection button to make that clear.
161# 172#
162 173
163 foreach my $ur (@user_records) { 174 foreach my $ur (@user_records) {
164 push(@send_to,$ur->user_id) if $ur->status eq 'C' and not($ur->user_id =~ /practice/); 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/;
165 } 178 }
166 } elsif (defined($recipients) and $recipients eq 'studentID' ) { 179 } elsif (defined($recipients) and $recipients eq 'studentID' ) {
167 @send_to = $r->param('classList'); 180 @send_to = $r->param('classList');
168 } else { 181 } else {
169 # no recipients have been defined -- probably the first time on the page 182 # no recipients have been defined -- probably the first time on the page
… …
257 # bail if there is no message body 270 # bail if there is no message body
258 271
259 $from = $r->param('from'); 272 $from = $r->param('from');
260 $replyTo = $r->param('replyTo'); 273 $replyTo = $r->param('replyTo');
261 $subject = $r->param('subject'); 274 $subject = $r->param('subject');
262 my $body = $r->param('body'); 275 my $body = $r->param('body');
263 # Sanity check: body must contain non-white space 276 # Sanity check: body must contain non-white space
264 $self->addbadmessage(CGI::p('You didn\'t enter any message.')) unless ($r->param('body') =~ /\S/); 277 $self->addbadmessage(CGI::p('You didn\'t enter any message.')) unless ($r->param('body') =~ /\S/);
265 $r_text = \$body; 278 $r_text = \$body;
266 279
267 } 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
268 # store data 290 # store data
269 $self->{from} = $from; 291 $self->{from} = $from;
270 $self->{replyTo} = $replyTo; 292 $self->{replyTo} = $replyTo;
271 $self->{subject} = $subject; 293 $self->{subject} = $subject;
294 $self->{remote_host} = $remote_host;
272 $self->{r_text} = $r_text; 295 $self->{r_text} = $r_text;
273 296
274 297
275 298
276################################################################################### 299###################################################################################
… …
301############################################################################################# 324#############################################################################################
302 my $to = $r->param('To'); 325 my $to = $r->param('To');
303 my $script_action = ''; 326 my $script_action = '';
304 327
305 328
306 if(not defined($action) or $action eq 'Open' or $action eq $REFRESH_RESIZE_BUTTON or $action eq 'Sort by' 329 if(not defined($action) or $action eq 'Open'
307 or $action eq 'Set merge file to:' ){ 330 or $action eq $UPDATE_SETTINGS_BUTTON ){
308 331
309 return ''; 332 return '';
310 } 333 }
311 334
312 335
… …
362 } elsif ($action eq 'Preview message') { 385 } elsif ($action eq 'Preview message') {
363 $self->{response} = 'preview'; 386 $self->{response} = 'preview';
364 387
365 } elsif ($action eq 'Send Email') { 388 } elsif ($action eq 'Send Email') {
366 $self->{response} = 'send_email'; 389 $self->{response} = 'send_email';
367 390
391 # check that recipients have been selected.
368 my @recipients = @{$self->{ra_send_to}}; 392 my @recipients = @{$self->{ra_send_to}};
369 $self->addbadmessage(CGI::p("No recipients selected ")) unless @recipients; 393 if (@recipients) {
370 # get merge file 394 # get merge file
371 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 395 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
372 my $delimiter = ','; 396 my $delimiter = ',';
373 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 397 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
374 unless (ref($rh_merge_data) ) { 398 unless (ref($rh_merge_data) ) {
375 $self->addbadmessage(CGI::p("No merge data file")); 399 $self->addbadmessage(CGI::p("No merge data file"));
376 $self->addbadmessage(CGI::p("Can't read merge file $merge_file. No message sent")); 400 $self->addbadmessage(CGI::p("Can't read merge file $merge_file. No message sent"));
377 return; 401 return;
378 } ; 402 } ;
379 403 if (@recipients) {
380 404 $self->{rh_merge_data} = $rh_merge_data;
381 foreach my $recipient (@recipients) { 405 $self->{smtpServer} = $ce->{mail}->{smtpServer};
382 #warn "FIXME sending email to $recipient"; 406 my $post_connection_action = sub {
383 my $ur = $self->{db}->getUser($recipient); #checked 407 my $r = shift;
384 die "record for user $recipient not found" unless $ur; 408 my $result_message = $self->mail_message_to_recipients();
385 unless ($ur->email_address) { 409 $self->email_notification($result_message);
386 $self->addbadmessage(CGI::p("user $recipient does not have an email address -- skipping")); 410 };
387 next; 411 if (MP2) {
412 $r->connection->pool->cleanup_register($post_connection_action);
413 } else {
414 $r->post_connection($post_connection_action);
415 }
388 } 416 }
417 } else {
418 $self->addbadmessage(CGI::p("No recipients selected. Please select one or more recipients from the list below."));
419 }
420# foreach my $recipient (@recipients) {
421# #warn "FIXME sending email to $recipient";
422# my $ur = $self->{db}->getUser($recipient); #checked
423# die "record for user $recipient not found" unless $ur;
424# unless ($ur->email_address) {
425# $self->addbadmessage(CGI::p("user $recipient does not have an email address -- skipping"));
426# next;
427# }
389 my ($msg, $preview_header); 428# my ($msg, $preview_header);
390 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); }; 429# eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); };
391 $self->addbadmessage(CGI::p("There were errors in processing user $ur, merge file $merge_file. $@")) if $@; 430# $self->addbadmessage(CGI::p("There were errors in processing user $ur, merge file $merge_file. $@")) if $@;
392 my $mailer = Mail::Sender->new({ 431# my $mailer = Mail::Sender->new({
393 from => $from, 432# from => $from,
394 to => $ur->email_address, 433# to => $ur->email_address,
395 smtp => $ce->{mail}->{smtpServer}, 434# smtp => $ce->{mail}->{smtpServer},
396 subject => $subject, 435# subject => $subject,
397 headers => "X-Remote-Host: ".$r->get_remote_host(), 436# headers => "X-Remote-Host: ".$r->get_remote_host(),
398 }); 437# });
399 unless (ref $mailer) { 438# unless (ref $mailer) {
400 $self->addbadmessage(CGI::p("Failed to create a mailer for user $recipient: $Mail::Sender::Error")); 439# $self->addbadmessage(CGI::p("Failed to create a mailer for user $recipient: $Mail::Sender::Error"));
401 next; 440# next;
402 } 441# }
403 unless (ref $mailer->Open()) { 442# unless (ref $mailer->Open()) {
404 $self->addbadmessage(CGI::p("Failed to open the mailer for user $recipient: $Mail::Sender::Error")); 443# $self->addbadmessage(CGI::p("Failed to open the mailer for user $recipient: $Mail::Sender::Error"));
405 next; 444# next;
406 } 445# }
407 my $MAIL = $mailer->GetHandle() or $self->addbadmessage(CGI::p("Couldn't get handle")); 446# my $MAIL = $mailer->GetHandle() or $self->addbadmessage(CGI::p("Couldn't get handle"));
408 print $MAIL $msg || $self->addbadmessage(CGI::p("Couldn't print to $MAIL")); 447# print $MAIL $msg || $self->addbadmessage(CGI::p("Couldn't print to $MAIL"));
409 close $MAIL || $self->addbadmessage(CGI::p("Couldn't close $MAIL")); 448# close $MAIL || $self->addbadmessage(CGI::p("Couldn't close $MAIL"));
410 #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject"; 449# #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject";
411 450#
412 } 451# }
413 452
414 } else { 453 } else {
415 $self->addbadmessage(CGI::p("Didn't recognize button $action")); 454 $self->addbadmessage(CGI::p("Didn't recognize button $action"));
416 } 455 }
417 456
… …
439 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to send mail to students")) 478 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to send mail to students"))
440 unless $authz->hasPermissions($user, "send_mail"); 479 unless $authz->hasPermissions($user, "send_mail");
441 480
442 if ($response eq 'preview') { 481 if ($response eq 'preview') {
443 $self->print_preview($setID); 482 $self->print_preview($setID);
444 } elsif (($response eq 'send_email')){ 483 } elsif ($response eq 'send_email' and $self->{ra_send_to} and @{$self->{ra_send_to}}){
445 $self->addgoodmessage(CGI::p("Email sent to ". scalar(@{$self->{ra_send_to}})." students.")); 484 my $message = CGI::i("Email is being sent to ". scalar(@{$self->{ra_send_to}})." recipient(s). You will be notified"
446 $self->{message} .= CGI::i("Email sent to ". scalar(@{$self->{ra_send_to}})." students."); 485 ." by email when the task is completed. This may take several minutes if the class is large."
486 );
487 $self->addgoodmessage($message);
488 $self->{message} .= $message;
489
447 $self->print_form($setID); 490 $self->print_form($setID);
448 } else { 491 } else {
449 $self->print_form($setID); 492 $self->print_form($setID);
450 } 493 }
451 494
… …
463 # get merge file 506 # get merge file
464 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 507 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
465 my $delimiter = ','; 508 my $delimiter = ',';
466 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 509 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
467 510
468 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data); 511 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data,1); # 1 == for preview
469 512
470 my $recipients = join(" ",@{$self->{ra_send_to} }); 513 my $recipients = join(" ",@{$self->{ra_send_to} });
471 my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ; 514 my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ;
472 $msg = join("", 515 $msg = join("",
473 $errorMessage, 516 $errorMessage,
… …
507 550
508 my $userTemplate = $db->newUser; 551 my $userTemplate = $db->newUser;
509 my $permissionLevelTemplate = $db->newPermissionLevel; 552 my $permissionLevelTemplate = $db->newPermissionLevel;
510 553
511 # This code will require changing if the permission and user tables ever have different keys. 554 # This code will require changing if the permission and user tables ever have different keys.
512 my @users = @{ $self->{ra_users} }; 555 my @users = sort @{ $self->{ra_users} };
513 my $ra_user_records = $self->{ra_user_records}; 556 my $ra_user_records = $self->{ra_user_records};
514 my %classlistLabels = ();# %$hr_classlistLabels; 557 my %classlistLabels = ();# %$hr_classlistLabels;
515 foreach my $ur (@{ $ra_user_records }) { 558 foreach my $ur (@{ $ra_user_records }) {
516 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation; 559 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation;
517 } 560 }
… …
523 default_sort => "lnfn", 566 default_sort => "lnfn",
524 default_format => "lnfn_uid", 567 default_format => "lnfn_uid",
525 default_filters => ["all"], 568 default_filters => ["all"],
526 size => 5, 569 size => 5,
527 multiple => 1, 570 multiple => 1,
571 refresh_button_name =>'Update settings and refresh page',
528 }, @{$ra_user_records}); 572 }, @{$ra_user_records});
529 573
530############################################################################################################## 574##############################################################################################################
531 575
532 576
… …
561 print CGI::Tr({-align=>'left',-valign=>'top'}, 605 print CGI::Tr({-align=>'left',-valign=>'top'},
562############################################################################################# 606#############################################################################################
563# first column 607# first column
564############################################################################################# 608#############################################################################################
565 609
610 CGI::td({},
566 CGI::td(CGI::strong("Message file: $input_file"),"\n",CGI::br(), 611 CGI::strong("Message file: "), $input_file,"\n",CGI::br(),
567 CGI::submit(-name=>'action', -value=>'Open'), '    ',"\n", 612 CGI::submit(-name=>'action', -value=>'Open'), '    ',"\n",
568 CGI::popup_menu(-name=>'openfilename', 613 CGI::popup_menu(-name=>'openfilename',
569 -values=>\@sorted_messages, 614 -values=>\@sorted_messages,
570 -default=>$input_file 615 -default=>$input_file
616 ),
571 ), "\n",CGI::br(), 617 "\n",CGI::br(),
572 618 CGI::strong("Save file to: "), $output_file,
573 "Save file to: $output_file","\n",CGI::br(), 619 "\n",CGI::br(),
620 CGI::strong('Merge file: '), $merge_file,
621 CGI::br(),
622 CGI::popup_menu(-name=>'merge_file',
623 -values=>\@sorted_merge_files,
624 -default=>$merge_file,
625 ), "\n",
626 "\n",
627 #CGI::hr(),
628 CGI::div({style=>"background-color: #CCCCCC"},
574 "\n", 'From:','     ', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1), 629 "\n", 'From:','     ', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1),
575 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1), 630 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1),
576 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>30, -override=>1), 631 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-cols=>30, -override=>1),
632 ),
633 #CGI::hr(),
634 CGI::submit(-name=>'action', -value=>$UPDATE_SETTINGS_BUTTON),
635
577 ), 636 ),
578############################################################################################# 637#############################################################################################
579# second column 638# second column
580############################################################################################# 639#############################################################################################
581# CGI::td({-align=>'left',style=>'font-size:smaller'}, 640
582#
583# CGI::strong("Send to:"),
584# CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'],
585# -labels=>{all_students=>'All students in course',studentID => 'Selected'},
586# -default=>'studentID',
587# -linebreak=>0
588# ), CGI::br(),CGI::br(),
589## Edit by Mark to insert scrolling list 641## Edit by Mark to insert scrolling list
590 CGI::td({-style=>"width:33%"},CGI::strong("Send to:"), 642 CGI::td({-style=>"width:33%"},
643 CGI::strong("Send to:"),
644 CGI::radio_group(-name=>'radio',
591 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], 645 -values=>['all_students','studentID'],
592 -labels=>{all_students=>'All students in course',studentID => 'Selected students'}, 646 -labels=>{all_students=>'All students in course',studentID => 'Selected students'},
593 -default=>'studentID', -linebreak=>0), 647 -default=>'studentID', -linebreak=>0),
594 CGI::br(),$scrolling_user_list), 648 CGI::br(),$scrolling_user_list,
649 CGI::i("Preview set to: "), $preview_record->last_name,
650 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview message'),'  ',
651 ),
652
595## Edit here to insert filtering 653## Edit here to insert filtering
596## be sure to fail GRACEFULLY! 654## be sure to fail GRACEFULLY!
597# 655#
598# 656#
599# CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),, 657# CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),,
… …
618 676
619############################################################################################# 677#############################################################################################
620# third column 678# third column
621############################################################################################# 679#############################################################################################
622 CGI::td({align=>'left'}, 680 CGI::td({align=>'left'},
623 "<b>Merge file:</b> $merge_file", CGI::br(), 681
624 CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(),
625 CGI::popup_menu(-name=>'merge_file',
626 -values=>\@sorted_merge_files,
627 -default=>$merge_file,
628 ), "\n",CGI::hr(),
629 CGI::b("Viewing email for: "), "$preview_user",CGI::br(),
630 CGI::submit(-name=>'action', -value=>'resize', -label=>$REFRESH_RESIZE_BUTTON),'&nbsp;',
631 CGI::popup_menu(-name=>'preview_user',
632 -values=>\@users,
633 #-labels=>\%classlistLabels,
634 -default=>$preview_user,
635 ),
636 CGI::br(),
637 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview message'),'&nbsp;&nbsp;',
638
639 CGI::br(),
640
641 CGI::hr(),
642 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), 682 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows),
643 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), 683 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns),
684 CGI::br(),
644 CGI::br(),CGI::i('Press any action button to update display'),CGI::br(), 685# CGI::i('Press any action button to update display'),CGI::br(),
645 #show available macros 686 #show available macros
646 CGI::popup_menu( 687 CGI::popup_menu(
647 -name=>'dummyName', 688 -name=>'dummyName',
648 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'], 689 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'],
649 -labels=>{''=>'list of insertable macros', 690 -labels=>{''=>'list of insertable macros',
… …
690 } 731 }
691#create a textbox with the subject and a textarea with the message 732#create a textbox with the subject and a textarea with the message
692#print actual body of message 733#print actual body of message
693 734
694 print "\n", CGI::p( $self->{message}) if defined($self->{message}); 735 print "\n", CGI::p( $self->{message}) if defined($self->{message});
695 print "\n", CGI::p( CGI::textarea(-name=>'body', -default=>$text, -rows=>$rows, -columns=>$columns, -override=>1)); 736 print "\n", CGI::p( CGI::textarea(-name=>'body', -default=>$text, -rows=>$rows, -cols=>$columns, -override=>1));
696 737
697############################################################################################# 738#############################################################################################
698# action button table 739# action button table
699############################################################################################# 740#############################################################################################
700 print CGI::table( { -border=>2,-cellpadding=>4}, 741 print CGI::table( { -border=>2,-cellpadding=>4},
701 CGI::Tr( 742 CGI::Tr( {},
702 CGI::td( CGI::submit(-name=>'action', -value=>'Send Email') ), "\n", 743 CGI::td({}, CGI::submit(-name=>'action', -value=>'Send Email') ), "\n",
703 CGI::td(CGI::submit(-name=>'action', -value=>'Save')," to $output_file"), " \n", 744 CGI::td({}, CGI::submit(-name=>'action', -value=>'Save')," to $output_file"), " \n",
704 CGI::td(CGI::submit(-name=>'action', -value=>'Save as:'), 745 CGI::td({}, CGI::submit(-name=>'action', -value=>'Save as:'),
705 CGI::textfield(-name=>'savefilename', -size => 20, -value=> "$output_file", -override=>1) 746 CGI::textfield(-name=>'savefilename', -size => 20, -value=> "$output_file", -override=>1)
706 ), "\n", 747 ), "\n",
707 CGI::td(CGI::submit(-name=>'action', -value=>'Save as Default')), 748 CGI::td(CGI::submit(-name=>'action', -value=>'Save as Default')),
708 ) 749 )
709 ); 750 );
… …
715} 756}
716 757
717############################################################################## 758##############################################################################
718# Utility methods 759# Utility methods
719############################################################################## 760##############################################################################
720sub submission_error {
721 my $self = shift;
722 my $msg = join( " ", @_);
723 $self->{submitError} .= CGI::br().$msg;
724 return;
725}
726 761
727sub saveProblem { 762sub saveProblem {
728 my $self = shift; 763 my $self = shift;
729 my ($body, $probFileName)= @_; 764 my ($body, $probFileName)= @_;
730 local(*PROBLEM); 765 local(*PROBLEM);
… …
777sub get_merge_file_names { 812sub get_merge_file_names {
778 my $self = shift; 813 my $self = shift;
779 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed. 814 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed.
780} 815}
781 816
817sub mail_message_to_recipients {
818 my $self = shift;
819 my $r = $self->r;
820 my $ce = $r->ce;
821 my $subject = $self->{subject};
822 my $from = $self->{from};
823 my @recipients = @{$self->{ra_send_to}};
824 my $rh_merge_data = $self->{rh_merge_data};
825 my $merge_file = $self->{merge_file};
826 my $result_message = '';
827 my $failed_messages = 0;
828 foreach my $recipient (@recipients) {
829 # warn "FIXME sending email to $recipient";
830 my $error_messages = '';
831 my $ur = $self->{db}->getUser($recipient); #checked
832 unless ($ur) {
833 $error_messages .= "Record for user $recipient not found\n";
834 next;
835 }
836 unless ($ur->email_address) {
837 $error_messages .="User $recipient does not have an email address -- skipping\n";
838 next;
839 }
840 my $msg = eval { $self->process_message($ur,$rh_merge_data) };
841 $error_messages .= "There were errors in processing user $recipient, merge file $merge_file. \n$@\n" if $@;
842 my $mailer = Mail::Sender->new({
843 from => $ce->{mail}{smtpSender},
844 fake_from => $from,
845 to => $ur->email_address,
846 smtp => $self->{smtpServer},
847 subject => $subject,
848 headers => "X-Remote-Host: ".$self->{remote_host},
849 });
850 unless (ref $mailer) {
851 $error_messages .= "Failed to create a mailer for user $recipient: $Mail::Sender::Error\n";
852 next;
853 }
854 unless (ref $mailer->Open()) {
855 $error_messages .= "Failed to open the mailer for user $recipient: $Mail::Sender::Error\n";
856 next;
857 }
858 my $MAIL = $mailer->GetHandle() || ($error_messages .= "Couldn't get mailer handle \n");
859 print $MAIL $msg || ($error_messages .= "Couldn't print to $MAIL");
860 close $MAIL || ($error_messages .= "Couldn't close $MAIL");
861 #warn "FIXME mailed to $recipient: ", $ur->email_address, " from $from subject $subject Errors: $error_messages";
862 $failed_messages++ if $error_messages;
863 $result_message .= $error_messages;
864 }
865 my $courseName = $self->r->urlpath->arg("courseID");
866 my $number_of_recipients = scalar(@recipients) - $failed_messages;
867 $result_message = <<EndText.$result_message;
868
869 A message with the subject line
870 $subject
871 has been sent to
872 $number_of_recipients recipient(s) in the class $courseName.
873 There were $failed_messages message(s) that could not be delivered.
874
875EndText
782 876
877}
878sub email_notification {
879 my $self = shift;
880 my $result_message = shift;
881 # find info on mailer and sender
882 # use the defaultFrom address.
883
884 # find info on instructor recipient and message
885 my $subject="WeBWorK email sent";
886
887 my $mailing_errors = "";
888 # open MAIL handle
889 my $mailer = Mail::Sender->new({
890 from => $self->{defaultFrom},
891 to => $self->{defaultFrom},
892 smtp => $self->{smtpServer},
893 subject => $subject,
894 headers => "X-Remote-Host: ".$self->{remote_host},
895 });
896 unless (ref $mailer) {
897 $mailing_errors .= "Failed to create a mailer: $Mail::Sender::Error";
898 return "";
899 }
900 unless (ref $mailer->Open()) {
901 $mailing_errors .= "Failed to open the mailer: $Mail::Sender::Error";
902 return "";
903 }
904 my $MAIL = $mailer->GetHandle();
905 # print message
906 print $MAIL $result_message;
907 # clean up
908 close $MAIL;
909
910 warn "instructor message sent to ", $self->{defaultFrom};
911
912}
783sub getRecord { 913sub getRecord {
784 my $self = shift; 914 my $self = shift;
785 my $line = shift; 915 my $line = shift;
786 my $delimiter = shift; 916 my $delimiter = shift;
787 $delimiter = ',' unless defined($delimiter); 917 $delimiter = ',' unless defined($delimiter);
… …
802 932
803sub process_message { 933sub process_message {
804 my $self = shift; 934 my $self = shift;
805 my $ur = shift; 935 my $ur = shift;
806 my $rh_merge_data = shift; 936 my $rh_merge_data = shift;
937 my $for_preview = shift;
807 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 938 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }:
808 'FIXME no text was produced by initialization!!'; 939 'FIXME no text was produced by initialization!!';
809 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 940 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
941
942 my $status_name = $self->r->ce->status_abbrev_to_name($ur->status);
943 $status_name = $ur->status unless defined $status_name;
944
810 #user macros that can be used in the email message 945 #user macros that can be used in the email message
811 my $SID = $ur->student_id; 946 my $SID = $ur->student_id;
812 my $FN = $ur->first_name; 947 my $FN = $ur->first_name;
813 my $LN = $ur->last_name; 948 my $LN = $ur->last_name;
814 my $SECTION = $ur->section; 949 my $SECTION = $ur->section;
815 my $RECITATION = $ur->recitation; 950 my $RECITATION = $ur->recitation;
816 my $STATUS = $ur->status; 951 my $STATUS = $status_name;
817 my $EMAIL = $ur->email_address; 952 my $EMAIL = $ur->email_address;
818 my $LOGIN = $ur->user_id; 953 my $LOGIN = $ur->user_id;
819 954
820 # get record from merge file 955 # get record from merge file
821 # FIXME this is inefficient. The info should be cached 956 # FIXME this is inefficient. The info should be cached
822 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); 957 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : ();
823 if ($merge_file ne 'None' && not defined($rh_merge_data->{$SID}) ) { 958 if ($merge_file ne 'None' and not defined($rh_merge_data->{$SID}) and $for_preview) {
824 $self->addbadmessage(CGI::p("No merge data for student id:$SID; name:$FN $LN; login:$LOGIN")); 959 $self->addbadmessage(CGI::p("No merge data for student id:$SID; name:$FN $LN; login:$LOGIN"));
825 } 960 }
826 unshift(@COL,""); ## this makes COL[1] the first column 961 unshift(@COL,""); ## this makes COL[1] the first column
827 my $endCol = @COL; 962 my $endCol = @COL;
828 # for safety, only evaluate special variables 963 # for safety, only evaluate special variables
829 my $msg = $text; 964 my $msg = $text;
830 $msg =~ s/(\$SID)/eval($1)/ge; 965 $msg =~ s/\$SID/$SID/ge;
831 $msg =~ s/(\$LN)/eval($1)/ge; 966 $msg =~ s/\$LN/$LN/ge;
832 $msg =~ s/(\$FN)/eval($1)/ge; 967 $msg =~ s/\$FN/$FN/ge;
833 $msg =~ s/(\$STATUS)/eval($1)/ge; 968 $msg =~ s/\$STATUS/$STATUS/ge;
834 $msg =~ s/(\$SECTION)/eval($1)/ge; 969 $msg =~ s/\$SECTION/$SECTION/ge;
835 $msg =~ s/(\$RECITATION)/eval($1)/ge; 970 $msg =~ s/\$RECITATION/$RECITATION/ge;
836 $msg =~ s/(\$EMAIL)/eval($1)/ge; 971 $msg =~ s/\$EMAIL/$EMAIL/ge;
837 $msg =~ s/(\$LOGIN)/eval($1)/ge; 972 $msg =~ s/\$LOGIN/$LOGIN/ge;
838# $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g; ## Perl handles negative indexes correctly, so there is no need to do this 973 if (defined($COL[1])) { # prevents extraneous error messages.
839 $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1]/ge if defined($COL[1]); # prevents extraneous error messages. 974 $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1]/ge
840 975 }
976 else { # prevents extraneous $COL's in email message
977 $msg =~ s/\$COL\[(\-?\d+)\]//g
978 }
979
841 $msg =~ s/\r//g; 980 $msg =~ s/\r//g;
842 981
982 if ($for_preview) {
843 my @preview_COL = @COL; 983 my @preview_COL = @COL;
844 shift @preview_COL; ## shift back for preview 984 shift @preview_COL; ## shift back for preview
845 my $preview_header = CGI::pre("",data_format(1..($#COL)),"<br>", data_format2(@preview_COL)). 985 my $preview_header = CGI::pre({},data_format(1..($#COL)),"<br>", data_format2(@preview_COL)).
846 CGI::h3( "This sample mail would be sent to $EMAIL"); 986 CGI::h3( "This sample mail would be sent to $EMAIL");
847
848 return $msg, $preview_header; 987 return $msg, $preview_header;
988 } else {
989 return $msg;
990 }
849} 991}
850 992
851 993
852# Ê sub data_format { 994# Ý sub data_format {
853# 995#
854# Ê Ê Ê Ê Êmap {$_ =~s/\s/\./g;$_} Ê Ê map {sprintf('%-8.8s',$_);} Ê@_; 996# Ý Ý Ý Ý Ýmap {$_ =~s/\s/\./g;$_} Ý Ý map {sprintf('%-8.8s',$_);} Ý@_;
855 sub data_format { 997 sub data_format {
856 map {"COL[$_]".'&nbsp;'x(3-length($_));} @_; # problems if $_ has length bigger than 4 998 map {"COL[$_]".'&nbsp;'x(3-length($_));} @_; # problems if $_ has length bigger than 4
857 } 999 }
858 sub data_format2 { 1000 sub data_format2 {
859 map {$_ =~s/\s/&nbsp;/g;$_} map {sprintf('%-8.8s',$_);} @_; 1001 map {$_ =~s/\s/&nbsp;/g;$_} map {sprintf('%-8.8s',$_);} @_;
Legend:
Removed from v.2786  
changed lines
  Added in v.4934
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9