[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 1375 Revision 1953
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.23 2004/04/05 20:52:54 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();
13use HTML::Entities; 29#use HTML::Entities;
14use Mail::Sender; 30use Mail::Sender;
15 31
32my $REFRESH_RESIZE_BUTTON = "Reorder, Resize and Update"; # handle submit value idiocy
16sub initialize { 33sub initialize {
17 my ($self) = @_; 34 my ($self) = @_;
18 my $r = $self->{r}; 35 my $r = $self->r;
19 my $db = $self->{db}; 36 my $db = $r->db;
20 my $ce = $self->{ce}; 37 my $ce = $r->ce;
21 my $authz = $self->{authz}; 38 my $authz = $r->authz;
22 my $user = $r->param('user'); 39 my $user = $r->param('user');
23 40
24 unless ($authz->hasPermissions($user, "send_mail")) { 41 unless ($authz->hasPermissions($user, "send_mail")) {
25 $self->{submitError} = "You are not authorized to send mail to students."; 42 $self->{submitError} = "You are not authorized to send mail to students.";
26 return; 43 return;
27 } 44 }
… …
48 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows}; 65 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows};
49 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns}; 66 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns};
50 $self->{default_msg_file} = $default_msg_file; 67 $self->{default_msg_file} = $default_msg_file;
51 $self->{old_default_msg_file} = $old_default_msg_file; 68 $self->{old_default_msg_file} = $old_default_msg_file;
52 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None'; 69 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None';
53 $self->{preview_user} = (defined($r->param('preview_user'))) ? $r->param('preview_user') : 'Yourself'; 70 $self->{preview_user} = (defined($r->param('preview_user'))) ? $r->param('preview_user') : $user;
54 71
55 72
56############################################################################################# 73#############################################################################################
57# gather database data 74# gather database data
58############################################################################################# 75#############################################################################################
59 # FIXME this might be better done in body? We don't always need all of this data. or do we? 76 # FIXME this might be better done in body? We don't always need all of this data. or do we?
60 my @users = sort $db->listUsers; 77 my @users = $db->listUsers;
61 my @user_records = (); 78 my @user_records = ();
62 push(@user_records,$db->getUser($_)) foreach (@users); 79 foreach my $userName (@users) {
80 my $userRecord = $db->getUser($userName); # checked
81 die "record for user $userName not found" unless $userRecord;
82 push(@user_records, $userRecord);
83 }
84 ###########################
85 # Sort the users for presentation in the select list
86 ###########################
87 if (defined $r->param("sort_by") ) {
88 my $sort_method = $r->param("sort_by");
89 if ($sort_method eq 'section') {
90 @user_records = sort { (lc($a->section) cmp lc($b->section)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
91 } elsif ($sort_method eq 'recitation') {
92 @user_records = sort { (lc($a->recitation) cmp lc($b->recitation)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
93 } elsif ($sort_method eq 'alphabetical') {
94 @user_records = sort { (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
95 } elsif ($sort_method eq 'id' ) {
96 @user_records = sort { $a->user_id cmp $b->user_id } @user_records;
97 }
98 } else {
99 @user_records = sort { $a->user_id cmp $b->user_id } @user_records;
100 }
63 101
102
103 # replace the user names by a sorted version.
104 @users = map {$_->user_id} @user_records;
64 # store data 105 # store data
65 $self->{ra_users} = \@users; 106 $self->{ra_users} = \@users;
66 $self->{ra_user_records} = \@user_records; 107 $self->{ra_user_records} = \@user_records;
67 108
68############################################################################################# 109#############################################################################################
… …
114# Determine the file name to save message into 155# Determine the file name to save message into
115################################################################# 156#################################################################
116 my $output_file = 'FIXME no output file specified'; 157 my $output_file = 'FIXME no output file specified';
117 if (defined($action) and $action eq 'Save as Default') { 158 if (defined($action) and $action eq 'Save as Default') {
118 $output_file = $default_msg_file; 159 $output_file = $default_msg_file;
119 } elsif ( defined($action) and ($action =~/save/i) and defined($savefilename) ){ 160 } elsif ( defined($action) and ($action =~/save/i) and defined($savefilename) and $savefilename ){
120 $output_file = $savefilename; 161 $output_file = $savefilename;
121 } elsif ( defined($input_file) ) { 162 } elsif ( defined($input_file) ) {
122 $output_file = $input_file; 163 $output_file = $input_file;
123 } 164 }
124# warn "FIXME savefilename $savefilename output file $output_file"; 165
125 ################################################################# 166 #################################################################
126 # Sanity check on save file name 167 # Sanity check on save file name
127 ################################################################# 168 #################################################################
128 169
129 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) { 170 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) {
130 $self->submission_error("For security reasons, you cannot specify a merge file from a directory", 171 $self->submission_error("For security reasons, you cannot specify a message file from a directory",
131 "higher than the email directory (you can't use ../blah/blah). ", 172 "higher than the email directory (you can't use ../blah/blah for example). ",
132 "Please specify a different file or move the needed file to the email directory", 173 "Please specify a different file or move the needed file to the email directory",
133 ); 174 );
134 } 175 }
135 unless ($output_file =~ m|\.msg$| ) { 176 unless ($output_file =~ m|\.msg$| ) {
136 $self->submission_error("Invalid file name.", 177 $self->submission_error("Invalid file name.",
… …
145 186
146############################################################################################# 187#############################################################################################
147# Determine input source 188# Determine input source
148############################################################################################# 189#############################################################################################
149 my $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file'; 190 my $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file';
150# warn "FIXME input source is $input_source from $input_file"; 191
151############################################################################################# 192#############################################################################################
152# Get inputs 193# Get inputs
153############################################################################################# 194#############################################################################################
154 my($from, $replyTo, $r_text, $subject); 195 my($from, $replyTo, $r_text, $subject);
155 if ($input_source eq 'file') { 196 if ($input_source eq 'file') {
156# warn "FIXME obtaining source from $emailDirectory/$input_file"; 197
157 ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file"); 198 ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file");
158# warn "FIXME Done reading source"; 199
159 200
160 } elsif ($input_source eq 'form') { 201 } elsif ($input_source eq 'form') {
161 # read info from the form 202 # read info from the form
162 # bail if there is no message body 203 # bail if there is no message body
163 204
… …
206############################################################################################# 247#############################################################################################
207 my $to = $r->param('To'); 248 my $to = $r->param('To');
208 my $script_action = ''; 249 my $script_action = '';
209 250
210 251
211 if(not defined($action) or $action eq 'Open' or $action eq 'Resize message window' 252 if(not defined($action) or $action eq 'Open' or $action eq $REFRESH_RESIZE_BUTTON or $action eq 'Sort by'
212 or $action eq 'Set merge file to:' ){ 253 or $action eq 'Set merge file to:' ){
213# warn "FIXME action is |$action| no further initialization required"; 254
214 return ''; 255 return '';
215 } 256 }
216 257
217 258
218 259
… …
221############################################################################################# 262#############################################################################################
222# If form is submitted deal with filled out forms 263# If form is submitted deal with filled out forms
223# and various actions resulting from different buttons 264# and various actions resulting from different buttons
224############################################################################################# 265#############################################################################################
225 266
226
227
228 # user_errors
229 # save
230 # save as
231 # save as default
232 # send mail
233 # set defaults
234 267
235 if ($action eq 'Save' or $action eq 'Save as:' or $action eq 'Save as Default') { 268 if ($action eq 'Save' or $action eq 'Save as:' or $action eq 'Save as Default') {
236 269
237# warn "FIXME Saving files action = $action outputFileName=$output_file"; 270# warn "FIXME Saving files action = $action outputFileName=$output_file";
238 271
… …
266 } 299 }
267 ################################################################# 300 #################################################################
268 # Save the message 301 # Save the message
269 ################################################################# 302 #################################################################
270 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ); 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
271 $self->{message} .= "Message saved to file <code>${emailDirectory}/$output_file</code>."; 305 $self->{message} .= "Message saved to file <code>${emailDirectory}/$output_file</code>.";
272# warn "FIXME saving to ${emailDirectory}/$output_file"; 306 }
307
273 } elsif ($action eq 'Preview') { 308 } elsif ($action eq 'Preview') {
274 $self->{response} = 'preview'; 309 $self->{response} = 'preview';
275 310
276 } elsif ($action eq 'Send Email') { 311 } elsif ($action eq 'Send Email') {
277 $self->{response} = 'send_email'; 312 $self->{response} = 'send_email';
… …
279 my @recipients = @{$self->{ra_send_to}}; 314 my @recipients = @{$self->{ra_send_to}};
280 warn "No recipients selected " unless @recipients; 315 warn "No recipients selected " unless @recipients;
281 # get merge file 316 # get merge file
282 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 317 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
283 my $delimiter = ','; 318 my $delimiter = ',';
284 my $rh_merge_data = $self->read_merge_file("$merge_file", "$delimiter"); 319 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
285 warn "No data for merge file $merge_file" unless ref($rh_merge_data); 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
286 326
287 foreach my $recipient (@recipients) { 327 foreach my $recipient (@recipients) {
288 #warn "FIXME sending email to $recipient"; 328 #warn "FIXME sending email to $recipient";
289 my $ur = $self->{db}->getUser($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 }
290 my ($msg, $preview_header); 335 my ($msg, $preview_header);
291 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); }; 336 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); };
292 warn "There were errors in processing user $ur, merge file $merge_file. $@" if $@; 337 warn "There were errors in processing user $ur, merge file $merge_file. $@" if $@;
293 my $mailer = Mail::Sender->new({ 338 my $mailer = Mail::Sender->new({
294 from => $from, 339 from => $from,
… …
296 smtp => $ce->{mail}->{smtpServer}, 341 smtp => $ce->{mail}->{smtpServer},
297 subject => $subject, 342 subject => $subject,
298 headers => "X-Remote-Host: ".$r->get_remote_host(), 343 headers => "X-Remote-Host: ".$r->get_remote_host(),
299 }); 344 });
300 unless (ref $mailer) { 345 unless (ref $mailer) {
301 warn "Failed to create a mailer: $Mail::Sender::Error"; 346 warn "Failed to create a mailer for user $recipient: $Mail::Sender::Error";
302 next; 347 next;
303 } 348 }
304 unless (ref $mailer->Open()) { 349 unless (ref $mailer->Open()) {
305 warn "Failed to open the mailer: $Mail::Sender::Error"; 350 warn "Failed to open the mailer for user $recipient: $Mail::Sender::Error";
306 next; 351 next;
307 } 352 }
308 my $MAIL = $mailer->GetHandle() or warn "Couldn't get handle"; 353 my $MAIL = $mailer->GetHandle() or warn "Couldn't get handle";
309 $msg = 'Hi ' . $msg;
310 print $MAIL $msg || warn "Couldn't print to $MAIL"; 354 print $MAIL $msg || warn "Couldn't print to $MAIL";
311 close $MAIL || warn "Couldn't close $MAIL"; 355 close $MAIL || warn "Couldn't close $MAIL";
312 #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject"; 356 #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject";
313 357
314 } 358 }
315
316 359
317#&success;
318
319
320 } else { 360 } else {
321 warn "Didn't recognize button $action"; 361 warn "Didn't recognize button $action";
322 } 362 }
323 363
324 364
325 365
326} #end initialize 366} #end initialize
327 367
328 368
329sub title {
330 my $self = shift;
331 return 'Send mail to ' .$self->{ce}->{courseName};
332}
333 369
334sub path { 370
335 my $self = shift;
336 my $args = $_[-1];
337
338 my $ce = $self->{ce};
339 my $root = $ce->{webworkURLs}->{root};
340 my $courseName = $ce->{courseName};
341 return $self->pathMacro($args,
342 "Home" => "$root",
343 $courseName => "$root/$courseName",
344 'instructor' => "$root/$courseName/instructor",
345 "Send Mail to: $courseName" => '',
346 );
347}
348 371
349sub body { 372sub body {
350 my ($self, $setID) = @_; 373 my ($self) = @_;
374 my $r = $self->r;
375 my $urlpath = $r->urlpath;
376 my $setID = $urlpath->arg("setID");
351 my $response = (defined($self->{response}))? $self->{response} : ''; 377 my $response = (defined($self->{response}))? $self->{response} : '';
352 if ($response eq 'preview') { 378 if ($response eq 'preview') {
353 $self->print_preview($setID); 379 $self->print_preview($setID);
354 } elsif (($response eq 'send_email')){ 380 } elsif (($response eq 'send_email')){
355 $self->{message} .= CGI::h3("Email sent to "). join(" ", @{$self->{ra_send_to}}); 381 $self->{message} .= CGI::h3("Email sent to "). join(" ", @{$self->{ra_send_to}});
… …
358 $self->print_form($setID); 384 $self->print_form($setID);
359 } 385 }
360 386
361} 387}
362sub print_preview { 388sub print_preview {
363 my ($self, $setID) = @_; 389 my ($self) = @_;
390 my $r = $self->r;
391 my $urlpath = $r->urlpath;
392 my $setID = $urlpath->arg("setID");
393
364 # get preview user 394 # get preview user
365 my $ur = $self->{db}->getUser($self->{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;
366 397
367 # get merge file 398 # get merge file
368 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 399 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
369 my $delimiter = ','; 400 my $delimiter = ',';
370 my $rh_merge_data = $self->read_merge_file("$merge_file", "$delimiter"); 401 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
371 402
372 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data); 403 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data);
373 404
374 my $recipients = join(" ",@{$self->{ra_send_to} }); 405 my $recipients = join(" ",@{$self->{ra_send_to} });
375 my $errorMessage = defined($self->{submitError}) ? CGI::h3($self->{submitError} ) : '' ; 406 my $errorMessage = defined($self->{submitError}) ? CGI::h3($self->{submitError} ) : '' ;
… …
391 422
392 ); 423 );
393 424
394} 425}
395sub print_form { 426sub print_form {
396 my ($self, $setID) = @_; 427 my ($self) = @_;
397 my $r = $self->{r}; 428 my $r = $self->r;
398 my $authz = $self->{authz}; 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");
399 my $user = $r->param('user'); 435 my $user = $r->param('user');
400 my $db = $self->{db}; 436
401 my $ce = $self->{ce};
402 my $root = $ce->{webworkURLs}->{root}; 437 my $root = $ce->{webworkURLs}->{root};
403 my $courseName = $ce->{courseName}; 438 my $sendMailPage = $urlpath->newFromModule($urlpath->module,courseID=>$courseName);
439 my $sendMailURL = $self->systemLink($sendMailPage, authen => 0);
404 440
405 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");
406 442
407 my $userTemplate = $db->newUser; 443 my $userTemplate = $db->newUser;
408 my $permissionLevelTemplate = $db->newPermissionLevel; 444 my $permissionLevelTemplate = $db->newPermissionLevel;
… …
410 # 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.
411 my @users = @{ $self->{ra_users} }; 447 my @users = @{ $self->{ra_users} };
412 my $ra_user_records = $self->{ra_user_records}; 448 my $ra_user_records = $self->{ra_user_records};
413 my %classlistLabels = ();# %$hr_classlistLabels; 449 my %classlistLabels = ();# %$hr_classlistLabels;
414 foreach my $ur (@{ $ra_user_records }) { 450 foreach my $ur (@{ $ra_user_records }) {
415 $classlistLabels{$ur->user_id} = $ur->user_id.' '.$ur->last_name. ', '. $ur->first_name.' - '.$ur->section; 451 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation;
416 } 452 }
417 453
418 454
419############################################################################################################## 455##############################################################################################################
420 456
… …
429 my $output_file = $self->{output_file}; 465 my $output_file = $self->{output_file};
430 my @sorted_messages = $self->get_message_file_names; 466 my @sorted_messages = $self->get_message_file_names;
431 my @sorted_merge_files = $self->get_merge_file_names; 467 my @sorted_merge_files = $self->get_merge_file_names;
432 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 468 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
433 my $delimiter = ','; 469 my $delimiter = ',';
434 my $rh_merge_data = $self->read_merge_file("$merge_file", "$delimiter"); 470 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
435 my @merge_keys = keys %$rh_merge_data; 471 my @merge_keys = keys %$rh_merge_data;
436 my $preview_user = $self->{preview_user}; 472 my $preview_user = $self->{preview_user};
437 my $preview_record = $db->getUser($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
438 476
439############################################################################################# 477#############################################################################################
440 478
441 print CGI::start_form({method=>"post", action=>$r->uri()}); 479 print CGI::start_form({method=>"post", action=>$sendMailURL});
442 print $self->hidden_authen_fields(); 480 print $self->hidden_authen_fields();
443############################################################################################# 481#############################################################################################
444# begin upper table 482# begin upper table
445############################################################################################# 483#############################################################################################
446 484
447 print CGI::start_table({-border=>'2', -cellpadding=>'4'}); 485 print CGI::start_table({-border=>'2', -cellpadding=>'4'});
448 print CGI::Tr({-align=>'left',-valign=>'VCENTER'}, 486 print CGI::Tr({-align=>'left',-valign=>'top'},
449############################################################################################# 487#############################################################################################
450# first column 488# first column
451############################################################################################# 489#############################################################################################
452 490
453 CGI::td("Message file: $input_file","\n",CGI::br(), 491 CGI::td(CGI::strong("Message file: $input_file"),"\n",CGI::br(),
454 CGI::submit(-name=>'action', -value=>'Open'), '&nbsp;&nbsp;&nbsp;&nbsp;',"\n", 492 CGI::submit(-name=>'action', -value=>'Open'), '&nbsp;&nbsp;&nbsp;&nbsp;',"\n",
455 CGI::popup_menu(-name=>'openfilename', 493 CGI::popup_menu(-name=>'openfilename',
456 -values=>\@sorted_messages, 494 -values=>\@sorted_messages,
457 -default=>$input_file 495 -default=>$input_file
458 ), "\n",CGI::br(), 496 ), "\n",CGI::br(),
459 497
460 "Save file to: $output_file","\n",CGI::br(), 498 "Save file to: $output_file","\n",CGI::br(),
461 "\n", 'From:','&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1), 499 "\n", 'From:','&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1),
462 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1), 500 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1),
463 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>35, -override=>1), 501 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>30, -override=>1),
464 ), 502 ),
465############################################################################################# 503#############################################################################################
466# second column 504# second column
467############################################################################################# 505#############################################################################################
468 CGI::td({-align=>'left'}, 506 CGI::td({-align=>'left',style=>'font-size:smaller'},
507
508 CGI::strong("Send to:"),
469 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], 509 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'],
470 -labels=>{all_students=>'All active students',studentID => 'Select recipients'}, 510 -labels=>{all_students=>'All',studentID => 'Selected'},
471 -default=>'studentID', 511 -default=>'studentID',
472 -linebreak=>1), 512 -linebreak=>0
473 CGI::br(), 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(),
474 CGI::popup_menu(-name=>'classList', 523 CGI::popup_menu(-name=>'classList',
475 -values=>\@users, 524 -values=>\@users,
476 -labels=>\%classlistLabels, 525 -labels=>\%classlistLabels,
477 -size => 10, 526 -size => 10,
478 -multiple => 1, 527 -multiple => 1,
479 -default=>$user 528 -default=>$user
480 ), 529 ),
481 530 ),
482 531
483 ), 532
484############################################################################################# 533#############################################################################################
485# third column 534# third column
486############################################################################################# 535#############################################################################################
487 CGI::td({align=>'left'}, 536 CGI::td({align=>'left'},
488 "Merge file is: $merge_file", CGI::br(), 537 "<b>Merge file:</b> $merge_file", CGI::br(),
489 CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(), 538 CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(),
490 CGI::popup_menu(-name=>'merge_file', 539 CGI::popup_menu(-name=>'merge_file',
491 -values=>\@sorted_merge_files, 540 -values=>\@sorted_merge_files,
492 -default=>$merge_file, 541 -default=>$merge_file,
493 ), "\n",CGI::hr(),CGI::br(), 542 ), "\n",CGI::hr(),CGI::br(),
… …
496 -values=>\@users, 545 -values=>\@users,
497 #-labels=>\%classlistLabels, 546 #-labels=>\%classlistLabels,
498 -default=>$preview_user, 547 -default=>$preview_user,
499 ), 548 ),
500 CGI::hr(), 549 CGI::hr(),
501 CGI::submit(-name=>'action', -value=>'resize', -label=>'Resize message window'),CGI::br(), 550 CGI::submit(-name=>'action', -value=>'resize', -label=>$REFRESH_RESIZE_BUTTON),CGI::br(),
502 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), 551 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows),
503 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), 552 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns),
504 CGI::br(),CGI::br(), 553 CGI::br(),CGI::br(),
505 #show available macros 554 #show available macros
506 CGI::popup_menu( 555 CGI::popup_menu(
… …
540# warn "merge keys ", join( " ",@merge_keys); 589# warn "merge keys ", join( " ",@merge_keys);
541############################################################################################# 590#############################################################################################
542# merge file fragment and message text area field 591# merge file fragment and message text area field
543############################################################################################# 592#############################################################################################
544 my @tmp2; 593 my @tmp2;
545 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; 594 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; # checked
546 if ($@) { 595 if ($@ and $merge_file ne 'None') {
547 print CGI::p( "Couldn't get merge data for $preview_user", CGI::br(), $@) ; 596 print "No merge data for $preview_user in merge file: &lt;$merge_file&gt;",CGI::br();
548 } else { 597 } else {
549 print CGI::pre("",data_format(0..($#tmp2)),"\n", data_format(@tmp2)); 598 print CGI::pre("",data_format(0..($#tmp2)),"<br>", data_format2(@tmp2));
550 } 599 }
551#create a textbox with the subject and a textarea with the message 600#create a textbox with the subject and a textarea with the message
552#print actual body of message 601#print actual body of message
553 602
554 print "\n", CGI::p( $self->{message}) if defined($self->{message}); 603 print "\n", CGI::p( $self->{message}) if defined($self->{message});
… …
578# Utility methods 627# Utility methods
579############################################################################## 628##############################################################################
580sub submission_error { 629sub submission_error {
581 my $self = shift; 630 my $self = shift;
582 my $msg = join( " ", @_); 631 my $msg = join( " ", @_);
583 $self->{submitError}= $msg; #CGI::b(HTML::Entities::encode($msg)); 632 $self->{submitError} .= CGI::br().$msg;
584# qq{Please hit the &quot;<B>Back</B>&quot; button on your browser to
585# try again, or notify your web master
586# if you believe this message is in error.
587# };
588 return; 633 return;
589} 634}
590 635
591sub saveProblem { 636sub saveProblem {
592 my $self = shift; 637 my $self = shift;
… …
632 $subject = "FIXME default subject"; 677 $subject = "FIXME default subject";
633 } 678 }
634 return ($from, $replyTo, $subject, \$text); 679 return ($from, $replyTo, $subject, \$text);
635} 680}
636 681
682
637sub get_message_file_names { 683sub get_message_file_names {
638 my $self = shift; 684 my $self = shift;
639 my $emailDirectory = $self->{ce}->{courseDirs}->{email}; 685 return $self->read_dir($self->{ce}->{courseDirs}->{email}, '\\.msg$');
640 #get all message files and create a list
641 local(*EMAILDIR);
642 opendir( EMAILDIR, $emailDirectory )|| die "Can't access directory $emailDirectory. Please check that webserver has permission to read this directory.";
643 my @messageFiles = grep /\.msg$/, readdir EMAILDIR; #all message files
644 closedir EMAILDIR;
645
646 return sort @messageFiles;
647} 686}
648sub get_merge_file_names { 687sub get_merge_file_names {
649 my $self = shift;
650 my $scoringDirectory = $self->{ce}->{courseDirs}->{scoring};
651 #get all message files and create a list
652 local(*SCORINGDIR);
653 opendir( SCORINGDIR, $scoringDirectory )|| die "Can't access directory $scoringDirectory.",
654 "Please check that webserver has permission to read this directory.";
655 my @mergeFiles = grep( /\.csv$/, readdir SCORINGDIR); #all message files
656 closedir SCORINGDIR;
657 @mergeFiles = sort @mergeFiles;
658# warn "FIXME scoring directory $scoringDirectory merge Files", join(" ", @mergeFiles);
659 unshift(@mergeFiles, 'None');
660 return @mergeFiles;
661}
662
663sub read_merge_file {
664 my $self = shift; 688 my $self = shift;
665 my $fileName = shift; 689 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed.
666 my $delimiter = shift;
667 $delimiter = ',' unless defined($delimiter);
668 my $scoringDirectory= $self->{ce}->{courseDirs}->{scoring};
669 my $filePath = "$scoringDirectory/$fileName";
670 # Takes a delimited file as a parameter and returns an
671 # associative array with the first field as the key.
672 # Blank lines are skipped. White space is removed
673 my(@dbArray,$key,$dbString);
674 my %assocArray = ();
675 return
676 local(*FILE);
677 if ($fileName eq 'None') {
678 # do nothing
679 }elsif ( open(FILE, "$filePath") ) {
680 my $index=0;
681 while (<FILE>){
682 unless ($_ =~ /\S/) {next;} ## skip blank lines
683 chomp;
684 @{$dbArray[$index]} =$self->getRecord($_,$delimiter);
685 $key =$dbArray[$index][0];
686 #@dbArray = map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} @dbArray;
687 #$dbString = join(" | ",@dbArray);
688 $assocArray{$key}=$dbArray[$index];
689 $index++;
690 }
691 close(FILE);
692 } else {
693 warn "Couldn't read file $filePath";
694 }
695 return \%assocArray;
696} 690}
691
692
697sub getRecord { 693sub getRecord {
698 my $self = shift; 694 my $self = shift;
699 my $line = shift; 695 my $line = shift;
700 my $delimiter = shift; 696 my $delimiter = shift;
701 $delimiter = ',' unless defined($delimiter); 697 $delimiter = ',' unless defined($delimiter);
… …
717sub process_message { 713sub process_message {
718 my $self = shift; 714 my $self = shift;
719 my $ur = shift; 715 my $ur = shift;
720 my $rh_merge_data = shift; 716 my $rh_merge_data = shift;
721 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 717 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }:
722 'FIXME no text was produced by initialization!!'; 718 'FIXME no text was produced by initialization!!';
719 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
723 #user macros that can be used in the email message 720 #user macros that can be used in the email message
724 my $SID = $ur->student_id; 721 my $SID = $ur->student_id;
725 my $FN = $ur->first_name; 722 my $FN = $ur->first_name;
726 my $LN = $ur->last_name; 723 my $LN = $ur->last_name;
727 my $SECTION = $ur->section; 724 my $SECTION = $ur->section;
728 my $RECITATION = $ur->recitation; 725 my $RECITATION = $ur->recitation;
729 my $STATUS = $ur->status; 726 my $STATUS = $ur->status;
730 my $EMAIL = $ur->email_address; 727 my $EMAIL = $ur->email_address;
731 my $LOGIN = $ur->user_id; 728 my $LOGIN = $ur->user_id;
729
732 # get record from merge file 730 # get record from merge file
733 # FIXME this is inefficient. The info should be cached 731 # FIXME this is inefficient. The info should be cached
734 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); 732 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : ();
733 if ($merge_file ne 'None' && not defined($rh_merge_data->{$SID}) ) {
735 $self->submission_error( "No merge data for $SID $FN $LN $LOGIN") unless defined($rh_merge_data->{$SID}); 734 $self->submission_error( "No merge data for $SID $FN $LN $LOGIN");
735 }
736 736
737 my $endCol = @COL; 737 my $endCol = @COL;
738 # for safety, only evaluate special variables 738 # for safety, only evaluate special variables
739 my $msg = $text; 739 my $msg = $text;
740 $msg =~ s/(\$SID)/eval($1)/ge; 740 $msg =~ s/(\$SID)/eval($1)/ge;
… …
748 $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g; 748 $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g;
749 $msg =~ s/(\$COL\[.*?\])/eval($1)/ge; 749 $msg =~ s/(\$COL\[.*?\])/eval($1)/ge;
750 750
751 $msg =~ s/\r//g; 751 $msg =~ s/\r//g;
752 752
753 my $preview_header = CGI::pre("",data_format(0..($#COL)),"\n", data_format(@COL)). 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"); 754 CGI::h3( "This sample mail would be sent to $EMAIL");
755 755
756 756
757 return $msg, $preview_header; 757 return $msg, $preview_header;
758} 758}
759
760
761# Ê sub data_format {
762#
763# Ê Ê Ê Ê Êmap {$_ =~s/\s/\./g;$_} Ê Ê map {sprintf('%-8.8s',$_);} Ê@_;
759 sub data_format { 764 sub data_format {
765 map {"COL[$_]".'&nbsp;'x(3-length($_));} @_; # problems if $_ has length bigger than 4
766 }
767 sub data_format2 {
760 map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} @_; 768 map {$_ =~s/\s/&nbsp;/g;$_} map {sprintf('%-8.8s',$_);} @_;
761 } 769 }
7621; 7701;
Legend:
Removed from v.1375  
changed lines
  Added in v.1953
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9