[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

Revision 4628 Revision 4629
1################################################################################ 1################################################################################
2# WeBWorK Online Homework Delivery System 2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm,v 1.50 2006/07/16 02:40:41 gage 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.
… …
27use warnings; 27use warnings;
28#use CGI qw(-nosticky ); 28#use CGI qw(-nosticky );
29use WeBWorK::CGI; 29use WeBWorK::CGI;
30use HTML::Entities; 30use HTML::Entities;
31use Mail::Sender; 31use Mail::Sender;
32use Socket qw/unpack_sockaddr_in inet_ntoa/; # for remote host/port info
32use Text::Wrap qw(wrap); 33use Text::Wrap qw(wrap);
33use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; 34use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/;
34use WeBWorK::Utils::FilterRecords qw/filterRecords/; 35use WeBWorK::Utils::FilterRecords qw/filterRecords/;
36
37use mod_perl;
38use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 );
35 39
36#my $REFRESH_RESIZE_BUTTON = "Set preview to: "; # handle submit value idiocy 40#my $REFRESH_RESIZE_BUTTON = "Set preview to: "; # handle submit value idiocy
37my $UPDATE_SETTINGS_BUTTON = "Update settings and refresh page"; # handle submit value idiocy 41my $UPDATE_SETTINGS_BUTTON = "Update settings and refresh page"; # handle submit value idiocy
38sub initialize { 42sub initialize {
39 my ($self) = @_; 43 my ($self) = @_;
… …
272 # Sanity check: body must contain non-white space 276 # Sanity check: body must contain non-white space
273 $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/);
274 $r_text = \$body; 278 $r_text = \$body;
275 279
276 } 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
277 # store data 290 # store data
278 $self->{from} = $from; 291 $self->{from} = $from;
279 $self->{replyTo} = $replyTo; 292 $self->{replyTo} = $replyTo;
280 $self->{subject} = $subject; 293 $self->{subject} = $subject;
294 $self->{remote_host} = $remote_host;
281 $self->{r_text} = $r_text; 295 $self->{r_text} = $r_text;
282 296
283 297
284 298
285################################################################################### 299###################################################################################
… …
392 my $post_connection_action = sub { 406 my $post_connection_action = sub {
393 my $r = shift; 407 my $r = shift;
394 my $result_message = $self->mail_message_to_recipients(); 408 my $result_message = $self->mail_message_to_recipients();
395 $self->email_notification($result_message); 409 $self->email_notification($result_message);
396 }; 410 };
411 if (MP2) {
412 $r->connection->pool->cleanup_register($post_connection_action);
413 } else {
397 $r->post_connection($post_connection_action) ; 414 $r->post_connection($post_connection_action);
415 }
398 } 416 }
399# foreach my $recipient (@recipients) { 417# foreach my $recipient (@recipients) {
400# #warn "FIXME sending email to $recipient"; 418# #warn "FIXME sending email to $recipient";
401# my $ur = $self->{db}->getUser($recipient); #checked 419# my $ur = $self->{db}->getUser($recipient); #checked
402# die "record for user $recipient not found" unless $ur; 420# die "record for user $recipient not found" unless $ur;
… …
485 # get merge file 503 # get merge file
486 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 504 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
487 my $delimiter = ','; 505 my $delimiter = ',';
488 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 506 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
489 507
490 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data); 508 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data,1); # 1 == for preview
491 509
492 my $recipients = join(" ",@{$self->{ra_send_to} }); 510 my $recipients = join(" ",@{$self->{ra_send_to} });
493 my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ; 511 my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ;
494 $msg = join("", 512 $msg = join("",
495 $errorMessage, 513 $errorMessage,
… …
793 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed. 811 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed.
794} 812}
795 813
796sub mail_message_to_recipients { 814sub mail_message_to_recipients {
797 my $self = shift; 815 my $self = shift;
816 my $r = $self->r;
798 my $subject = $self->{subject}; 817 my $subject = $self->{subject};
799 my $from = $self->{from}; 818 my $from = $self->{from};
800 my @recipients = @{$self->{ra_send_to}}; 819 my @recipients = @{$self->{ra_send_to}};
801 my $rh_merge_data = $self->{rh_merge_data}; 820 my $rh_merge_data = $self->{rh_merge_data};
802 my $merge_file = $self->{merge_file}; 821 my $merge_file = $self->{merge_file};
… …
812 } 831 }
813 unless ($ur->email_address) { 832 unless ($ur->email_address) {
814 $error_messages .="User $recipient does not have an email address -- skipping\n"; 833 $error_messages .="User $recipient does not have an email address -- skipping\n";
815 next; 834 next;
816 } 835 }
817 my ($msg, $preview_header); 836 my $msg = eval { $self->process_message($ur,$rh_merge_data) };
818 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); };
819 $error_messages .= "There were errors in processing user $ur, merge file $merge_file. \n$@\n" if $@; 837 $error_messages .= "There were errors in processing user $recipient, merge file $merge_file. \n$@\n" if $@;
820 my $mailer = Mail::Sender->new({ 838 my $mailer = Mail::Sender->new({
821 from => $from, 839 from => $from,
822 to => $ur->email_address, 840 to => $ur->email_address,
823 smtp => $self->{smtpServer}, 841 smtp => $self->{smtpServer},
824 subject => $subject, 842 subject => $subject,
825 headers => "X-Remote-Host: ".$self->r->get_remote_host(), 843 headers => "X-Remote-Host: ".$self->{remote_host},
826 }); 844 });
827 unless (ref $mailer) { 845 unless (ref $mailer) {
828 $error_messages .= "Failed to create a mailer for user $recipient: $Mail::Sender::Error\n"; 846 $error_messages .= "Failed to create a mailer for user $recipient: $Mail::Sender::Error\n";
829 next; 847 next;
830 } 848 }
… …
866 my $mailer = Mail::Sender->new({ 884 my $mailer = Mail::Sender->new({
867 from => $self->{defaultFrom}, 885 from => $self->{defaultFrom},
868 to => $self->{defaultFrom}, 886 to => $self->{defaultFrom},
869 smtp => $self->{smtpServer}, 887 smtp => $self->{smtpServer},
870 subject => $subject, 888 subject => $subject,
871 headers => "X-Remote-Host: ".$self->r->get_remote_host(), 889 headers => "X-Remote-Host: ".$self->{remote_host},
872 }); 890 });
873 unless (ref $mailer) { 891 unless (ref $mailer) {
874 $mailing_errors .= "Failed to create a mailer: $Mail::Sender::Error"; 892 $mailing_errors .= "Failed to create a mailer: $Mail::Sender::Error";
875 return ""; 893 return "";
876 } 894 }
… …
909 927
910sub process_message { 928sub process_message {
911 my $self = shift; 929 my $self = shift;
912 my $ur = shift; 930 my $ur = shift;
913 my $rh_merge_data = shift; 931 my $rh_merge_data = shift;
932 my $for_preview = shift;
914 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 933 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }:
915 'FIXME no text was produced by initialization!!'; 934 'FIXME no text was produced by initialization!!';
916 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 935 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
917 936
918 my $status_name = $self->r->ce->status_abbrev_to_name($ur->status); 937 my $status_name = $self->r->ce->status_abbrev_to_name($ur->status);
… …
929 my $LOGIN = $ur->user_id; 948 my $LOGIN = $ur->user_id;
930 949
931 # get record from merge file 950 # get record from merge file
932 # FIXME this is inefficient. The info should be cached 951 # FIXME this is inefficient. The info should be cached
933 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); 952 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : ();
934 if ($merge_file ne 'None' && not defined($rh_merge_data->{$SID}) ) { 953 if ($merge_file ne 'None' and not defined($rh_merge_data->{$SID}) and $for_preview) {
935 $self->addbadmessage(CGI::p("No merge data for student id:$SID; name:$FN $LN; login:$LOGIN")); 954 $self->addbadmessage(CGI::p("No merge data for student id:$SID; name:$FN $LN; login:$LOGIN"));
936 } 955 }
937 unshift(@COL,""); ## this makes COL[1] the first column 956 unshift(@COL,""); ## this makes COL[1] the first column
938 my $endCol = @COL; 957 my $endCol = @COL;
939 # for safety, only evaluate special variables 958 # for safety, only evaluate special variables
… …
953 $msg =~ s/\$COL\[(\-?\d+)\]//g 972 $msg =~ s/\$COL\[(\-?\d+)\]//g
954 } 973 }
955 974
956 $msg =~ s/\r//g; 975 $msg =~ s/\r//g;
957 976
977 if ($for_preview) {
958 my @preview_COL = @COL; 978 my @preview_COL = @COL;
959 shift @preview_COL; ## shift back for preview 979 shift @preview_COL; ## shift back for preview
960 my $preview_header = CGI::pre({},data_format(1..($#COL)),"<br>", data_format2(@preview_COL)). 980 my $preview_header = CGI::pre({},data_format(1..($#COL)),"<br>", data_format2(@preview_COL)).
961 CGI::h3( "This sample mail would be sent to $EMAIL"); 981 CGI::h3( "This sample mail would be sent to $EMAIL");
962
963 return $msg, $preview_header; 982 return $msg, $preview_header;
983 } else {
984 return $msg;
985 }
964} 986}
965 987
966 988
967# Ý sub data_format { 989# Ý sub data_format {
968# 990#
Legend:
Removed from v.4628  
changed lines
  Added in v.4629
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9