Parent Directory
| 
Revision Log
Changed substitution as suggested by Sam Arnie
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.36 2004/09/14 18:55:58 apizer 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 17 package WeBWorK::ContentGenerator::Instructor::SendMail; 18 use base qw(WeBWorK::ContentGenerator::Instructor); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Instructor::SendMail - Entry point for User-specific data editing 23 24 =cut 25 26 use strict; 27 use warnings; 28 use CGI qw(); 29 #use HTML::Entities; 30 use Mail::Sender; 31 use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; 32 use WeBWorK::Utils::FilterRecords qw/filterRecords/; 33 34 my $REFRESH_RESIZE_BUTTON = "Set preview to: "; # handle submit value idiocy 35 sub initialize { 36 my ($self) = @_; 37 my $r = $self->r; 38 my $db = $r->db; 39 my $ce = $r->ce; 40 my $authz = $r->authz; 41 my $user = $r->param('user'); 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"); 50 return unless $authz->hasPermissions($user, "send_mail"); 51 52 ############################################################################################# 53 # gather directory data 54 ############################################################################################# 55 my $emailDirectory = $ce->{courseDirs}->{email}; 56 my $scoringDirectory = $ce->{courseDirs}->{scoring}; 57 my $templateDirectory = $ce->{courseDirs}->{templates}; 58 59 my $action = $r->param('action') ; 60 my $openfilename = $r->param('openfilename'); 61 my $savefilename = $r->param('savefilename'); 62 63 64 #FIXME get these values from global course environment (see subroutines as well) 65 my $default_msg_file = 'default.msg'; 66 my $old_default_msg_file = 'old_default.msg'; 67 68 69 # get user record 70 my $ur = $self->{db}->getUser($user); 71 72 # store data 73 $self->{defaultFrom} = $ur->email_address . " (".$ur->first_name." ".$ur->last_name.")"; 74 $self->{defaultReply} = $ur->email_address; 75 $self->{defaultSubject} = $self->r->urlpath->arg("courseID") . " notice"; 76 77 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows}; 78 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns}; 79 $self->{default_msg_file} = $default_msg_file; 80 $self->{old_default_msg_file} = $old_default_msg_file; 81 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None'; 82 $self->{preview_user} = (defined($r->param('preview_user'))) ? $r->param('preview_user') : $user; 83 84 85 ############################################################################################# 86 # gather database data 87 ############################################################################################# 88 # FIXME this might be better done in body? We don't always need all of this data. or do we? 89 my @users = $db->listUsers; 90 my @Users = $db->getUsers(@users); 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 119 # foreach my $userName (@users) { 120 # my $userRecord = $db->getUser($userName); # checked 121 # die "record for user $userName not found" unless $userRecord; 122 # push(@user_records, $userRecord); 123 # } 124 ########################### 125 # Sort the users for presentation in the select list 126 ########################### 127 # if (defined $r->param("sort_by") ) { 128 # my $sort_method = $r->param("sort_by"); 129 # if ($sort_method eq 'section') { 130 # @user_records = sort { (lc($a->section) cmp lc($b->section)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records; 131 # } elsif ($sort_method eq 'recitation') { 132 # @user_records = sort { (lc($a->recitation) cmp lc($b->recitation)) || (lc($a->last_name) cmp lc($b->last_name)) } @user_records; 133 # } elsif ($sort_method eq 'alphabetical') { 134 # @user_records = sort { (lc($a->last_name) cmp lc($b->last_name)) } @user_records; 135 # } elsif ($sort_method eq 'id' ) { 136 # @user_records = sort { $a->user_id cmp $b->user_id } @user_records; 137 # } 138 # } else { 139 # @user_records = sort { $a->user_id cmp $b->user_id } @user_records; 140 # } 141 142 143 # replace the user names by a sorted version. 144 @users = map {$_->user_id} @user_records; 145 # store data 146 $self->{ra_users} = \@users; 147 $self->{ra_user_records} = \@user_records; 148 149 ############################################################################################# 150 # gather list of recipients 151 ############################################################################################# 152 my @send_to = (); 153 #FIXME this (radio) is a lousy name 154 my $recipients = $r->param('radio'); 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 163 foreach my $ur (@user_records) { 164 push(@send_to,$ur->user_id) if $ur->status eq 'C' and not($ur->user_id =~ /practice/); 165 } 166 } elsif (defined($recipients) and $recipients eq 'studentID' ) { 167 @send_to = $r->param('classList'); 168 } else { 169 # no recipients have been defined -- probably the first time on the page 170 } 171 $self->{ra_send_to} = \@send_to; 172 ################################################################# 173 # Check the validity of the input file name 174 ################################################################# 175 my $input_file = ''; 176 #make sure an input message file was submitted and exists 177 #else use the default message 178 if ( defined($openfilename) ) { 179 if ( -e "${emailDirectory}/$openfilename") { 180 if ( -R "${emailDirectory}/$openfilename") { 181 $input_file = $openfilename; 182 } else { 183 $self->addbadmessage(CGI::p(join("", 184 "The file ${emailDirectory}/$openfilename is not readable by the webserver.",CGI::br(), 185 "Check that it's permissions are set correctly.", 186 ))); 187 } 188 } else { 189 $input_file = $default_msg_file; 190 $self->addbadmessage(CGI::p(join("", 191 "The file ${emailDirectory}/$openfilename cannot be found.",CGI::br(), 192 "Check whether it exists and whether the directory $emailDirectory can be read by the webserver.",CGI::br(), 193 "Using contents of the default message $default_msg_file instead.", 194 ))); 195 } 196 } else { 197 $input_file = $default_msg_file; 198 } 199 $self->{input_file} =$input_file; 200 201 ################################################################# 202 # Determine the file name to save message into 203 ################################################################# 204 my $output_file = 'FIXME no output file specified'; 205 if (defined($action) and $action eq 'Save as Default') { 206 $output_file = $default_msg_file; 207 } elsif ( defined($action) and ($action =~/save/i)) { 208 if (defined($savefilename) and $savefilename ) { 209 $output_file = $savefilename; 210 } else { 211 $self->addbadmessage(CGI::p("No filename was specified for saving! The message was not saved.")); 212 } 213 } elsif ( defined($input_file) ) { 214 $output_file = $input_file; 215 } 216 217 ################################################################# 218 # Sanity check on save file name 219 ################################################################# 220 221 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) { 222 $self->addbadmessage(CGI::p("For security reasons, you cannot specify a message file from a directory", 223 "higher than the email directory (you can't use ../blah/blah for example). ", 224 "Please specify a different file or move the needed file to the email directory",)); 225 } 226 unless ($output_file =~ m|\.msg$| ) { 227 $self->addbadmessage(CGI::p("Invalid file name.", 228 "The file name \"$output_file\" does not have a \".msg\" extension", 229 "All email file names must end in the extension \".msg\"", 230 "choose a file name with a \".msg\" extension.", 231 "The message was not saved.",)); 232 } 233 234 $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing. 235 236 237 ############################################################################################# 238 # Determine input source 239 ############################################################################################# 240 #warn "Action = $action"; 241 my $input_source; 242 if ($action){ 243 $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file';} 244 else { $input_source = ( defined($r->param('body')) ) ? 'form' : 'file';} 245 246 ############################################################################################# 247 # Get inputs 248 ############################################################################################# 249 my($from, $replyTo, $r_text, $subject); 250 if ($input_source eq 'file') { 251 252 ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file"); 253 254 255 } elsif ($input_source eq 'form') { 256 # read info from the form 257 # bail if there is no message body 258 259 $from = $r->param('from'); 260 $replyTo = $r->param('replyTo'); 261 $subject = $r->param('subject'); 262 my $body = $r->param('body'); 263 # Sanity check: body must contain non-white space 264 $self->addbadmessage(CGI::p('You didn\'t enter any message.')) unless ($r->param('body') =~ /\S/); 265 $r_text = \$body; 266 267 } 268 # store data 269 $self->{from} = $from; 270 $self->{replyTo} = $replyTo; 271 $self->{subject} = $subject; 272 $self->{r_text} = $r_text; 273 274 275 276 ################################################################################### 277 #Determine the appropriate script action from the buttons 278 ################################################################################### 279 # first time actions 280 # open new file 281 # open default file 282 # choose merge file actions 283 # chose merge button 284 # option actions 285 # 'reset rows' 286 287 # save actions 288 # "save" button 289 # "save as" button 290 # "save as default" button 291 # preview actions 292 # 'preview' button 293 # email actions 294 # 'entire class' 295 # 'selected studentIDs' 296 # error actions (various) 297 298 299 ############################################################################################# 300 # if no form is submitted, gather data needed to produce the mail form and return 301 ############################################################################################# 302 my $to = $r->param('To'); 303 my $script_action = ''; 304 305 306 if(not defined($action) or $action eq 'Open' or $action eq $REFRESH_RESIZE_BUTTON or $action eq 'Sort by' 307 or $action eq 'Set merge file to:' ){ 308 309 return ''; 310 } 311 312 313 314 315 316 ############################################################################################# 317 # If form is submitted deal with filled out forms 318 # and various actions resulting from different buttons 319 ############################################################################################# 320 321 322 if ($action eq 'Save' or $action eq 'Save as:' or $action eq 'Save as Default') { 323 324 # warn "FIXME Saving files action = $action outputFileName=$output_file"; 325 326 ################################################################# 327 # construct message body 328 ################################################################# 329 my $temp_body = ${ $r_text }; 330 $temp_body =~ s/\r\n/\n/g; 331 $temp_body = join("", 332 "From: $from \nReply-To: $replyTo\n" , 333 "Subject: $subject\n" , 334 "Message: \n $temp_body"); 335 # warn "FIXME from $from | subject $subject |reply $replyTo|msg $temp_body"; 336 ################################################################# 337 # overwrite protection 338 ################################################################# 339 if ($action eq 'Save as:' and -e "$emailDirectory/$output_file") { 340 $self->addbadmessage(CGI::p("The file $emailDirectory/$output_file already exists and cannot be overwritten", 341 "The message was not saved")); 342 return; 343 } 344 345 ################################################################# 346 # Back up existing file? 347 ################################################################# 348 if ($action eq 'Save as Default' and -e "$emailDirectory/$default_msg_file") { 349 rename("$emailDirectory/$default_msg_file","$emailDirectory/$old_default_msg_file") or 350 die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ", 351 "Check permissions for webserver on directory $emailDirectory. $!"; 352 $self->addgoodmessage(CGI::p("Backup file <code>$emailDirectory/$old_default_msg_file</code> created." . CGI::br())); 353 } 354 ################################################################# 355 # Save the message 356 ################################################################# 357 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ) unless ($output_file =~ /^[~.]/ || $output_file =~ /\.\./ || not $output_file =~ m|\.msg$|); 358 unless ( $self->{submit_message} or not -w "${emailDirectory}/$output_file" ) { # if there are no errors report success 359 $self->addgoodmessage(CGI::p("Message saved to file <code>${emailDirectory}/$output_file</code>.")); 360 } 361 362 } elsif ($action eq 'Preview message') { 363 $self->{response} = 'preview'; 364 365 } elsif ($action eq 'Send Email') { 366 $self->{response} = 'send_email'; 367 368 my @recipients = @{$self->{ra_send_to}}; 369 $self->addbadmessage(CGI::p("No recipients selected ")) unless @recipients; 370 # get merge file 371 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 372 my $delimiter = ','; 373 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 374 unless (ref($rh_merge_data) ) { 375 $self->addbadmessage(CGI::p("No merge data file")); 376 $self->addbadmessage(CGI::p("Can't read merge file $merge_file. No message sent")); 377 return; 378 } ; 379 380 381 foreach my $recipient (@recipients) { 382 #warn "FIXME sending email to $recipient"; 383 my $ur = $self->{db}->getUser($recipient); #checked 384 die "record for user $recipient not found" unless $ur; 385 unless ($ur->email_address) { 386 $self->addbadmessage(CGI::p("user $recipient does not have an email address -- skipping")); 387 next; 388 } 389 my ($msg, $preview_header); 390 eval{ ($msg,$preview_header) = $self->process_message($ur,$rh_merge_data); }; 391 $self->addbadmessage(CGI::p("There were errors in processing user $ur, merge file $merge_file. $@")) if $@; 392 my $mailer = Mail::Sender->new({ 393 from => $from, 394 to => $ur->email_address, 395 smtp => $ce->{mail}->{smtpServer}, 396 subject => $subject, 397 headers => "X-Remote-Host: ".$r->get_remote_host(), 398 }); 399 unless (ref $mailer) { 400 $self->addbadmessage(CGI::p("Failed to create a mailer for user $recipient: $Mail::Sender::Error")); 401 next; 402 } 403 unless (ref $mailer->Open()) { 404 $self->addbadmessage(CGI::p("Failed to open the mailer for user $recipient: $Mail::Sender::Error")); 405 next; 406 } 407 my $MAIL = $mailer->GetHandle() or $self->addbadmessage(CGI::p("Couldn't get handle")); 408 print $MAIL $msg || $self->addbadmessage(CGI::p("Couldn't print to $MAIL")); 409 close $MAIL || $self->addbadmessage(CGI::p("Couldn't close $MAIL")); 410 #warn "FIXME mailed to ", $ur->email_address, "from $from subject $subject"; 411 412 } 413 414 } else { 415 $self->addbadmessage(CGI::p("Didn't recognize button $action")); 416 } 417 418 419 420 } #end initialize 421 422 423 424 425 426 sub body { 427 my ($self) = @_; 428 my $r = $self->r; 429 my $urlpath = $r->urlpath; 430 my $authz = $r->authz; 431 my $setID = $urlpath->arg("setID"); 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 442 if ($response eq 'preview') { 443 $self->print_preview($setID); 444 } elsif (($response eq 'send_email')){ 445 $self->addgoodmessage(CGI::p("Email sent to ". scalar(@{$self->{ra_send_to}})." students.")); 446 $self->{message} .= CGI::i("Email sent to ". scalar(@{$self->{ra_send_to}})." students."); 447 $self->print_form($setID); 448 } else { 449 $self->print_form($setID); 450 } 451 452 } 453 sub print_preview { 454 my ($self) = @_; 455 my $r = $self->r; 456 my $urlpath = $r->urlpath; 457 my $setID = $urlpath->arg("setID"); 458 459 # get preview user 460 my $ur = $r->db->getUser($self->{preview_user}); #checked 461 die "record for preview user ".$self->{preview_user}. " not found." unless $ur; 462 463 # get merge file 464 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 465 my $delimiter = ','; 466 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 467 468 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data); 469 470 my $recipients = join(" ",@{$self->{ra_send_to} }); 471 my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ; 472 $msg = join("", 473 $errorMessage, 474 $preview_header, 475 "To: " , $ur->email_address,"\n", 476 "From: " , $self->{from} , "\n" , 477 "Reply-To: " , $self->{replyTo} , "\n" , 478 "Subject: " , $self->{subject} , "\n" ,"\n" , 479 $msg , "\n" 480 ); 481 482 return join("", '<pre>',$msg,"\n","\n", 483 '</pre>', 484 CGI::p('Use browser back button to return from preview mode'), 485 CGI::h3('Emails to be sent to the following:'), 486 $recipients, "\n", 487 488 ); 489 490 } 491 sub print_form { 492 my ($self) = @_; 493 my $r = $self->r; 494 my $urlpath = $r->urlpath; 495 my $authz = $r->authz; 496 my $db = $r->db; 497 my $ce = $r->ce; 498 my $courseName = $urlpath->arg("courseID"); 499 my $setID = $urlpath->arg("setID"); 500 my $user = $r->param('user'); 501 502 my $root = $ce->{webworkURLs}->{root}; 503 my $sendMailPage = $urlpath->newFromModule($urlpath->module,courseID=>$courseName); 504 my $sendMailURL = $self->systemLink($sendMailPage, authen => 0); 505 506 return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); 507 508 my $userTemplate = $db->newUser; 509 my $permissionLevelTemplate = $db->newPermissionLevel; 510 511 # This code will require changing if the permission and user tables ever have different keys. 512 my @users = @{ $self->{ra_users} }; 513 my $ra_user_records = $self->{ra_user_records}; 514 my %classlistLabels = ();# %$hr_classlistLabels; 515 foreach my $ur (@{ $ra_user_records }) { 516 $classlistLabels{$ur->user_id} = $ur->user_id.': '.$ur->last_name. ', '. $ur->first_name.' -- '.$ur->section." / ".$ur->recitation; 517 } 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}); 529 530 ############################################################################################################## 531 532 533 my $from = $self->{from}; 534 my $subject = $self->{subject}; 535 my $replyTo = $self->{replyTo}; 536 my $columns = $self->{columns}; 537 my $rows = $self->{rows}; 538 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 'FIXME no text was produced by initialization!!'; 539 my $input_file = $self->{input_file}; 540 my $output_file = $self->{output_file}; 541 my @sorted_messages = $self->get_message_file_names; 542 my @sorted_merge_files = $self->get_merge_file_names; 543 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 544 my $delimiter = ','; 545 my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); 546 my @merge_keys = keys %$rh_merge_data; 547 my $preview_user = $self->{preview_user}; 548 my $preview_record = $db->getUser($preview_user); # checked 549 die "record for preview user ".$self->{preview_user}. " not found." unless $preview_record; 550 551 552 ############################################################################################# 553 554 print CGI::start_form({method=>"post", action=>$sendMailURL}); 555 print $self->hidden_authen_fields(); 556 ############################################################################################# 557 # begin upper table 558 ############################################################################################# 559 560 print CGI::start_table({-border=>'2', -cellpadding=>'4'}); 561 print CGI::Tr({-align=>'left',-valign=>'top'}, 562 ############################################################################################# 563 # first column 564 ############################################################################################# 565 566 CGI::td(CGI::strong("Message file: $input_file"),"\n",CGI::br(), 567 CGI::submit(-name=>'action', -value=>'Open'), ' ',"\n", 568 CGI::popup_menu(-name=>'openfilename', 569 -values=>\@sorted_messages, 570 -default=>$input_file 571 ), "\n",CGI::br(), 572 573 "Save file to: $output_file","\n",CGI::br(), 574 "\n", 'From:',' ', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1), 575 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1), 576 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>30, -override=>1), 577 ), 578 ############################################################################################# 579 # second column 580 ############################################################################################# 581 # CGI::td({-align=>'left',style=>'font-size:smaller'}, 582 # 583 # CGI::strong("Send to:"), 584 # CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], 585 # -labels=>{all_students=>'All students in course',studentID => 'Selected'}, 586 # -default=>'studentID', 587 # -linebreak=>0 588 # ), CGI::br(),CGI::br(), 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 # 599 # CGI::input({type=>'submit',value=>'Sort by',name=>'action'}),, 600 # CGI::radio_group(-name=>'sort_by', -values=>['id','alphabetical','section','recitation'], 601 # -labels=>{id=>'Login',alphabetical=>'Alph.',section => 'Sec.',recitation=>'Rec.'}, 602 # -default=>defined($r->param("sort_by")) ? $r->param("sort_by") : 'id', 603 # -linebreak=>0 604 # ), 605 # 606 # CGI::br(),CGI::br(), 607 # CGI::popup_menu(-name=>'classList', 608 # -values=>\@users, 609 # -labels=>\%classlistLabels, 610 # -size => 10, 611 # -multiple => 1, 612 # -default=>$user 613 # ), 614 # ), 615 616 617 618 619 ############################################################################################# 620 # third column 621 ############################################################################################# 622 CGI::td({align=>'left'}, 623 "<b>Merge file:</b> $merge_file", CGI::br(), 624 CGI::submit(-name=>'action', -value=>'Set merge file to:'),CGI::br(), 625 CGI::popup_menu(-name=>'merge_file', 626 -values=>\@sorted_merge_files, 627 -default=>$merge_file, 628 ), "\n",CGI::hr(), 629 CGI::b("Viewing email for: "), "$preview_user",CGI::br(), 630 CGI::submit(-name=>'action', -value=>'resize', -label=>$REFRESH_RESIZE_BUTTON),' ', 631 CGI::popup_menu(-name=>'preview_user', 632 -values=>\@users, 633 #-labels=>\%classlistLabels, 634 -default=>$preview_user, 635 ), 636 CGI::br(), 637 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview message'),' ', 638 639 CGI::br(), 640 641 CGI::hr(), 642 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), 643 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), 644 CGI::br(),CGI::i('Press any action button to update display'),CGI::br(), 645 #show available macros 646 CGI::popup_menu( 647 -name=>'dummyName', 648 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'], 649 -labels=>{''=>'list of insertable macros', 650 '$SID'=>'$SID - Student ID', 651 '$FN'=>'$FN - First name', 652 '$LN'=>'$LN - Last name', 653 '$SECTION'=>'$SECTION', 654 '$RECITATION'=>'$RECITATION', 655 '$STATUS'=>'$STATUS - C, Audit, Drop, etc.', 656 '$EMAIL'=>'$EMAIL - Email address', 657 '$LOGIN'=>'$LOGIN - Login', 658 '$COL[3]'=>'$COL[3] - 3rd col', 659 '$COL[-1]'=>'$COL[-1] - Last column' 660 } 661 ), "\n", 662 ), 663 664 ); # end Tr 665 print CGI::end_table(); 666 ############################################################################################# 667 # end upper table 668 ############################################################################################# 669 670 # show merge file 671 # print "<pre>",(map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} 0..8),"</pre>"; 672 # print CGI::popup_menu( 673 # -name=>'dummyName2', 674 # -values=>\@merge_keys, 675 # -labels=>$rh_merge_data, 676 # -multiple=>1, 677 # -size =>2, 678 # 679 # ), "\n",CGI::br(); 680 # warn "merge keys ", join( " ",@merge_keys); 681 ############################################################################################# 682 # merge file fragment and message text area field 683 ############################################################################################# 684 my @tmp2; 685 eval{ @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } };}; # checked 686 if ($@ and $merge_file ne 'None') { 687 print "No merge data for $preview_user in merge file: <$merge_file>",CGI::br(); 688 } else { 689 print CGI::pre("",data_format(1..($#tmp2+1)),"<br>", data_format2(@tmp2)); 690 } 691 #create a textbox with the subject and a textarea with the message 692 #print actual body of message 693 694 print "\n", CGI::p( $self->{message}) if defined($self->{message}); 695 print "\n", CGI::p( CGI::textarea(-name=>'body', -default=>$text, -rows=>$rows, -columns=>$columns, -override=>1)); 696 697 ############################################################################################# 698 # action button table 699 ############################################################################################# 700 print CGI::table( { -border=>2,-cellpadding=>4}, 701 CGI::Tr( 702 CGI::td( CGI::submit(-name=>'action', -value=>'Send Email') ), "\n", 703 CGI::td(CGI::submit(-name=>'action', -value=>'Save')," to $output_file"), " \n", 704 CGI::td(CGI::submit(-name=>'action', -value=>'Save as:'), 705 CGI::textfield(-name=>'savefilename', -size => 20, -value=> "$output_file", -override=>1) 706 ), "\n", 707 CGI::td(CGI::submit(-name=>'action', -value=>'Save as Default')), 708 ) 709 ); 710 711 ############################################################################################################## 712 713 print CGI::end_form(); 714 return ""; 715 } 716 717 ############################################################################## 718 # Utility methods 719 ############################################################################## 720 sub submission_error { 721 my $self = shift; 722 my $msg = join( " ", @_); 723 $self->{submitError} .= CGI::br().$msg; 724 return; 725 } 726 727 sub saveProblem { 728 my $self = shift; 729 my ($body, $probFileName)= @_; 730 local(*PROBLEM); 731 open (PROBLEM, ">$probFileName") || 732 $self->addbadmessage(CGI::p("Could not open $probFileName for writing. 733 Check that the permissions for this problem are 660 (-rw-rw----)")); 734 print PROBLEM $body if -w $probFileName; 735 close PROBLEM; 736 chmod 0660, "$probFileName" || 737 $self->addbadmessage(CGI::p("CAN'T CHANGE PERMISSIONS ON FILE $probFileName")); 738 } 739 740 sub read_input_file { 741 my $self = shift; 742 my $filePath = shift; 743 my ($text, @text); 744 my $header = ''; 745 my ($subject, $from, $replyTo); 746 local(*FILE); 747 if (-e "$filePath" and -r "$filePath") { 748 open FILE, "$filePath" || do { $self->addbadmessage(CGI::p("Can't open $filePath")); return}; 749 while ($header !~ s/Message:\s*$//m and not eof(FILE)) { 750 $header .= <FILE>; 751 } 752 $text = join( '', <FILE>); 753 $text =~ s/^\s*//; # remove initial white space if any. 754 $header =~ /^From:\s(.*)$/m; 755 $from = $1 or $from = $self->{defaultFrom}; 756 757 $header =~ /^Reply-To:\s(.*)$/m; 758 $replyTo = $1 or $replyTo = $self->{defaultReply}; 759 760 $header =~ /^Subject:\s(.*)$/m; 761 $subject = $1; 762 763 } else { 764 $from = $self->{defaultFrom}; 765 $replyTo = $self->{defaultReply}; 766 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist"; 767 $subject = $self->{defaultSubject}; 768 } 769 return ($from, $replyTo, $subject, \$text); 770 } 771 772 773 sub get_message_file_names { 774 my $self = shift; 775 return $self->read_dir($self->{ce}->{courseDirs}->{email}, '\\.msg$'); 776 } 777 sub get_merge_file_names { 778 my $self = shift; 779 return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed. 780 } 781 782 783 sub getRecord { 784 my $self = shift; 785 my $line = shift; 786 my $delimiter = shift; 787 $delimiter = ',' unless defined($delimiter); 788 789 # Takes a delimited line as a parameter and returns an 790 # array. Note that all white space is removed. If the 791 # last field is empty, the last element of the returned 792 # array is also empty (unlike what the perl split command 793 # would return). E.G. @lineArray=&getRecord(\$delimitedLine). 794 795 my(@lineArray); 796 $line.="${delimiter}___"; # add final field which must be non-empty 797 @lineArray = split(/\s*${delimiter}\s*/,$line); # split line into fields 798 $lineArray[0] =~s/^\s*//; # remove white space from first element 799 pop @lineArray; # remove the last artificial field 800 @lineArray; 801 } 802 803 sub process_message { 804 my $self = shift; 805 my $ur = shift; 806 my $rh_merge_data = shift; 807 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 808 'FIXME no text was produced by initialization!!'; 809 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 810 #user macros that can be used in the email message 811 my $SID = $ur->student_id; 812 my $FN = $ur->first_name; 813 my $LN = $ur->last_name; 814 my $SECTION = $ur->section; 815 my $RECITATION = $ur->recitation; 816 my $STATUS = $ur->status; 817 my $EMAIL = $ur->email_address; 818 my $LOGIN = $ur->user_id; 819 820 # get record from merge file 821 # FIXME this is inefficient. The info should be cached 822 my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); 823 if ($merge_file ne 'None' && not defined($rh_merge_data->{$SID}) ) { 824 $self->addbadmessage(CGI::p("No merge data for student id:$SID; name:$FN $LN; login:$LOGIN")); 825 } 826 unshift(@COL,""); ## this makes COL[1] the first column 827 my $endCol = @COL; 828 # for safety, only evaluate special variables 829 my $msg = $text; 830 $msg =~ s/(\$SID)/eval($1)/ge; 831 $msg =~ s/(\$LN)/eval($1)/ge; 832 $msg =~ s/(\$FN)/eval($1)/ge; 833 $msg =~ s/(\$STATUS)/eval($1)/ge; 834 $msg =~ s/(\$SECTION)/eval($1)/ge; 835 $msg =~ s/(\$RECITATION)/eval($1)/ge; 836 $msg =~ s/(\$EMAIL)/eval($1)/ge; 837 $msg =~ s/(\$LOGIN)/eval($1)/ge; 838 # $msg =~ s/\$COL\[ *-/\$COL\[$endCol-/g; ## Perl handles negative indexes correctly, so there is no need to do this 839 $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1]/ge if defined($COL[1]); # prevents extraneous error messages. 840 841 $msg =~ s/\r//g; 842 843 my @preview_COL = @COL; 844 shift @preview_COL; ## shift back for preview 845 my $preview_header = CGI::pre("",data_format(1..($#COL)),"<br>", data_format2(@preview_COL)). 846 CGI::h3( "This sample mail would be sent to $EMAIL"); 847 848 return $msg, $preview_header; 849 } 850 851 852 # Ê sub data_format { 853 # 854 # Ê Ê Ê Ê Êmap {$_ =~s/\s/\./g;$_} Ê Ê map {sprintf('%-8.8s',$_);} Ê@_; 855 sub data_format { 856 map {"COL[$_]".' 'x(3-length($_));} @_; # problems if $_ has length bigger than 4 857 } 858 sub data_format2 { 859 map {$_ =~s/\s/ /g;$_} map {sprintf('%-8.8s',$_);} @_; 860 } 861 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |