[system] / trunk / webwork2 / lib / WeBWorK / ContentGenerator / Instructor / SendMail.pm Repository:
ViewVC logotype

Diff of /trunk/webwork2/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm

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

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