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

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

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

Revision 1368 Revision 2001
1################################################################################
2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm,v 1.24 2004/04/07 01:17:58 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
1package WeBWorK::ContentGenerator::Instructor::SendMail; 17package WeBWorK::ContentGenerator::Instructor::SendMail;
2use base qw(WeBWorK::ContentGenerator::Instructor); 18use base qw(WeBWorK::ContentGenerator::Instructor);
3 19
4=head1 NAME 20=head1 NAME
5 21
… …
8=cut 24=cut
9 25
10use strict; 26use strict;
11use warnings; 27use warnings;
12use CGI qw(); 28use CGI qw();
29#use HTML::Entities;
30use Mail::Sender;
13 31
32my $REFRESH_RESIZE_BUTTON = "Reorder, Resize and Update"; # handle submit value idiocy
14sub initialize { 33sub initialize {
15 my ($self) = @_; 34 my ($self) = @_;
16 my $r = $self->{r}; 35 my $r = $self->r;
17 my $db = $self->{db}; 36 my $db = $r->db;
18 my $ce = $self->{ce}; 37 my $ce = $r->ce;
19 my $authz = $self->{authz}; 38 my $authz = $r->authz;
20 my $user = $r->param('user'); 39 my $user = $r->param('user');
21 40
22 unless ($authz->hasPermissions($user, "send_mail")) { 41 unless ($authz->hasPermissions($user, "send_mail")) {
23 $self->{submitError} = "You are not authorized to send mail to students."; 42 $self->{submitError} = "You are not authorized to send mail to students.";
24 return; 43 return;
25 } 44 }
45#############################################################################################
46# gather directory data
47#############################################################################################
48 my $emailDirectory = $ce->{courseDirs}->{email};
49 my $scoringDirectory = $ce->{courseDirs}->{scoring};
50 my $templateDirectory = $ce->{courseDirs}->{templates};
26 51
27# if (defined($r->param('save_classlist'))) { 52 my $action = $r->param('action');
53 my $openfilename = $r->param('openfilename');
54 my $savefilename = $r->param('savefilename');
55
56
57 #FIXME get these values from global course environment (see subroutines as well)
58 my $default_msg_file = 'default.msg';
59 my $old_default_msg_file = 'old_default.msg';
60
61
62 # store data
63 $self->{defaultFrom} = 'FIXME from';
64 $self->{defaultReply} = 'FIXME reply';
65 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows};
66 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns};
67 $self->{default_msg_file} = $default_msg_file;
68 $self->{old_default_msg_file} = $old_default_msg_file;
69 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None';
70 $self->{preview_user} = (defined($r->param('preview_user'))) ? $r->param('preview_user') : $user;
71
72
73#############################################################################################
74# gather database data
75#############################################################################################
76 # FIXME this might be better done in body? We don't always need all of this data. or do we?
28# my @userList = $db->listUsers; 77 my @users = $db->listUsers;
78 my @user_records = ();
29# foreach my $user (@userList) { 79 foreach my $userName (@users) {
30# my $userRecord = $db->getUser($user); 80 my $userRecord = $db->getUser($userName); # checked
31# my $permissionLevelRecord = $db->getPermissionLevel($user); 81 die "record for user $userName not found" unless $userRecord;
32# foreach my $field ($userRecord->NONKEYFIELDS()) { 82 push(@user_records, $userRecord);
33# my $paramName = "user.${user}.${field}"; 83 }
34# if (defined($r->param($paramName))) { 84 ###########################
35# $userRecord->$field($r->param($paramName)); 85 # Sort the users for presentation in the select list
36# } 86 ###########################
37# } 87 if (defined $r->param("sort_by") ) {
38# foreach my $field ($permissionLevelRecord->NONKEYFIELDS()) { 88 my $sort_method = $r->param("sort_by");
39# my $paramName = "permission.${user}.${field}"; 89 if ($sort_method eq 'section') {
40# if (defined($r->param($paramName))) { 90 @user_records = sort { (lc($a->section) cmp lc($b->section)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
41# $permissionLevelRecord->$field($r->param($paramName)); 91 } elsif ($sort_method eq 'recitation') {
42# } 92 @user_records = sort { (lc($a->recitation) cmp lc($b->recitation)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
43# } 93 } elsif ($sort_method eq 'alphabetical') {
44# $db->putUser($userRecord); 94 @user_records = sort { (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
45# $db->putPermissionLevel($permissionLevelRecord); 95 } elsif ($sort_method eq 'id' ) {
46# } 96 @user_records = sort { $a->user_id cmp $b->user_id } @user_records;
47# foreach my $userID ($r->param('deleteUser')) {
48# $db->deleteUser($userID);
49# }
50# } elsif (defined($r->param('addStudent'))) {
51# my $newUser = $db->newUser;
52# my $newPermissionLevel = $db->newPermissionLevel;
53# my $newPassword = $db->newPassword;
54# $newUser->user_id($r->param('newUserID'));
55# $newPermissionLevel->user_id($r->param('newUserID'));
56# $newPassword->user_id($r->param('newUserID'));
57# $newUser->status('C');
58# $newPermissionLevel->permission(0);
59# $db->addUser($newUser);
60# $db->addPermissionLevel($newPermissionLevel);
61# $db->addPassword($newPassword);
62# }
63}
64
65sub fieldEditHTML {
66 my ($self, $fieldName, $value, $properties) = @_;
67 my $size = $properties->{size};
68 my $type = $properties->{type};
69 my $access = $properties->{access};
70 my $items = $properties->{items};
71 my $synonyms = $properties->{synonyms};
72
73
74 if ($access eq "readonly") {
75 return $value;
76 } 97 }
77 if ($type eq "number" or $type eq "text") { 98 } else {
78 return CGI::input({type=>"text", name=>$fieldName, value=>$value, size=>$size}); 99 @user_records = sort { $a->user_id cmp $b->user_id } @user_records;
100 }
101
102
103 # replace the user names by a sorted version.
104 @users = map {$_->user_id} @user_records;
105 # store data
106 $self->{ra_users} = \@users;
107 $self->{ra_user_records} = \@user_records;
108
109#############################################################################################
110# gather list of recipients
111#############################################################################################
112 my @send_to = ();
113 #FIXME this (radio) is a lousy name
114 my $recipients = $r->param('radio');
115 if (defined($recipients) and $recipients eq 'all_students') { #only active students #FIXME status check??
116 foreach my $ur (@user_records) {
117 push(@send_to,$ur->user_id) if $ur->status eq 'C' and not($ur->user_id =~ /practice/);
79 } 118 }
80 if ($type eq "enumerable") { 119 } elsif (defined($recipients) and $recipients eq 'studentID' ) {
81 my $matched = undef; # Whether a synonym match has occurred 120 @send_to = $r->param('classList');
82 121 } else {
83 # Process synonyms for enumerable objects 122 # no recipients have been defined -- probably the first time on the page
84 foreach my $synonym (keys %$synonyms) { 123 }
85 if ($synonym ne "*" and $value =~ m/$synonym/) { 124 $self->{ra_send_to} = \@send_to;
86 $value = $synonyms->{$synonym}; 125#################################################################
87 $matched = 1; 126# Check the validity of the input file name
127#################################################################
128 my $input_file = '';
129 #make sure an input message file was submitted and exists
130 #else use the default message
131 if ( defined($openfilename) ) {
132 if ( -e "${emailDirectory}/$openfilename") {
133 if ( -R "${emailDirectory}/$openfilename") {
134 $input_file = $openfilename;
135 } else {
136 warn join("",
137 "The file ${emailDirectory}/$openfilename is not readable by the webserver.",CGI::br(),
138 "Check that it's permissions are set correctly.",
139 );
88 } 140 }
141 } else {
142 $input_file = $default_msg_file;
143 warn join("",
144 "The file ${emailDirectory}/$openfilename cannot be found.",CGI::br(),
145 "Check whether it exists and whether the directory $emailDirectory can be read by the webserver.",CGI::br(),
146 "Using contents of the default message $default_msg_file instead.",
147 );
89 } 148 }
90 if (!$matched and exists $synonyms->{"*"}) { 149 } else {
91 $value = $synonyms->{"*"}; 150 $input_file = $default_msg_file;
151 }
152 $self->{input_file} =$input_file;
153
154#################################################################
155# Determine the file name to save message into
156#################################################################
157 my $output_file = 'FIXME no output file specified';
158 if (defined($action) and $action eq 'Save as Default') {
159 $output_file = $default_msg_file;
160 } elsif ( defined($action) and ($action =~/save/i) and defined($savefilename) and $savefilename ){
161 $output_file = $savefilename;
162 } elsif ( defined($input_file) ) {
163 $output_file = $input_file;
164 }
165
166 #################################################################
167 # Sanity check on save file name
168 #################################################################
169
170 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) {
171 $self->submission_error("For security reasons, you cannot specify a message file from a directory",
172 "higher than the email directory (you can't use ../blah/blah for example). ",
173 "Please specify a different file or move the needed file to the email directory",
174 );
175 }
176 unless ($output_file =~ m|\.msg$| ) {
177 $self->submission_error("Invalid file name.",
178 "The file name \"$output_file\" does not have a \".msg\" extension",
179 "All email file names must end in the extension \".msg\"",
180 "choose a file name with a \".msg\" extension.",
181 "The message was not saved.",
182 );
183 }
184 $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing.
185 # FIXME $output_file can be blank if there was no savefilename
186
187#############################################################################################
188# Determine input source
189#############################################################################################
190 my $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file';
191
192#############################################################################################
193# Get inputs
194#############################################################################################
195 my($from, $replyTo, $r_text, $subject);
196 if ($input_source eq 'file') {
197
198 ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file");
199
200
201 } elsif ($input_source eq 'form') {
202 # read info from the form
203 # bail if there is no message body
204
205 $from = $r->param('from');
206 $replyTo = $r->param('replyTo');
207 $subject = $r->param('subject');
208 my $body = $r->param('body');
209 # Sanity check: body must contain non-white space
210 $self->submission_error('You didn\'t enter any message.') unless ($r->param('body') =~ /\S/);
211 $r_text = \$body;
212
213 }
214 # store data
215 $self->{from} = $from;
216 $self->{replyTo} = $replyTo;
217 $self->{subject} = $subject;
218 $self->{r_text} = $r_text;
219
220
221
222###################################################################################
223#Determine the appropriate script action from the buttons
224###################################################################################
225# first time actions
226# open new file
227# open default file
228# choose merge file actions
229# chose merge button
230# option actions
231# 'reset rows'
232
233# save actions
234# "save" button
235# "save as" button
236# "save as default" button
237# preview actions
238# 'preview' button
239# email actions
240# 'entire class'
241# 'selected studentIDs'
242# error actions (various)
243
244
245#############################################################################################
246# if no form is submitted, gather data needed to produce the mail form and return
247#############################################################################################
248 my $to = $r->param('To');
249 my $script_action = '';
250
251
252 if(not defined($action) or $action eq 'Open' or $action eq $REFRESH_RESIZE_BUTTON or $action eq 'Sort by'
253 or $action eq 'Set merge file to:' ){
254
255 return '';
256 }
257
258
259
260
261
262#############################################################################################
263# If form is submitted deal with filled out forms
264# and various actions resulting from different buttons
265#############################################################################################
266
267
268 if ($action eq 'Save' or $action eq 'Save as:' or $action eq 'Save as Default') {
269
270# warn "FIXME Saving files action = $action outputFileName=$output_file";
271
272 #################################################################
273 # construct message body
274 #################################################################
275 my $temp_body = ${ $r_text };
276 $temp_body =~ s/\r\n/\n/g;
277 $temp_body = join("",
278 "From: $from \nReply-To: $replyTo\n" ,
279 "Subject: $subject\n" ,
280 "Message: \n $temp_body");
281# warn "FIXME from $from | subject $subject |reply $replyTo|msg $temp_body";
282 #################################################################
283 # overwrite protection
284 #################################################################
285 if ($action eq 'Save as:' and -e "$emailDirectory/$output_file") {
286 $self->submission_error("The file $emailDirectory/$output_file already exists and cannot be overwritten",
287 "The message was not saved");
288 return;
92 } 289 }
93 return CGI::popup_menu({ 290
94 name => $fieldName, 291 #################################################################
95 values => [keys %$items], 292 # Back up existing file?
96 default => $value, 293 #################################################################
97 labels => $items, 294 if ($action eq 'Save as Default' and -e "$emailDirectory/$default_msg_file") {
295 rename("$emailDirectory/$default_msg_file","$emailDirectory/$old_default_msg_file") or
296 die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ",
297 "Check permissions for webserver on directory $emailDirectory. $!";
298 $self->{message} .= "Backup file <code>$emailDirectory/$old_default_msg_file</code> created.".CGI::br();
299 }
300 #################################################################
301 # Save the message
302 #################################################################
303 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" );
304 unless ( $self->{submitError} or not -w "${emailDirectory}/$output_file" ) { # if there are no errors report success
305 $self->{message} .= "Message saved to file <code>${emailDirectory}/$output_file</code>.";
306 }
307
308 } elsif ($action eq 'Preview') {
309 $self->{response} = 'preview';
310
311 } elsif ($action eq 'Send Email') {
312 $self->{response} = 'send_email';
313
314 my @recipients = @{$self->{ra_send_to}};
315 warn "No recipients selected " unless @recipients;
316 # get merge file
317 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
318 my $delimiter = ',';
319 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
320 unless (ref($rh_merge_data) ) {
321 warn "no merge data file";
322 $self->submission_error("Can't read merge file $merge_file. No message sent");
323 return;
324 } ;
325
326
327 foreach my $recipient (@recipients) {
328 #warn "FIXME sending email to $recipient";
329 my $ur = $self->{db}->getUser($recipient); #checked
330 die "record for user $recipient not found" unless $ur;
331 unless ($ur->email_address) {
332 warn "user $recipient does not have an email address -- skipping";
333 next;
334 }
335 my ($msg, $preview_header);
336 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); };
337 warn "There were errors in processing user $ur, merge file $merge_file. $@" if $@;
338 my $mailer = Mail::Sender->new({
339 from => $from,
340 to => $ur->email_address,
341 smtp => $ce->{mail}->{smtpServer},
342 subject => $subject,
343 headers => "X-Remote-Host: ".$r->get_remote_host(),
98 }); 344 });
345 unless (ref $mailer) {
346 warn "Failed to create a mailer for user $recipient: $Mail::Sender::Error";
347 next;
348 }
349 unless (ref $mailer->Open()) {
350 warn "Failed to open the mailer for user $recipient: $Mail::Sender::Error";
351 next;
352 }
353 my $MAIL = $mailer->GetHandle() or warn "Couldn't get handle";
354 print $MAIL $msg || warn "Couldn't print to $MAIL";
355 close $MAIL || warn "Couldn't close $MAIL";
356 #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject";
357
358 }
359
360 } else {
361 warn "Didn't recognize button $action";
99 } 362 }
100}
101 363
102sub title {
103 my $self = shift;
104 return 'Send mail to ' .$self->{ce}->{courseName};
105}
106 364
107sub path { 365
366} #end initialize
367
368
369
370
371
372sub body {
108 my $self = shift; 373 my ($self) = @_;
109 my $args = $_[-1]; 374 my $r = $self->r;
375 my $urlpath = $r->urlpath;
376 my $setID = $urlpath->arg("setID");
377 my $response = (defined($self->{response}))? $self->{response} : '';
378 if ($response eq 'preview') {
379 $self->print_preview($setID);
380 } elsif (($response eq 'send_email')){
381 $self->{message} .= CGI::h3("Email sent to "). join(" ", @{$self->{ra_send_to}});
382 $self->print_form($setID);
383 } else {
384 $self->print_form($setID);
385 }
386
387}
388sub print_preview {
389 my ($self) = @_;
390 my $r = $self->r;
391 my $urlpath = $r->urlpath;
392 my $setID = $urlpath->arg("setID");
393
394 # get preview user
395 my $ur = $r->db->getUser($self->{preview_user}); #checked
396 die "record for preview user ".$self->{preview_user}. " not found." unless $ur;
110 397
111 my $ce = $self->{ce}; 398 # get merge file
112 my $root = $ce->{webworkURLs}->{root}; 399 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
113 my $courseName = $ce->{courseName}; 400 my $delimiter = ',';
114 return $self->pathMacro($args, 401 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
115 "Home" => "$root", 402
116 $courseName => "$root/$courseName", 403 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data);
117 'instructor' => "$root/$courseName/instructor", 404
118 "Send Mail to: $courseName" => '', 405 my $recipients = join(" ",@{$self->{ra_send_to} });
406 my $errorMessage = defined($self->{submitError}) ? CGI::h3($self->{submitError} ) : '' ;
407 $msg = join("",
408 $errorMessage,
409 $preview_header,
410 "To: " , $ur->email_address,"\n",
411 "From: " , $self->{from} , "\n" ,
412 "Reply-To: " , $self->{replyTo} , "\n" ,
413 "Subject: " , $self->{subject} , "\n" ,"\n" ,
414 $msg , "\n"
119 ); 415 );
120}
121 416
122sub body { 417 return join("", '<pre>',$msg,"\n","\n",
123 my ($self, $setID) = @_; 418 '</pre>',
124 my $r = $self->{r}; 419 CGI::p('Use browser back button to return from preview mode'),
125 my $authz = $self->{authz}; 420 CGI::h3('Emails to be sent to the following:'),
421 $recipients, "\n",
422
423 );
424
425}
426sub print_form {
427 my ($self) = @_;
428 my $r = $self->r;
429 my $urlpath = $r->urlpath;
430 my $authz = $r->authz;
431 my $db = $r->db;
432 my $ce = $r->ce;
433 my $courseName = $urlpath->arg("courseID");
434 my $setID = $urlpath->arg("setID");
126 my $user = $r->param('user'); 435 my $user = $r->param('user');
127 my $db = $self->{db}; 436
128 my $ce = $self->{ce};
129 my $root = $ce->{webworkURLs}->{root}; 437 my $root = $ce->{webworkURLs}->{root};
130 my $courseName = $ce->{courseName}; 438 my $sendMailPage = $urlpath->newFromModule($urlpath->module,courseID=>$courseName);
439 my $sendMailURL = $self->systemLink($sendMailPage, authen => 0);
131 440
132 return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); 441 return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools");
133 442
134 my $userTemplate = $db->newUser; 443 my $userTemplate = $db->newUser;
135 my $permissionLevelTemplate = $db->newPermissionLevel; 444 my $permissionLevelTemplate = $db->newPermissionLevel;
136 445
137 # This code will require changing if the permission and user tables ever have different keys. 446 # This code will require changing if the permission and user tables ever have different keys.
138 my @users = $db->listUsers; 447 my @users = @{ $self->{ra_users} };
139 448 my $ra_user_records = $self->{ra_user_records};
140 # This table can be consulted when display-ready forms of field names are needed. 449 my %classlistLabels = ();# %$hr_classlistLabels;
141 my %prettyFieldNames = map {$_ => $_} ($userTemplate->FIELDS(), $permissionLevelTemplate->FIELDS()); 450 foreach my $ur (@{ $ra_user_records }) {
142 @prettyFieldNames{qw( 451 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation;
143 user_id
144 first_name
145 last_name
146 email_address
147 student_id
148 status
149 section
150 recitation
151 comment
152 permission
153 )} = (
154 "User ID",
155 "First Name",
156 "Last Name",
157 "E-mail",
158 "Student ID",
159 "Status",
160 "Section",
161 "Recitation",
162 "Comment",
163 "Perm. Level"
164 );
165
166 my %fieldProperties = (
167 user_id => {
168 type => "text",
169 size => 8,
170 access => "readonly",
171 },
172 first_name => {
173 type => "text",
174 size => 10,
175 access => "readwrite",
176 },
177 last_name => {
178 type => "text",
179 size => 10,
180 access => "readwrite",
181 },
182 email_address => {
183 type => "text",
184 size => 20,
185 access => "readwrite",
186 },
187 student_id => {
188 type => "text",
189 size => 11,
190 access => "readwrite",
191 },
192 status => {
193 type => "enumerable",
194 size => 4,
195 access => "readwrite",
196 items => {
197 "C" => "Enrolled",
198 "D" => "Drop",
199 "A" => "Audit",
200 },
201 synonyms => {
202 qr/^[ce]/i => "C",
203 qr/^[dw]/i => "D",
204 qr/^a/i => "A",
205 "*" => "C",
206 }
207 },
208 section => {
209 type => "text",
210 size => 4,
211 access => "readwrite",
212 },
213 recitation => {
214 type => "text",
215 size => 4,
216 access => "readwrite",
217 },
218 comment => {
219 type => "text",
220 size => 20,
221 access => "readwrite",
222 },
223 permission => {
224 type => "number",
225 size => 2,
226 access => "readwrite",
227 } 452 }
228 ); 453
229 454
230 print CGI::start_form({method=>"post", action=>$r->uri()});
231
232############################################################################################################## 455##############################################################################################################
233 456
234# my ($ar_sortedNames, $hr_classlistLabels) = getClasslistFilesAndLabels($course); 457
235# my @sortedNames = @$ar_sortedNames; 458 my $from = $self->{from};
236 my %classlistLabels = ();# %$hr_classlistLabels; 459 my $subject = $self->{subject};
237 unshift(@users, "None"); 460 my $replyTo = $self->{replyTo};
238 $classlistLabels{None} = 'None'; 461 my $columns = $self->{columns};
239my ($from,$subject,$replyTo,$text,$columns,$rows,$messageFileName); #FIXME 462 my $rows = $self->{rows};
240$rows = 20; $columns=120; $messageFileName=''; 463 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 'FIXME no text was produced by initialization!!';
241#create list of sudents 464 my $input_file = $self->{input_file};
242# show professors's name and email address 465 my $output_file = $self->{output_file};
243# show replyTo field and From field 466 my @sorted_messages = $self->get_message_file_names;
467 my @sorted_merge_files = $self->get_merge_file_names;
468 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
469 my $delimiter = ',';
470 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
471 my @merge_keys = keys %$rh_merge_data;
472 my $preview_user = $self->{preview_user};
473 my $preview_record = $db->getUser($preview_user); # checked
474 die "record for preview user ".$self->{preview_user}. " not found." unless $preview_record;
475
476
477#############################################################################################
478
479 print CGI::start_form({method=>"post", action=>$sendMailURL});
480 print $self->hidden_authen_fields();
481#############################################################################################
482# begin upper table
483#############################################################################################
484
244 print CGI::start_table({-border=>'2', -cellpadding=>'4'}); 485 print CGI::start_table({-border=>'2', -cellpadding=>'4'});
245 print CGI::Tr({-align=>'RIGHT',-valign=>'VCENTER'}, 486 print CGI::Tr({-align=>'left',-valign=>'top'},
246 CGI::td("\n", CGI::p( CGI::b('From: '), CGI::textfield(-name=>"from", -size=>40, -value=>$from, -override=>1), ), 487#############################################################################################
488# first column
489#############################################################################################
490
491 CGI::td(CGI::strong("Message file: $input_file"),"\n",CGI::br(),
492 CGI::submit(-name=>'action', -value=>'Open'), '&nbsp;&nbsp;&nbsp;&nbsp;',"\n",
493 CGI::popup_menu(-name=>'openfilename',
494 -values=>\@sorted_messages,
495 -default=>$input_file
496 ), "\n",CGI::br(),
497
498 "Save file to: $output_file","\n",CGI::br(),
499 "\n", 'From:','&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1),
247 "\n", CGI::p( CGI::b('Reply-To: '), CGI::textfield(-name=>"replyTo", -size=>40, -value=>$replyTo, -override=>1), ), 500 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1),
248 "\n", CGI::p( CGI::b('Subject: '), CGI::textfield(-name=>'subject', -default=>$subject, -size=>40, -override=>1), ), 501 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>30, -override=>1),
249 ), 502 ),
250 CGI::td( 503#############################################################################################
251 'Select&nbsp;recipients'.CGI::br(). 504# second column
505#############################################################################################
506 CGI::td({-align=>'left',style=>'font-size:smaller'},
507
508 CGI::strong("Send to:"),
509 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'],
510 -labels=>{all_students=>'All',studentID => 'Selected'},
511 -default=>'studentID',
512 -linebreak=>0
513 ), CGI::br(),CGI::br(),
514
515 CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),,
516 CGI::radio_group(-name=>'sort_by', -values=>['id','alphabetical','section','recitation'],
517 -labels=>{id=>'Login',alphabetical=>'Alph.',section => 'Sec.',recitation=>'Rec.'},
518 -default=>defined($r->param("sort_by")) ? $r->param("sort_by") : 'id',
519 -linebreak=>0
520 ),
521
522 CGI::br(),CGI::br(),
252 CGI::popup_menu(-name=>'classList', 523 CGI::popup_menu(-name=>'classList',
253 -values=>\@users, 524 -values=>\@users,
254 -labels=>\%classlistLabels, 525 -labels=>\%classlistLabels,
255 -size => 10, 526 -size => 10,
256 -multiple => 1, 527 -multiple => 1,
257 -default=>'None' 528 -default=>$user
258 ) 529 ),
259 ), 530 ),
260 CGI::td( 531
532
533#############################################################################################
534# third column
535#############################################################################################
536 CGI::td({align=>'left'},
537 "<b>Merge file:</b> $merge_file", CGI::br(),
538 CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(),
539 CGI::popup_menu(-name=>'merge_file',
540 -values=>\@sorted_merge_files,
541 -default=>$merge_file,
542 ), "\n",CGI::hr(),CGI::br(),
543 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview')," email to ",
544 CGI::popup_menu(-name=>'preview_user',
545 -values=>\@users,
546 #-labels=>\%classlistLabels,
547 -default=>$preview_user,
548 ),
549 CGI::hr(),
550 CGI::submit(-name=>'action', -value=>'resize', -label=>$REFRESH_RESIZE_BUTTON),CGI::br(),
551 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows),
552 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns),
553 CGI::br(),CGI::br(),
261 #show available macros 554 #show available macros
262 CGI::popup_menu( 555 CGI::popup_menu(
263 -name=>'dummyName', 556 -name=>'dummyName',
264 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'], 557 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'],
265 -labels=>{''=>'These macros can be used to insert student specific data:', 558 -labels=>{''=>'list of insertable macros',
266 '$SID'=>'$SID - Student ID', 559 '$SID'=>'$SID - Student ID',
267 '$FN'=>'$FN - First name', 560 '$FN'=>'$FN - First name',
268 '$LN'=>'$LN - Last name', 561 '$LN'=>'$LN - Last name',
269 '$SECTION'=>'$SECTION - Student\'s Section', 562 '$SECTION'=>'$SECTION',
270 '$RECITATION'=>'$RECITATION - Student\'s Recitation', 563 '$RECITATION'=>'$RECITATION',
271 '$STATUS'=>'$STATUS - C, Audit, Drop, etc.', 564 '$STATUS'=>'$STATUS - C, Audit, Drop, etc.',
272 '$EMAIL'=>'$EMAIL - Email address', 565 '$EMAIL'=>'$EMAIL - Email address',
273 '$LOGIN'=>'$LOGIN - Login', 566 '$LOGIN'=>'$LOGIN - Login',
274 '$COL[3]'=>'$COL[3] - Third column in merge file', 567 '$COL[3]'=>'$COL[3] - 3rd col',
275 '$COL[-1]'=>'$COL[-1] - Last column in merge file' 568 '$COL[-1]'=>'$COL[-1] - Last column'
276 } 569 }
277 ), "\n", 570 ), "\n",
278 ), 571 ),
279 572
573 ); # end Tr
574 print CGI::end_table();
575#############################################################################################
576# end upper table
577#############################################################################################
578
579# show merge file
580# print "<pre>",(map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} 0..8),"</pre>";
581# print CGI::popup_menu(
582# -name=>'dummyName2',
583# -values=>\@merge_keys,
584# -labels=>$rh_merge_data,
585# -multiple=>1,
586# -size =>2,
587#
588# ), "\n",CGI::br();
589# warn "merge keys ", join( " ",@merge_keys);
590#############################################################################################
591# merge file fragment and message text area field
592#############################################################################################
593 my @tmp2;
594 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; # checked
595 if ($@ and $merge_file ne 'None') {
596 print "No merge data for $preview_user in merge file: &lt;$merge_file&gt;",CGI::br();
597 } else {
598 print CGI::pre("",data_format(0..($#tmp2)),"<br>", data_format2(@tmp2));
599 }
600#create a textbox with the subject and a textarea with the message
601#print actual body of message
602
603 print "\n", CGI::p( $self->{message}) if defined($self->{message});
604 print "\n", CGI::p( CGI::textarea(-name=>'body', -default=>$text, -rows=>$rows, -columns=>$columns, -override=>1));
605
606#############################################################################################
607# action button table
608#############################################################################################
609 print CGI::table( { -border=>2,-cellpadding=>4},
610 CGI::Tr(
611 CGI::td( CGI::submit(-name=>'action', -value=>'Send Email') ), "\n",
612 CGI::td(CGI::submit(-name=>'action', -value=>'Save')," to $output_file"), " \n",
613 CGI::td(CGI::submit(-name=>'action', -value=>'Save as:'),
614 CGI::textfield(-name=>'savefilename', -size => 20, -value=> "$output_file", -override=>1)
615 ), "\n",
616 CGI::td(CGI::submit(-name=>'action', -value=>'Save as Default')),
617 )
280 ); 618 );
281 print CGI::end_table();
282#create a textbox with the subject and a textarea with the message
283
284#print actual body of message
285 print CGI::p(
286 CGI::submit(-name=>'action', -value=>'Revert to original and Resize message window'),
287 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows),
288 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns),CGI::br(),
289 "If you resize the message window, you will lose all unsaved changes."
290 );
291
292 print "\n", CGI::p( CGI::textarea(-name=>'body', -default=>$text, -rows=>$rows, -columns=>$columns, -override=>1)
293 );
294#create all necessary action buttons
295 print CGI::p(CGI::submit(-name=>'action', -value=>'Open'), "\n",
296 CGI::textfield(-name=>'savefilename', -size => 20, -value=> "$messageFileName", -override=>1), ' ',
297 CGI::submit(-name=>'action', -value=>'Save'), " \n",
298 CGI::submit(-name=>'action', -value=>'Save as'), " \n",
299 CGI::submit(-name=>'action', -value=>'Save as Default'),
300 CGI::submit(-name=>'action', -value=>'Send Email'), "\n", CGI::br(),
301 'For "Save As" choose a new filename.',
302 );
303 619
304############################################################################################################## 620##############################################################################################################
305 # Table headings, prettied-up 621
306# print CGI::start_table({});
307# print CGI::Tr({},
308# CGI::th({}, [
309# "Delete?",
310# map {$prettyFieldNames{$_}} (
311# $userTemplate->KEYFIELDS(),
312# $userTemplate->NONKEYFIELDS(),
313# $permissionLevelTemplate->NONKEYFIELDS(),
314# )
315# ])
316# );
317#
318# foreach my $currentUser (@users) {
319# my $userRecord = $db->getUser($currentUser);
320# my $permissionLevel = $db->getPermissionLevel($currentUser);
321# unless (defined $permissionLevel) {
322# warn "No permissionLevel record for user $currentUser" ;
323# next;
324# }
325#
326# # A concise way of printing a row containing a cell for each field, editable unless it's a key
327# print CGI::Tr({},
328# CGI::td({}, [
329# CGI::input({type=>"checkbox", name=>"deleteUser", value=>$currentUser}),
330# (
331# map {
332# my $changeEUserURL = "$root/$courseName?user=".$r->param("user")."&effectiveUser=".$userRecord->user_id()."&key=".$r->param("key");
333# CGI::a({href=>$changeEUserURL}, $userRecord->$_)
334# } $userRecord->KEYFIELDS
335# ),
336# (map {
337# # CGI::input({type=>"text", size=>"8", name=> "user.".$userRecord->user_id().".".$_, value=>$userRecord->$_})
338# $self->fieldEditHTML("user.".$userRecord->user_id().".".$_, $userRecord->$_, $fieldProperties{$_});
339# } $userRecord->NONKEYFIELDS()),
340# (map {
341# # CGI::input({type=>"text", size=>"8", name => "permission.".$permissionLevel->user_id().".".$_, value=>$permissionLevel->$_})
342# $self->fieldEditHTML("permission.".$permissionLevel->user_id().".".$_, $permissionLevel->$_, $fieldProperties{$_});
343# } $permissionLevel->NONKEYFIELDS()),
344# ])
345# );
346# }
347#
348# print CGI::end_table();
349 print $self->hidden_authen_fields();
350 print CGI::submit({name=>"save_classlist", value=>"Save Changes to Users"});
351 print CGI::end_form(); 622 print CGI::end_form();
352
353 # Add a student form
354# print CGI::start_form({method=>"post", action=>$r->uri()});
355# print $self->hidden_authen_fields();
356# print "User ID:";
357# print CGI::input({type=>"text", name=>"newUserID", value=>"", size=>"20"});
358# print CGI::submit({name=>"addStudent", value=>"Add Student"});
359# print CGI::end_form();
360
361 return ""; 623 return "";
362} 624}
363 625
626##############################################################################
627# Utility methods
628##############################################################################
629sub submission_error {
630 my $self = shift;
631 my $msg = join( " ", @_);
632 $self->{submitError} .= CGI::br().$msg;
633 return;
634}
635
636sub saveProblem {
637 my $self = shift;
638 my ($body, $probFileName)= @_;
639 local(*PROBLEM);
640 open (PROBLEM, ">$probFileName") ||
641 $self->submission_error("Could not open $probFileName for writing.
642 Check that the permissions for this problem are 660 (-rw-rw----)");
643 print PROBLEM $body;
644 close PROBLEM;
645 chmod 0660, "$probFileName" ||
646 $self->submission_error("
647 CAN'T CHANGE PERMISSIONS ON FILE $probFileName");
648}
649
650sub read_input_file {
651 my $self = shift;
652 my $filePath = shift;
653 my ($text, @text);
654 my $header = '';
655 my ($subject, $from, $replyTo);
656 local(*FILE);
657 if (-e "$filePath" and -r "$filePath") {
658 open FILE, "$filePath" || do { $self->submission_error("Can't open $filePath"); return};
659 while ($header !~ s/Message:\s*$//m and not eof(FILE)) {
660 $header .= <FILE>;
661 }
662 $text = join( '', <FILE>);
663 $text =~ s/^\s*//; # remove initial white space if any.
664 $header =~ /^From:\s(.*)$/m;
665 $from = $1 or $from = $self->{defaultFrom};
666
667 $header =~ /^Reply-To:\s(.*)$/m;
668 $replyTo = $1 or $replyTo = $self->{defaultReply};
669
670 $header =~ /^Subject:\s(.*)$/m;
671 $subject = $1;
672
673 } else {
674 $from = $self->{defaultFrom};
675 $replyTo = $self->{defaultReply};
676 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist";
677 $subject = "FIXME default subject";
678 }
679 return ($from, $replyTo, $subject, \$text);
680}
681
682
683sub get_message_file_names {
684 my $self = shift;
685 return $self->read_dir($self->{ce}->{courseDirs}->{email}, '\\.msg$');
686}
687sub get_merge_file_names {
688 my $self = shift;
689 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed.
690}
691
692
693sub getRecord {
694 my $self = shift;
695 my $line = shift;
696 my $delimiter = shift;
697 $delimiter = ',' unless defined($delimiter);
698
699 # Takes a delimited line as a parameter and returns an
700 # array. Note that all white space is removed. If the
701 # last field is empty, the last element of the returned
702 # array is also empty (unlike what the perl split command
703 # would return). E.G. @lineArray=&getRecord(\$delimitedLine).
704
705 my(@lineArray);
706 $line.="${delimiter}___"; # add final field which must be non-empty
707 @lineArray = split(/\s*${delimiter}\s*/,$line); # split line into fields
708 $lineArray[0] =~s/^\s*//; # remove white space from first element
709 pop @lineArray; # remove the last artificial field
710 @lineArray;
711}
712
713sub process_message {
714 my $self = shift;
715 my $ur = shift;
716 my $rh_merge_data = shift;
717 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }:
718 'FIXME no text was produced by initialization!!';
719 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
720 #user macros that can be used in the email message
721 my $SID = $ur->student_id;
722 my $FN = $ur->first_name;
723 my $LN = $ur->last_name;
724 my $SECTION = $ur->section;
725 my $RECITATION = $ur->recitation;
726 my $STATUS = $ur->status;
727 my $EMAIL = $ur->email_address;
728 my $LOGIN = $ur->user_id;
729
730 # get record from merge file
731 # FIXME this is inefficient. The info should be cached
732 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : ();
733 if ($merge_file ne 'None' && not defined($rh_merge_data->{$SID}) ) {
734 $self->submission_error( "No merge data for $SID $FN $LN $LOGIN");
735 }
736
737 my $endCol = @COL;
738 # for safety, only evaluate special variables
739 my $msg = $text;
740 $msg =~ s/(\$SID)/eval($1)/ge;
741 $msg =~ s/(\$LN)/eval($1)/ge;
742 $msg =~ s/(\$FN)/eval($1)/ge;
743 $msg =~ s/(\$STATUS)/eval($1)/ge;
744 $msg =~ s/(\$SECTION)/eval($1)/ge;
745 $msg =~ s/(\$RECITATION)/eval($1)/ge;
746 $msg =~ s/(\$EMAIL)/eval($1)/ge;
747 $msg =~ s/(\$LOGIN)/eval($1)/ge;
748 $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g;
749 $msg =~ s/(\$COL\[.*?\])/eval($1)/ge;
750
751 $msg =~ s/\r//g;
752
753 my $preview_header = CGI::pre("",data_format(0..($#COL)),"<br>", data_format2(@COL)).
754 CGI::h3( "This sample mail would be sent to $EMAIL");
755
756
757 return $msg, $preview_header;
758}
759
760
761# Ê sub data_format {
762#
763# Ê Ê Ê Ê Êmap {$_ =~s/\s/\./g;$_} Ê Ê map {sprintf('%-8.8s',$_);} Ê@_;
764 sub data_format {
765 map {"COL[$_]".'&nbsp;'x(3-length($_));} @_; # problems if $_ has length bigger than 4
766 }
767 sub data_format2 {
768 map {$_ =~s/\s/&nbsp;/g;$_} map {sprintf('%-8.8s',$_);} @_;
769 }
3641; 7701;
Legend:
Removed from v.1368  
changed lines
  Added in v.2001
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9