[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 2035 Revision 2779
1################################################################################ 1################################################################################
2# WeBWorK Online Homework Delivery System 2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm,v 1.25 2004/05/05 01:53:51 gage Exp $ 4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm,v 1.35 2004/06/24 18:08:43 dpvc Exp $
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 6# This program is free software; you can redistribute it and/or modify it under
7# the terms of either: (a) the GNU General Public License as published by the 7# the terms of either: (a) the GNU General Public License as published by the
8# Free Software Foundation; either version 2, or (at your option) any later 8# Free Software Foundation; either version 2, or (at your option) any later
9# version, or (b) the "Artistic License" which comes with this package. 9# version, or (b) the "Artistic License" which comes with this package.
… …
26use strict; 26use strict;
27use warnings; 27use warnings;
28use CGI qw(); 28use CGI qw();
29#use HTML::Entities; 29#use HTML::Entities;
30use Mail::Sender; 30use Mail::Sender;
31use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/;
32use WeBWorK::Utils::FilterRecords qw/filterRecords/;
31 33
32my $REFRESH_RESIZE_BUTTON = "Reorder, Resize and Update"; # handle submit value idiocy 34my $REFRESH_RESIZE_BUTTON = "Set preview to: "; # handle submit value idiocy
33sub initialize { 35sub initialize {
34 my ($self) = @_; 36 my ($self) = @_;
35 my $r = $self->r; 37 my $r = $self->r;
36 my $db = $r->db; 38 my $db = $r->db;
37 my $ce = $r->ce; 39 my $ce = $r->ce;
38 my $authz = $r->authz; 40 my $authz = $r->authz;
39 my $user = $r->param('user'); 41 my $user = $r->param('user');
40 42
43 my @selected_filters;
44 if (defined ($r->param('classList!filter'))){ @selected_filters = $r->param('classList!filter');}
45 else {@selected_filters = ("all");}
46
47
48 # Check permissions
49 return unless $authz->hasPermissions($user, "access_instructor_tools");
41 unless ($authz->hasPermissions($user, "send_mail")) { 50 return unless $authz->hasPermissions($user, "send_mail");
42 $self->{submitError} = "You are not authorized to send mail to students."; 51
43 return;
44 }
45############################################################################################# 52#############################################################################################
46# gather directory data 53# gather directory data
47############################################################################################# 54#############################################################################################
48 my $emailDirectory = $ce->{courseDirs}->{email}; 55 my $emailDirectory = $ce->{courseDirs}->{email};
49 my $scoringDirectory = $ce->{courseDirs}->{scoring}; 56 my $scoringDirectory = $ce->{courseDirs}->{scoring};
50 my $templateDirectory = $ce->{courseDirs}->{templates}; 57 my $templateDirectory = $ce->{courseDirs}->{templates};
51 58
52 my $action = $r->param('action'); 59 my $action = $r->param('action') ;
53 my $openfilename = $r->param('openfilename'); 60 my $openfilename = $r->param('openfilename');
54 my $savefilename = $r->param('savefilename'); 61 my $savefilename = $r->param('savefilename');
55 62
56 63
57 #FIXME get these values from global course environment (see subroutines as well) 64 #FIXME get these values from global course environment (see subroutines as well)
58 my $default_msg_file = 'default.msg'; 65 my $default_msg_file = 'default.msg';
59 my $old_default_msg_file = 'old_default.msg'; 66 my $old_default_msg_file = 'old_default.msg';
60 67
61 68
69 # get user record
70 my $ur = $self->{db}->getUser($user);
71
62 # store data 72 # store data
63 $self->{defaultFrom} = 'FIXME from'; 73 $self->{defaultFrom} = $ur->email_address . " (".$ur->first_name." ".$ur->last_name.")";
64 $self->{defaultReply} = 'FIXME reply'; 74 $self->{defaultReply} = $ur->email_address;
75 $self->{defaultSubject} = $self->r->urlpath->arg("courseID") . " notice";
76
65 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows}; 77 $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}; 78 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns};
67 $self->{default_msg_file} = $default_msg_file; 79 $self->{default_msg_file} = $default_msg_file;
68 $self->{old_default_msg_file} = $old_default_msg_file; 80 $self->{old_default_msg_file} = $old_default_msg_file;
69 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None'; 81 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None';
… …
73############################################################################################# 85#############################################################################################
74# gather database data 86# gather database data
75############################################################################################# 87#############################################################################################
76 # FIXME this might be better done in body? We don't always need all of this data. or do we? 88 # FIXME this might be better done in body? We don't always need all of this data. or do we?
77 my @users = $db->listUsers; 89 my @users = $db->listUsers;
90 my @Users = $db->getUsers(@users);
78 my @user_records = (); 91 my @user_records = ();
92
93## Mark's code to prefilter userlist
94
95
96 my (@viewable_sections,@viewable_recitations);
97
98 if (defined @{$ce->{viewable_sections}->{$user}})
99 {@viewable_sections = @{$ce->{viewable_sections}->{$user}};}
100 if (defined @{$ce->{viewable_recitations}->{$user}})
101 {@viewable_recitations = @{$ce->{viewable_recitations}->{$user}};}
102
103 if (@viewable_sections or @viewable_recitations){
104 foreach my $student (@Users){
105 my $keep = 0;
106 foreach my $sec (@viewable_sections){
107 if ($student->section() eq $sec){$keep = 1;}
108 }
109 foreach my $rec (@viewable_recitations){
110 if ($student->recitation() eq $rec){$keep = 1;}
111 }
112 if ($keep) {push @user_records, $student;}
113 }
114 }
115 else {@user_records = @Users;}
116
117## End Mark's code
118
79 foreach my $userName (@users) { 119# foreach my $userName (@users) {
80 my $userRecord = $db->getUser($userName); # checked 120# my $userRecord = $db->getUser($userName); # checked
81 die "record for user $userName not found" unless $userRecord; 121# die "record for user $userName not found" unless $userRecord;
82 push(@user_records, $userRecord); 122# push(@user_records, $userRecord);
83 } 123# }
84 ########################### 124 ###########################
85 # Sort the users for presentation in the select list 125 # Sort the users for presentation in the select list
86 ########################### 126 ###########################
87 if (defined $r->param("sort_by") ) { 127# if (defined $r->param("sort_by") ) {
88 my $sort_method = $r->param("sort_by"); 128# my $sort_method = $r->param("sort_by");
89 if ($sort_method eq 'section') { 129# 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; 130# @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') { 131# } 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; 132# @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') { 133# } elsif ($sort_method eq 'alphabetical') {
94 @user_records = sort { (lc($a->last_name) cmp lc($b->last_name)) } @user_records; 134# @user_records = sort { (lc($a->last_name) cmp lc($b->last_name)) } @user_records;
95 } elsif ($sort_method eq 'id' ) { 135# } elsif ($sort_method eq 'id' ) {
96 @user_records = sort { $a->user_id cmp $b->user_id } @user_records; 136# @user_records = sort { $a->user_id cmp $b->user_id } @user_records;
97 } 137# }
98 } else { 138# } else {
99 @user_records = sort { $a->user_id cmp $b->user_id } @user_records; 139# @user_records = sort { $a->user_id cmp $b->user_id } @user_records;
100 } 140# }
101 141
102 142
103 # replace the user names by a sorted version. 143 # replace the user names by a sorted version.
104 @users = map {$_->user_id} @user_records; 144 @users = map {$_->user_id} @user_records;
105 # store data 145 # store data
… …
111############################################################################################# 151#############################################################################################
112 my @send_to = (); 152 my @send_to = ();
113 #FIXME this (radio) is a lousy name 153 #FIXME this (radio) is a lousy name
114 my $recipients = $r->param('radio'); 154 my $recipients = $r->param('radio');
115 if (defined($recipients) and $recipients eq 'all_students') { #only active students #FIXME status check?? 155 if (defined($recipients) and $recipients eq 'all_students') { #only active students #FIXME status check??
156
157## Add code so that only people who pass the current filters are added to our list of recipients.
158# @user_records = filterRecords({filter=\@selected_filters},@user_records);
159# I wasn't able to make this work
160# I edited the selection button to make that clear.
161#
162
116 foreach my $ur (@user_records) { 163 foreach my $ur (@user_records) {
117 push(@send_to,$ur->user_id) if $ur->status eq 'C' and not($ur->user_id =~ /practice/); 164 push(@send_to,$ur->user_id) if $ur->status eq 'C' and not($ur->user_id =~ /practice/);
118 } 165 }
119 } elsif (defined($recipients) and $recipients eq 'studentID' ) { 166 } elsif (defined($recipients) and $recipients eq 'studentID' ) {
120 @send_to = $r->param('classList'); 167 @send_to = $r->param('classList');
… …
131 if ( defined($openfilename) ) { 178 if ( defined($openfilename) ) {
132 if ( -e "${emailDirectory}/$openfilename") { 179 if ( -e "${emailDirectory}/$openfilename") {
133 if ( -R "${emailDirectory}/$openfilename") { 180 if ( -R "${emailDirectory}/$openfilename") {
134 $input_file = $openfilename; 181 $input_file = $openfilename;
135 } else { 182 } else {
136 warn join("", 183 $self->addbadmessage(CGI::p(join("",
137 "The file ${emailDirectory}/$openfilename is not readable by the webserver.",CGI::br(), 184 "The file ${emailDirectory}/$openfilename is not readable by the webserver.",CGI::br(),
138 "Check that it's permissions are set correctly.", 185 "Check that it's permissions are set correctly.",
139 ); 186 )));
140 } 187 }
141 } else { 188 } else {
142 $input_file = $default_msg_file; 189 $input_file = $default_msg_file;
143 warn join("", 190 $self->addbadmessage(CGI::p(join("",
144 "The file ${emailDirectory}/$openfilename cannot be found.",CGI::br(), 191 "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(), 192 "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.", 193 "Using contents of the default message $default_msg_file instead.",
147 ); 194 )));
148 } 195 }
149 } else { 196 } else {
150 $input_file = $default_msg_file; 197 $input_file = $default_msg_file;
151 } 198 }
152 $self->{input_file} =$input_file; 199 $self->{input_file} =$input_file;
… …
155# Determine the file name to save message into 202# Determine the file name to save message into
156################################################################# 203#################################################################
157 my $output_file = 'FIXME no output file specified'; 204 my $output_file = 'FIXME no output file specified';
158 if (defined($action) and $action eq 'Save as Default') { 205 if (defined($action) and $action eq 'Save as Default') {
159 $output_file = $default_msg_file; 206 $output_file = $default_msg_file;
160 } elsif ( defined($action) and ($action =~/save/i) and defined($savefilename) and $savefilename ){ 207 } elsif ( defined($action) and ($action =~/save/i)) {
208 if (defined($savefilename) and $savefilename ) {
161 $output_file = $savefilename; 209 $output_file = $savefilename;
210 } else {
211 $self->addbadmessage(CGI::p("No filename was specified for saving! The message was not saved."));
212 }
162 } elsif ( defined($input_file) ) { 213 } elsif ( defined($input_file) ) {
163 $output_file = $input_file; 214 $output_file = $input_file;
164 } 215 }
165 216
166 ################################################################# 217 #################################################################
167 # Sanity check on save file name 218 # Sanity check on save file name
168 ################################################################# 219 #################################################################
169 220
170 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) { 221 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) {
171 $self->submission_error("For security reasons, you cannot specify a message file from a directory", 222 $self->addbadmessage(CGI::p("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). ", 223 "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", 224 "Please specify a different file or move the needed file to the email directory",));
174 );
175 } 225 }
176 unless ($output_file =~ m|\.msg$| ) { 226 unless ($output_file =~ m|\.msg$| ) {
177 $self->submission_error("Invalid file name.", 227 $self->addbadmessage(CGI::p("Invalid file name.",
178 "The file name \"$output_file\" does not have a \".msg\" extension", 228 "The file name \"$output_file\" does not have a \".msg\" extension",
179 "All email file names must end in the extension \".msg\"", 229 "All email file names must end in the extension \".msg\"",
180 "choose a file name with a \".msg\" extension.", 230 "choose a file name with a \".msg\" extension.",
181 "The message was not saved.", 231 "The message was not saved.",));
182 );
183 } 232 }
233
184 $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing. 234 $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 235
186 236
187############################################################################################# 237#############################################################################################
188# Determine input source 238# Determine input source
189############################################################################################# 239#############################################################################################
240 #warn "Action = $action";
241 my $input_source;
242 if ($action){
190 my $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file'; 243 $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file';}
244 else { $input_source = ( defined($r->param('body')) ) ? 'form' : 'file';}
191 245
192############################################################################################# 246#############################################################################################
193# Get inputs 247# Get inputs
194############################################################################################# 248#############################################################################################
195 my($from, $replyTo, $r_text, $subject); 249 my($from, $replyTo, $r_text, $subject);
… …
205 $from = $r->param('from'); 259 $from = $r->param('from');
206 $replyTo = $r->param('replyTo'); 260 $replyTo = $r->param('replyTo');
207 $subject = $r->param('subject'); 261 $subject = $r->param('subject');
208 my $body = $r->param('body'); 262 my $body = $r->param('body');
209 # Sanity check: body must contain non-white space 263 # Sanity check: body must contain non-white space
210 $self->submission_error('You didn\'t enter any message.') unless ($r->param('body') =~ /\S/); 264 $self->addbadmessage(CGI::p('You didn\'t enter any message.')) unless ($r->param('body') =~ /\S/);
211 $r_text = \$body; 265 $r_text = \$body;
212 266
213 } 267 }
214 # store data 268 # store data
215 $self->{from} = $from; 269 $self->{from} = $from;
… …
281# warn "FIXME from $from | subject $subject |reply $replyTo|msg $temp_body"; 335# warn "FIXME from $from | subject $subject |reply $replyTo|msg $temp_body";
282 ################################################################# 336 #################################################################
283 # overwrite protection 337 # overwrite protection
284 ################################################################# 338 #################################################################
285 if ($action eq 'Save as:' and -e "$emailDirectory/$output_file") { 339 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", 340 $self->addbadmessage(CGI::p("The file $emailDirectory/$output_file already exists and cannot be overwritten",
287 "The message was not saved"); 341 "The message was not saved"));
288 return; 342 return;
289 } 343 }
290 344
291 ################################################################# 345 #################################################################
292 # Back up existing file? 346 # Back up existing file?
293 ################################################################# 347 #################################################################
294 if ($action eq 'Save as Default' and -e "$emailDirectory/$default_msg_file") { 348 if ($action eq 'Save as Default' and -e "$emailDirectory/$default_msg_file") {
295 rename("$emailDirectory/$default_msg_file","$emailDirectory/$old_default_msg_file") or 349 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 ", 350 die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ",
297 "Check permissions for webserver on directory $emailDirectory. $!"; 351 "Check permissions for webserver on directory $emailDirectory. $!";
298 $self->{message} .= "Backup file <code>$emailDirectory/$old_default_msg_file</code> created.".CGI::br(); 352 $self->addgoodmessage(CGI::p("Backup file <code>$emailDirectory/$old_default_msg_file</code> created." . CGI::br()));
299 } 353 }
300 ################################################################# 354 #################################################################
301 # Save the message 355 # Save the message
302 ################################################################# 356 #################################################################
303 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ); 357 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ) unless ($output_file =~ /^[~.]/ || $output_file =~ /\.\./ || not $output_file =~ m|\.msg$|);
304 unless ( $self->{submitError} or not -w "${emailDirectory}/$output_file" ) { # if there are no errors report success 358 unless ( $self->{submit_message} 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>."; 359 $self->addgoodmessage(CGI::p("Message saved to file <code>${emailDirectory}/$output_file</code>."));
306 } 360 }
307 361
308 } elsif ($action eq 'Preview') { 362 } elsif ($action eq 'Preview message') {
309 $self->{response} = 'preview'; 363 $self->{response} = 'preview';
310 364
311 } elsif ($action eq 'Send Email') { 365 } elsif ($action eq 'Send Email') {
312 $self->{response} = 'send_email'; 366 $self->{response} = 'send_email';
313 367
314 my @recipients = @{$self->{ra_send_to}}; 368 my @recipients = @{$self->{ra_send_to}};
315 $self->addmessage(CGI::div({class=>'ResultsWithError'},
316 "No recipients selected")) unless @recipients; 369 $self->addbadmessage(CGI::p("No recipients selected ")) unless @recipients;
317 # get merge file 370 # get merge file
318 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 371 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None';
319 my $delimiter = ','; 372 my $delimiter = ',';
320 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 373 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
321 unless (ref($rh_merge_data) ) { 374 unless (ref($rh_merge_data) ) {
322 warn "no merge data file"; 375 $self->addbadmessage(CGI::p("No merge data file"));
323 $self->submission_error("Can't read merge file $merge_file. No message sent"); 376 $self->addbadmessage(CGI::p("Can't read merge file $merge_file. No message sent"));
324 return; 377 return;
325 } ; 378 } ;
326 379
327 380
328 foreach my $recipient (@recipients) { 381 foreach my $recipient (@recipients) {
329 #warn "FIXME sending email to $recipient"; 382 #warn "FIXME sending email to $recipient";
330 my $ur = $self->{db}->getUser($recipient); #checked 383 my $ur = $self->{db}->getUser($recipient); #checked
331 die "record for user $recipient not found" unless $ur; 384 die "record for user $recipient not found" unless $ur;
332 unless ($ur->email_address) { 385 unless ($ur->email_address) {
333 $self->addmessage(CGI::div({class=>'ResultsWithError'},
334 "user $recipient does not have an email address -- skipping")); 386 $self->addbadmessage(CGI::p("user $recipient does not have an email address -- skipping"));
335 next; 387 next;
336 } 388 }
337 my ($msg, $preview_header); 389 my ($msg, $preview_header);
338 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); }; 390 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); };
339 warn "There were errors in processing user $ur, merge file $merge_file. $@" if $@; 391 $self->addbadmessage(CGI::p("There were errors in processing user $ur, merge file $merge_file. $@")) if $@;
340 my $mailer = Mail::Sender->new({ 392 my $mailer = Mail::Sender->new({
341 from => $from, 393 from => $from,
342 to => $ur->email_address, 394 to => $ur->email_address,
343 smtp => $ce->{mail}->{smtpServer}, 395 smtp => $ce->{mail}->{smtpServer},
344 subject => $subject, 396 subject => $subject,
345 headers => "X-Remote-Host: ".$r->get_remote_host(), 397 headers => "X-Remote-Host: ".$r->get_remote_host(),
346 }); 398 });
347 unless (ref $mailer) { 399 unless (ref $mailer) {
348 warn "Failed to create a mailer for user $recipient: $Mail::Sender::Error"; 400 $self->addbadmessage(CGI::p("Failed to create a mailer for user $recipient: $Mail::Sender::Error"));
349 next; 401 next;
350 } 402 }
351 unless (ref $mailer->Open()) { 403 unless (ref $mailer->Open()) {
352 warn "Failed to open the mailer for user $recipient: $Mail::Sender::Error"; 404 $self->addbadmessage(CGI::p("Failed to open the mailer for user $recipient: $Mail::Sender::Error"));
353 next; 405 next;
354 } 406 }
355 my $MAIL = $mailer->GetHandle() or warn "Couldn't get handle"; 407 my $MAIL = $mailer->GetHandle() or $self->addbadmessage(CGI::p("Couldn't get handle"));
356 print $MAIL $msg || warn "Couldn't print to $MAIL"; 408 print $MAIL $msg || $self->addbadmessage(CGI::p("Couldn't print to $MAIL"));
357 close $MAIL || warn "Couldn't close $MAIL"; 409 close $MAIL || $self->addbadmessage(CGI::p("Couldn't close $MAIL"));
358 #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject"; 410 #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject";
359 411
360 } 412 }
361 413
362 } else { 414 } else {
363 warn "Didn't recognize button $action"; 415 $self->addbadmessage(CGI::p("Didn't recognize button $action"));
364 } 416 }
365 417
366 418
367 419
368} #end initialize 420} #end initialize
… …
373 425
374sub body { 426sub body {
375 my ($self) = @_; 427 my ($self) = @_;
376 my $r = $self->r; 428 my $r = $self->r;
377 my $urlpath = $r->urlpath; 429 my $urlpath = $r->urlpath;
430 my $authz = $r->authz;
378 my $setID = $urlpath->arg("setID"); 431 my $setID = $urlpath->arg("setID");
379 my $response = (defined($self->{response}))? $self->{response} : ''; 432 my $response = (defined($self->{response}))? $self->{response} : '';
433 my $user = $r->param('user');
434
435 # Check permissions
436 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to access instructor tools"))
437 unless $authz->hasPermissions($user, "access_instructor_tools");
438
439 return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to send mail to students"))
440 unless $authz->hasPermissions($user, "send_mail");
441
380 if ($response eq 'preview') { 442 if ($response eq 'preview') {
381 $self->print_preview($setID); 443 $self->print_preview($setID);
382 } elsif (($response eq 'send_email')){ 444 } elsif (($response eq 'send_email')){
445 $self->addgoodmessage(CGI::p("Email sent to ". scalar(@{$self->{ra_send_to}})." students."));
383 $self->{message} .= CGI::h3("Email sent to "). join(" ", @{$self->{ra_send_to}}); 446 $self->{message} .= CGI::i("Email sent to ". scalar(@{$self->{ra_send_to}})." students.");
384 $self->print_form($setID); 447 $self->print_form($setID);
385 } else { 448 } else {
386 $self->print_form($setID); 449 $self->print_form($setID);
387 } 450 }
388 451
… …
403 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 466 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter");
404 467
405 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data); 468 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data);
406 469
407 my $recipients = join(" ",@{$self->{ra_send_to} }); 470 my $recipients = join(" ",@{$self->{ra_send_to} });
408 my $errorMessage = defined($self->{submitError}) ? CGI::h3($self->{submitError} ) : '' ; 471 my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ;
409 $msg = join("", 472 $msg = join("",
410 $errorMessage, 473 $errorMessage,
411 $preview_header, 474 $preview_header,
412 "To: " , $ur->email_address,"\n", 475 "To: " , $ur->email_address,"\n",
413 "From: " , $self->{from} , "\n" , 476 "From: " , $self->{from} , "\n" ,
… …
451 my %classlistLabels = ();# %$hr_classlistLabels; 514 my %classlistLabels = ();# %$hr_classlistLabels;
452 foreach my $ur (@{ $ra_user_records }) { 515 foreach my $ur (@{ $ra_user_records }) {
453 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation; 516 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation;
454 } 517 }
455 518
519## Mark edit define scrolling list
520 my $scrolling_user_list = scrollingRecordList({
521 name => "classList", ## changed from classList to action
522 request => $r,
523 default_sort => "lnfn",
524 default_format => "lnfn_uid",
525 default_filters => ["all"],
526 size => 5,
527 multiple => 1,
528 }, @{$ra_user_records});
456 529
457############################################################################################################## 530##############################################################################################################
458 531
459 532
460 my $from = $self->{from}; 533 my $from = $self->{from};
… …
503 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>30, -override=>1), 576 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>30, -override=>1),
504 ), 577 ),
505############################################################################################# 578#############################################################################################
506# second column 579# second column
507############################################################################################# 580#############################################################################################
508 CGI::td({-align=>'left',style=>'font-size:smaller'}, 581# CGI::td({-align=>'left',style=>'font-size:smaller'},
509 582#
510 CGI::strong("Send to:"), 583# CGI::strong("Send to:"),
511 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], 584# CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'],
512 -labels=>{all_students=>'All',studentID => 'Selected'}, 585# -labels=>{all_students=>'All students in course',studentID => 'Selected'},
513 -default=>'studentID', 586# -default=>'studentID',
514 -linebreak=>0 587# -linebreak=>0
515 ), CGI::br(),CGI::br(), 588# ), CGI::br(),CGI::br(),
516 589## Edit by Mark to insert scrolling list
590 CGI::td({-style=>"width:33%"},CGI::strong("Send to:"),
591 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'],
592 -labels=>{all_students=>'All students in course',studentID => 'Selected students'},
593 -default=>'studentID', -linebreak=>0),
594 CGI::br(),$scrolling_user_list),
595## Edit here to insert filtering
596## be sure to fail GRACEFULLY!
597#
598#
517 CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),, 599# CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),,
518 CGI::radio_group(-name=>'sort_by', -values=>['id','alphabetical','section','recitation'], 600# CGI::radio_group(-name=>'sort_by', -values=>['id','alphabetical','section','recitation'],
519 -labels=>{id=>'Login',alphabetical=>'Alph.',section => 'Sec.',recitation=>'Rec.'}, 601# -labels=>{id=>'Login',alphabetical=>'Alph.',section => 'Sec.',recitation=>'Rec.'},
520 -default=>defined($r->param("sort_by")) ? $r->param("sort_by") : 'id', 602# -default=>defined($r->param("sort_by")) ? $r->param("sort_by") : 'id',
521 -linebreak=>0 603# -linebreak=>0
522 ), 604# ),
523 605#
524 CGI::br(),CGI::br(), 606# CGI::br(),CGI::br(),
525 CGI::popup_menu(-name=>'classList', 607# CGI::popup_menu(-name=>'classList',
526 -values=>\@users, 608# -values=>\@users,
527 -labels=>\%classlistLabels, 609# -labels=>\%classlistLabels,
528 -size => 10, 610# -size => 10,
529 -multiple => 1, 611# -multiple => 1,
530 -default=>$user 612# -default=>$user
531 ), 613# ),
532 ), 614# ),
615
533 616
617
534 618
535############################################################################################# 619#############################################################################################
536# third column 620# third column
537############################################################################################# 621#############################################################################################
538 CGI::td({align=>'left'}, 622 CGI::td({align=>'left'},
539 "<b>Merge file:</b> $merge_file", CGI::br(), 623 "<b>Merge file:</b> $merge_file", CGI::br(),
540 CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(), 624 CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(),
541 CGI::popup_menu(-name=>'merge_file', 625 CGI::popup_menu(-name=>'merge_file',
542 -values=>\@sorted_merge_files, 626 -values=>\@sorted_merge_files,
543 -default=>$merge_file, 627 -default=>$merge_file,
544 ), "\n",CGI::hr(),CGI::br(), 628 ), "\n",CGI::hr(),
545 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview')," email to ", 629 CGI::b("Viewing email for: "), "$preview_user",CGI::br(),
630 CGI::submit(-name=>'action', -value=>'resize', -label=>$REFRESH_RESIZE_BUTTON),'&nbsp;',
546 CGI::popup_menu(-name=>'preview_user', 631 CGI::popup_menu(-name=>'preview_user',
547 -values=>\@users, 632 -values=>\@users,
548 #-labels=>\%classlistLabels, 633 #-labels=>\%classlistLabels,
549 -default=>$preview_user, 634 -default=>$preview_user,
550 ), 635 ),
636 CGI::br(),
637 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview message'),'&nbsp;&nbsp;',
638
639 CGI::br(),
640
551 CGI::hr(), 641 CGI::hr(),
552 CGI::submit(-name=>'action', -value=>'resize', -label=>$REFRESH_RESIZE_BUTTON),CGI::br(),
553 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), 642 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows),
554 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), 643 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns),
555 CGI::br(),CGI::br(), 644 CGI::br(),CGI::i('Press any action button to update display'),CGI::br(),
556 #show available macros 645 #show available macros
557 CGI::popup_menu( 646 CGI::popup_menu(
558 -name=>'dummyName', 647 -name=>'dummyName',
559 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'], 648 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'],
560 -labels=>{''=>'list of insertable macros', 649 -labels=>{''=>'list of insertable macros',
… …
628############################################################################## 717##############################################################################
629# Utility methods 718# Utility methods
630############################################################################## 719##############################################################################
631sub submission_error { 720sub submission_error {
632 my $self = shift; 721 my $self = shift;
633 my $msg = join( " ", @_); 722 my $msg = join( " ", @_);
634 $self->{submitError} .= CGI::br().$msg; 723 $self->{submitError} .= CGI::br().$msg;
635 return; 724 return;
636} 725}
637 726
638sub saveProblem { 727sub saveProblem {
639 my $self = shift; 728 my $self = shift;
640 my ($body, $probFileName)= @_; 729 my ($body, $probFileName)= @_;
641 local(*PROBLEM); 730 local(*PROBLEM);
642 open (PROBLEM, ">$probFileName") || 731 open (PROBLEM, ">$probFileName") ||
643 $self->submission_error("Could not open $probFileName for writing. 732 $self->addbadmessage(CGI::p("Could not open $probFileName for writing.
644 Check that the permissions for this problem are 660 (-rw-rw----)"); 733 Check that the permissions for this problem are 660 (-rw-rw----)"));
645 print PROBLEM $body; 734 print PROBLEM $body if -w $probFileName;
646 close PROBLEM; 735 close PROBLEM;
647 chmod 0660, "$probFileName" || 736 chmod 0660, "$probFileName" ||
648 $self->submission_error("
649 CAN'T CHANGE PERMISSIONS ON FILE $probFileName"); 737 $self->addbadmessage(CGI::p("CAN'T CHANGE PERMISSIONS ON FILE $probFileName"));
650} 738}
651 739
652sub read_input_file { 740sub read_input_file {
653 my $self = shift; 741 my $self = shift;
654 my $filePath = shift; 742 my $filePath = shift;
655 my ($text, @text); 743 my ($text, @text);
656 my $header = ''; 744 my $header = '';
657 my ($subject, $from, $replyTo); 745 my ($subject, $from, $replyTo);
658 local(*FILE); 746 local(*FILE);
659 if (-e "$filePath" and -r "$filePath") { 747 if (-e "$filePath" and -r "$filePath") {
660 open FILE, "$filePath" || do { $self->submission_error("Can't open $filePath"); return}; 748 open FILE, "$filePath" || do { $self->addbadmessage(CGI::p("Can't open $filePath")); return};
661 while ($header !~ s/Message:\s*$//m and not eof(FILE)) { 749 while ($header !~ s/Message:\s*$//m and not eof(FILE)) {
662 $header .= <FILE>; 750 $header .= <FILE>;
663 } 751 }
664 $text = join( '', <FILE>); 752 $text = join( '', <FILE>);
665 $text =~ s/^\s*//; # remove initial white space if any. 753 $text =~ s/^\s*//; # remove initial white space if any.
… …
674 762
675 } else { 763 } else {
676 $from = $self->{defaultFrom}; 764 $from = $self->{defaultFrom};
677 $replyTo = $self->{defaultReply}; 765 $replyTo = $self->{defaultReply};
678 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist"; 766 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist";
679 $subject = "FIXME default subject"; 767 $subject = $self->{defaultSubject};
680 } 768 }
681 return ($from, $replyTo, $subject, \$text); 769 return ($from, $replyTo, $subject, \$text);
682} 770}
683 771
684 772
… …
731 819
732 # get record from merge file 820 # get record from merge file
733 # FIXME this is inefficient. The info should be cached 821 # FIXME this is inefficient. The info should be cached
734 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); 822 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : ();
735 if ($merge_file ne 'None' && not defined($rh_merge_data->{$SID}) ) { 823 if ($merge_file ne 'None' && not defined($rh_merge_data->{$SID}) ) {
736 $self->submission_error( "No merge data for $SID $FN $LN $LOGIN"); 824 $self->addbadmessage(CGI::p("No merge data for student id:$SID; name:$FN $LN; login:$LOGIN"));
737 } 825 }
738 826 unshift(@COL,""); ## this makes COL[1] the first column
739 my $endCol = @COL; 827 my $endCol = @COL;
740 # for safety, only evaluate special variables 828 # for safety, only evaluate special variables
741 my $msg = $text; 829 my $msg = $text;
742 $msg =~ s/(\$SID)/eval($1)/ge; 830 $msg =~ s/(\$SID)/eval($1)/ge;
743 $msg =~ s/(\$LN)/eval($1)/ge; 831 $msg =~ s/(\$LN)/eval($1)/ge;
… …
745 $msg =~ s/(\$STATUS)/eval($1)/ge; 833 $msg =~ s/(\$STATUS)/eval($1)/ge;
746 $msg =~ s/(\$SECTION)/eval($1)/ge; 834 $msg =~ s/(\$SECTION)/eval($1)/ge;
747 $msg =~ s/(\$RECITATION)/eval($1)/ge; 835 $msg =~ s/(\$RECITATION)/eval($1)/ge;
748 $msg =~ s/(\$EMAIL)/eval($1)/ge; 836 $msg =~ s/(\$EMAIL)/eval($1)/ge;
749 $msg =~ s/(\$LOGIN)/eval($1)/ge; 837 $msg =~ s/(\$LOGIN)/eval($1)/ge;
750 $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g; 838# $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g; ## Perl handles negative indexes correctly, so there is no need to do this
751 $msg =~ s/(\$COL\[.*?\])/eval($1)/ge; 839 $msg =~ s/(\$COL\[.*?\])/eval($1)/ge if defined($COL[1]); # prevents extraneous error messages.
752 840
753 $msg =~ s/\r//g; 841 $msg =~ s/\r//g;
754 842
843 my @preview_COL = @COL;
844 shift @preview_COL; ## shift back for preview
755 my $preview_header = CGI::pre("",data_format(0..($#COL)),"<br>", data_format2(@COL)). 845 my $preview_header = CGI::pre("",data_format(1..($#COL)),"<br>", data_format2(@preview_COL)).
756 CGI::h3( "This sample mail would be sent to $EMAIL"); 846 CGI::h3( "This sample mail would be sent to $EMAIL");
757
758 847
759 return $msg, $preview_header; 848 return $msg, $preview_header;
760} 849}
761 850
762 851
Legend:
Removed from v.2035  
changed lines
  Added in v.2779
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9