Parent Directory
| 
Revision Log
Preview now works fairly well. Only the actual send mail action needs to be implemented Followed by bug fixes and assignments. --Mike
1 package WeBWorK::ContentGenerator::Instructor::SendMail; 2 use base qw(WeBWorK::ContentGenerator::Instructor); 3 4 =head1 NAME 5 6 WeBWorK::ContentGenerator::Instructor::SendMail - Entry point for User-specific data editing 7 8 =cut 9 10 use strict; 11 use warnings; 12 use CGI qw(); 13 use HTML::Entities; 14 15 sub initialize { 16 my ($self) = @_; 17 my $r = $self->{r}; 18 my $db = $self->{db}; 19 my $ce = $self->{ce}; 20 my $authz = $self->{authz}; 21 my $user = $r->param('user'); 22 23 unless ($authz->hasPermissions($user, "send_mail")) { 24 $self->{submitError} = "You are not authorized to send mail to students."; 25 return; 26 } 27 ############################################################################################# 28 # gather directory data 29 ############################################################################################# 30 my $emailDirectory = $ce->{courseDirs}->{email}; 31 my $scoringDirectory = $ce->{courseDirs}->{scoring}; 32 my $templateDirectory = $ce->{courseDirs}->{templates}; 33 34 my $action = $r->param('action'); 35 my $openfilename = $r->param('openfilename'); 36 my $savefilename = $r->param('savefilename'); 37 38 39 #FIXME get these values from global course environment (see subroutines as well) 40 my $default_msg_file = 'default.msg'; 41 my $old_default_msg_file = 'old_default.msg'; 42 43 44 # store data 45 $self->{defaultFrom} = 'FIXME from'; 46 $self->{defaultReply} = 'FIXME reply'; 47 $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows}; 48 $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns}; 49 $self->{default_msg_file} = $default_msg_file; 50 $self->{old_default_msg_file} = $old_default_msg_file; 51 $self->{merge_file} = (defined($r->param('merge_file' ))) ? $r->param('merge_file') : 'None'; 52 $self->{preview_user} = (defined($r->param('preview_user'))) ? $r->param('preview_user') : 'Yourself'; 53 54 55 ############################################################################################# 56 # gather database data 57 ############################################################################################# 58 # FIXME this might be better done in body? We don't always need all of this data. or do we? 59 my @users = sort $db->listUsers; 60 my @user_records = (); 61 push(@user_records,$db->getUser($_)) foreach (@users); 62 63 # store data 64 $self->{ra_users} = \@users; 65 $self->{ra_user_records} = \@user_records; 66 67 ############################################################################################# 68 # gather list of recipients 69 ############################################################################################# 70 my @send_to = (); 71 #FIXME this (radio) is a lousy name 72 my $recipients = $r->param('radio'); 73 if ($recipients eq 'all_students') { #only active students #FIXME status check?? 74 foreach my $ur (@user_records) { 75 push(@send_to,$ur->user_id) if $ur->status eq 'C' and not($ur->user_id =~ /practice/); 76 } 77 } elsif ($recipients eq 'studentID' ) { 78 @send_to = $r->param('classList'); 79 } else { 80 warn "Don't understand recipient list |$recipients|"; 81 } 82 $self->{ra_send_to} = \@send_to; 83 ################################################################# 84 # Check the validity of the input file name 85 ################################################################# 86 my $input_file = ''; 87 #make sure an input message file was submitted and exists 88 #else use the default message 89 if ( defined($openfilename) ) { 90 if ( -e "${emailDirectory}/$openfilename") { 91 if ( -R "${emailDirectory}/$openfilename") { 92 $input_file = $openfilename; 93 } else { 94 warn join("", 95 "The file ${emailDirectory}/$openfilename is not readable by the webserver.",CGI::br(), 96 "Check that it's permissions are set correctly.", 97 ); 98 } 99 } else { 100 $input_file = $default_msg_file; 101 warn join("", 102 "The file ${emailDirectory}/$openfilename cannot be found.",CGI::br(), 103 "Check whether it exists and whether the directory $emailDirectory can be read by the webserver.",CGI::br(), 104 "Using contents of the default message $default_msg_file instead.", 105 ); 106 } 107 } else { 108 $input_file = $default_msg_file; 109 } 110 $self->{input_file} =$input_file; 111 112 ################################################################# 113 # Determine the file name to save message into 114 ################################################################# 115 my $output_file = 'FIXME no output file specified'; 116 if (defined($action) and $action eq 'Save as Default') { 117 $output_file = $default_msg_file; 118 } elsif ( defined($action) and ($action =~/save/i) and defined($savefilename) ){ 119 $output_file = $savefilename; 120 } elsif ( defined($input_file) ) { 121 $output_file = $input_file; 122 } 123 # warn "FIXME savefilename $savefilename output file $output_file"; 124 ################################################################# 125 # Sanity check on save file name 126 ################################################################# 127 128 if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) { 129 $self->submission_error("For security reasons, you cannot specify a merge file from a directory", 130 "higher than the email directory (you can't use ../blah/blah). ", 131 "Please specify a different file or move the needed file to the email directory", 132 ); 133 } 134 unless ($output_file =~ m|\.msg$| ) { 135 $self->submission_error("Invalid file name.", 136 "The file name \"$output_file\" does not have a \".msg\" extension", 137 "All email file names must end in the extension \".msg\"", 138 "choose a file name with a \".msg\" extension.", 139 "The message was not saved.", 140 ); 141 } 142 $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing. 143 # FIXME $output_file can be blank if there was no savefilename 144 145 ############################################################################################# 146 # Determine input source 147 ############################################################################################# 148 my $input_source = ( defined( $r->param('body') ) and $action ne 'Open' ) ? 'form' : 'file'; 149 # warn "FIXME input source is $input_source from $input_file"; 150 ############################################################################################# 151 # Get inputs 152 ############################################################################################# 153 my($from, $replyTo, $r_text, $subject); 154 if ($input_source eq 'file') { 155 # warn "FIXME obtaining source from $emailDirectory/$input_file"; 156 ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file"); 157 # warn "FIXME Done reading source"; 158 159 } elsif ($input_source eq 'form') { 160 # read info from the form 161 # bail if there is no message body 162 163 $from = $r->param('from'); 164 $replyTo = $r->param('replyTo'); 165 $subject = $r->param('subject'); 166 my $body = $r->param('body'); 167 # Sanity check: body must contain non-white space 168 $self->submission_error('You didn\'t enter any message.') unless ($r->param('body') =~ /\S/); 169 $r_text = \$body; 170 171 } 172 # store data 173 $self->{from} = $from; 174 $self->{replyTo} = $replyTo; 175 $self->{subject} = $subject; 176 $self->{r_text} = $r_text; 177 178 179 180 ################################################################################### 181 #Determine the appropriate script action from the buttons 182 ################################################################################### 183 # first time actions 184 # open new file 185 # open default file 186 # choose merge file actions 187 # chose merge button 188 # option actions 189 # 'reset rows' 190 191 # save actions 192 # "save" button 193 # "save as" button 194 # "save as default" button 195 # preview actions 196 # 'preview' button 197 # email actions 198 # 'entire class' 199 # 'selected studentIDs' 200 # error actions (various) 201 202 203 ############################################################################################# 204 # if no form is submitted, gather data needed to produce the mail form and return 205 ############################################################################################# 206 my $to = $r->param('To'); 207 my $script_action = ''; 208 209 210 if(not defined($action) or $action eq 'Open' or $action eq 'Resize message window' 211 or $action eq 'Choose merge file' ){ 212 # warn "FIXME action is |$action| no further initialization required"; 213 return ''; 214 } 215 216 217 218 219 220 ############################################################################################# 221 # If form is submitted deal with filled out forms 222 # and various actions resulting from different buttons 223 ############################################################################################# 224 225 226 227 # user_errors 228 # save 229 # save as 230 # save as default 231 # send mail 232 # set defaults 233 234 if ($action eq 'Save' or $action eq 'Save as:' or $action eq 'Save as Default') { 235 236 # warn "FIXME Saving files action = $action outputFileName=$output_file"; 237 238 ################################################################# 239 # construct message body 240 ################################################################# 241 my $temp_body = ${ $r_text }; 242 $temp_body =~ s/\r\n/\n/g; 243 $temp_body = join("", 244 "From: $from \nReply-To: $replyTo\n" , 245 "Subject: $subject\n" , 246 "Message: \n $temp_body"); 247 # warn "FIXME from $from | subject $subject |reply $replyTo|msg $temp_body"; 248 ################################################################# 249 # overwrite protection 250 ################################################################# 251 if ($action eq 'Save as:' and -e "$emailDirectory/$output_file") { 252 $self->submission_error("The file $emailDirectory/$output_file already exists and cannot be overwritten", 253 "The message was not saved"); 254 return; 255 } 256 257 ################################################################# 258 # Back up existing file? 259 ################################################################# 260 if ($action eq 'Save as Default' and -e "$emailDirectory/$default_msg_file") { 261 rename("$emailDirectory/$default_msg_file","$emailDirectory/$old_default_msg_file") or 262 die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ", 263 "Check permissions for webserver on directory $emailDirectory. $!"; 264 $self->{message} .= "Backup file <code>$emailDirectory/$old_default_msg_file</code> created.".CGI::br(); 265 } 266 ################################################################# 267 # Save the message 268 ################################################################# 269 $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ); 270 $self->{message} .= "Message saved to file <code>${emailDirectory}/$output_file</code>."; 271 # warn "FIXME saving to ${emailDirectory}/$output_file"; 272 } elsif ($action eq 'Preview') { 273 $self->{response} = 'preview'; 274 275 } elsif ($action eq 'Send Email') { 276 277 278 279 280 } else { 281 warn "Don't recognize button $action"; 282 } 283 284 #if Save button was clicked 285 if (( $r->param('action') eq 'Save') && defined($r->param('body')) && defined($r->param('savefilename'))) { 286 287 288 #if Save As button was clicked 289 } elsif (( $r->param('action') eq 'Save as:') && defined($r->param('body')) && defined($r->param('savefilename'))) { 290 291 292 } elsif (( $r->param('action') eq 'save_as_default') && defined($r->param('body'))) { 293 294 295 } elsif ( $r->param('action') eq 'Send Email' ) { 296 297 my @studentID = (); 298 299 if ($r->param('To') eq 'classList' && defined($r->param('classList')) && $r->param('classList') ne 'None') { 300 # my $classlist = $r->param('classList'); 301 # my $classListFile = "$templateDirectory$classlist"; 302 # my @classList = (); 303 # #FIXME checkClasslistFile($Global::noOfFieldsInClasslist,$classListFile); 304 # open(FILE, "$classListFile") || die "can't open $classListFile"; 305 # @classList=<FILE>; 306 # close(FILE); 307 # 308 # foreach (@classList) { ## read through classlist and send e-mail 309 # ## message to all active students 310 # unless ($_ =~ /\S/) {next;} ## skip blank lines 311 # chomp; 312 # my @classListRecord=&getRecord($_); 313 # my ($studentID, $lastName, $firstName, $status, $comment, $section, $recitation, $email_address, $login_name) 314 # = @classListRecord; 315 # unless (&dropStatus($status)) { 316 # push (@studentID, $studentID); 317 # $fn{$studentID} = $firstName; 318 # $ln{$studentID} = $lastName; 319 # $section{$studentID} = $section; 320 # $recitation{$studentID} = $recitation; 321 # $status{$studentID} = $status; 322 # $email{$studentID} = $email_address; 323 # $login{$studentID} = $login_name; 324 # } 325 # } 326 } elsif ($r->param('To') eq 'studentID' && defined($r->param('studentID'))) { 327 @studentID = $r->param('studentID'); 328 my ($studentID, $login_name); 329 # 330 # foreach $studentID (@studentID) { 331 # $login_name = $studentID_LoginName_Hash{$studentID}; 332 # &attachCLRecord($login_name); 333 # $fn{$studentID} = CL_getStudentFirstName($login_name); 334 # $ln{$studentID} = CL_getStudentLastName($login_name); 335 # $section{$studentID} = CL_getClassSection($login_name); 336 # $recitation{$studentID} = CL_getClassRecitation($login_name); 337 # $status{$studentID} = CL_getStudentStatus($login_name); 338 # $email{$studentID} = CL_getStudentEmailAddress($login_name); 339 # $login{$studentID} = $login_name; 340 # } 341 342 } elsif ($r->param('To') eq 'all_students') { 343 @studentID = (); 344 my ($studentID, $login_name, $status); 345 346 # foreach $login_name (@availableStudents) { 347 # &attachCLRecord($login_name); 348 # $status = CL_getStudentStatus($login_name); 349 # next if &dropStatus($status); 350 # $studentID = CL_getStudentID($login_name); 351 # push(@studentID,$studentID); 352 # 353 # $fn{$studentID} = CL_getStudentFirstName($login_name); 354 # $ln{$studentID} = CL_getStudentLastName($login_name); 355 # $section{$studentID} = CL_getClassSection($login_name); 356 # $recitation{$studentID} = CL_getClassRecitation($login_name); 357 # $status{$studentID} = CL_getStudentStatus($login_name); 358 # $email{$studentID} = CL_getStudentEmailAddress($login_name); 359 # $login{$studentID} = $login_name; 360 # } 361 } else { 362 $self->submission_error('You didn\'t select any recipients. Make sure you select either all student in the course, individual students or a whole classlist.'); 363 } 364 365 # my $mergeFile = ''; 366 # 367 # #the radio button named 'merge' determines whether to take the selected mergefile 368 # #or one that was typed in. A error message is given if select one and use the other 369 # $mergeFile = $scoringDirectory . $r->param('mergeFiles') 370 # if ($r->param('merge') eq 'mergeFiles' && defined($r->param('mergeFiles')) && $r->param('mergeFiles') ne 'None'); 371 # 372 # $mergeFile = $templateDirectory . $r->param('mergeFile') 373 # if ($r->param('merge') eq 'mergeFile' && defined($r->param('mergeFile')) && $r->param('mergeFile') !~ m|/$|); #does not end in a / 374 # 375 # if ($mergeFile =~ /^[~.]/ || $mergeFile =~ /\.\./) { 376 # $self->submission_error("For security reasons, you cannot specify a merge file from a directory higher than the email directory. Please specify a different file or move the needed file to the email directory"); 377 # } 378 # if ($r->param('body') =~ /(\$COL\[.*?\])/ && !(-e $mergeFile)) { 379 # $self->submission_error("In order to use the \$COL[] you must specify a merge file. The file you specified does not exist. Also, make sure you selected the right checkbox."); 380 # } 381 # 382 383 my %mergeAArray = (); 384 # unless ($mergeFile eq '') {%mergeAArray = &delim2aa($mergeFile);} 385 # 386 387 # 388 # foreach my $studentID (@studentID) { 389 # @COL =(); 390 # $SID = $studentID; 391 # $LN = defined $ln{$studentID} ? $ln{$studentID} :''; 392 # $FN = defined $fn{$studentID} ? $fn{$studentID} :''; 393 # $SECTION = defined $section{$studentID} ? $section{$studentID} :''; 394 # $RECITATION = defined $recitation{$studentID} ? $recitation{$studentID} :''; 395 # $EMAIL = defined $email{$studentID} ? $email{$studentID} :''; 396 # $STATUS =defined $status{$studentID} ? $status{$studentID} :''; 397 # $LOGIN = $login{$studentID}; 398 # 399 # next if ($LOGIN =~ /^$practiceUser/); ## skip practice users 400 # 401 # if ($timeout_attempts >= $max_timeout_attempts) { ## have attemped to connect to smtp server 402 # ## the max allowed times. Now just collect 403 # ## data on emails not sent and exit 404 # ++$emails_not_sent; 405 # &log_error(\@exceeded_max_timeout,$FN,$LN,$EMAIL); 406 # next; 407 # } 408 # 409 # unless ((defined $mergeAArray{$studentID}) or ($mergeFile eq '')) { 410 # if ($cgi->param('no_record')) { 411 # ++$emails_not_sent; 412 # &log_error(\@no_record,$FN,$LN,$EMAIL); 413 # next; 414 # } 415 # } 416 417 # my ($dbString, @dbArray); 418 # if (defined $mergeAArray{$SID}) { 419 # $dbString = $mergeAArray{$SID}; ## get sid record from merge file 420 # @dbArray = &getRecord($dbString); 421 # unshift(@dbArray,$SID); 422 # unshift(@dbArray,""); ## note COL[1] is the first column 423 # @COL= @dbArray; ## put merge fields in COL array 424 # $endCol = @COL; ## \endCol-1 gives last field, etc 425 # } 426 # my $smtp; 427 # if ($smtp = Net::SMTP->new($Global::smtpServer, Timeout => $timeout_sec)) {} else { 428 # # &internal_error("Couldn't contact SMTP server."); 429 # ++$emails_not_sent; 430 # &log_error(\@timeout_problem,$FN,$LN,$EMAIL); 431 # ++$timeout_attempts; 432 # next; 433 # } 434 # 435 # $smtp->mail($smtpSender); 436 # 437 # if ( $smtp->recipient($EMAIL)) { # this one's okay, keep going 438 # if ( $smtp->data("To: $EMAIL\n" . output() ) ) { 439 # ++$emails_sent; 440 # } else { 441 # ++$emails_not_sent; 442 # &log_error(\@unknown_problem,$FN,$LN,$EMAIL); 443 # next; 444 # } 445 # # &internal_error("Unknown problem sending message data to SMTP server."); 446 # } else { # we have a problem with this address 447 # $smtp->reset; 448 # #&internal_error("SMTP server doesn't like this address: <$EMAIL>."); 449 # ++$emails_not_sent; 450 # &log_error(\@bad_email_addresses,$FN,$LN,$EMAIL); 451 # } 452 # $smtp->quit; 453 # } 454 # &success; 455 } 456 457 458 459 460 } #end initialize 461 462 # sub fieldEditHTML { 463 # my ($self, $fieldName, $value, $properties) = @_; 464 # my $size = $properties->{size}; 465 # my $type = $properties->{type}; 466 # my $access = $properties->{access}; 467 # my $items = $properties->{items}; 468 # my $synonyms = $properties->{synonyms}; 469 # 470 # 471 # if ($access eq "readonly") { 472 # return $value; 473 # } 474 # if ($type eq "number" or $type eq "text") { 475 # return CGI::input({type=>"text", name=>$fieldName, value=>$value, size=>$size}); 476 # } 477 # if ($type eq "enumerable") { 478 # my $matched = undef; # Whether a synonym match has occurred 479 # 480 # # Process synonyms for enumerable objects 481 # foreach my $synonym (keys %$synonyms) { 482 # if ($synonym ne "*" and $value =~ m/$synonym/) { 483 # $value = $synonyms->{$synonym}; 484 # $matched = 1; 485 # } 486 # } 487 # if (!$matched and exists $synonyms->{"*"}) { 488 # $value = $synonyms->{"*"}; 489 # } 490 # return CGI::popup_menu({ 491 # name => $fieldName, 492 # values => [keys %$items], 493 # default => $value, 494 # labels => $items, 495 # }); 496 # } 497 # } 498 499 sub title { 500 my $self = shift; 501 return 'Send mail to ' .$self->{ce}->{courseName}; 502 } 503 504 sub path { 505 my $self = shift; 506 my $args = $_[-1]; 507 508 my $ce = $self->{ce}; 509 my $root = $ce->{webworkURLs}->{root}; 510 my $courseName = $ce->{courseName}; 511 return $self->pathMacro($args, 512 "Home" => "$root", 513 $courseName => "$root/$courseName", 514 'instructor' => "$root/$courseName/instructor", 515 "Send Mail to: $courseName" => '', 516 ); 517 } 518 519 sub body { 520 my ($self, $setID) = @_; 521 my $response = (defined($self->{response}))? $self->{response} : ''; 522 if ($response eq 'preview') { 523 $self->print_preview($setID); 524 } else { 525 $self->print_form($setID); 526 } 527 528 } 529 sub print_preview { 530 my ($self, $setID) = @_; 531 # get preview user 532 my $ur = $self->{db}->getUser($self->{preview_user}); 533 534 # get merge file 535 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 536 my $delimiter = ','; 537 my $rh_merge_data = $self->read_merge_file("$merge_file", "$delimiter"); 538 539 my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data); 540 541 my $recipients = join(" ",@{$self->{ra_send_to} }); 542 543 return join("", '<pre>',$preview_header,$msg,"\n","\n", 544 '</pre>', 545 CGI::p('Use browser back button to return from preview mode'), 546 CGI::h3('Emails to be sent to the following:'), 547 $recipients, "\n", 548 549 ); 550 551 } 552 sub print_form { 553 my ($self, $setID) = @_; 554 my $r = $self->{r}; 555 my $authz = $self->{authz}; 556 my $user = $r->param('user'); 557 my $db = $self->{db}; 558 my $ce = $self->{ce}; 559 my $root = $ce->{webworkURLs}->{root}; 560 my $courseName = $ce->{courseName}; 561 562 return CGI::em("You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); 563 564 my $userTemplate = $db->newUser; 565 my $permissionLevelTemplate = $db->newPermissionLevel; 566 567 # This code will require changing if the permission and user tables ever have different keys. 568 my @users = @{ $self->{ra_users} }; 569 my $ra_user_records = $self->{ra_user_records}; 570 my %classlistLabels = ();# %$hr_classlistLabels; 571 foreach my $ur (@{ $ra_user_records }) { 572 $classlistLabels{$ur->user_id} = $ur->user_id.' '.$ur->last_name. ', '. $ur->first_name.' - '.$ur->section; 573 } 574 575 576 ############################################################################################################## 577 578 579 my $from = $self->{from}; 580 my $subject = $self->{subject}; 581 my $replyTo = $self->{replyTo}; 582 my $columns = $self->{columns}; 583 my $rows = $self->{rows}; 584 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 'FIXME no text was produced by initialization!!'; 585 my $input_file = $self->{input_file}; 586 my $output_file = $self->{output_file}; 587 my @sorted_messages = $self->get_message_file_names; 588 my @sorted_merge_files = $self->get_merge_file_names; 589 my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; 590 my $delimiter = ','; 591 my $rh_merge_data = $self->read_merge_file("$merge_file", "$delimiter"); 592 my @merge_keys = keys %$rh_merge_data; 593 my $preview_user = $self->{preview_user}; 594 my $preview_record = $db->getUser($preview_user); 595 596 ############################################################################################# 597 598 print CGI::start_form({method=>"post", action=>$r->uri()}); 599 print $self->hidden_authen_fields(); 600 ############################################################################################# 601 # begin upper table 602 ############################################################################################# 603 604 print CGI::start_table({-border=>'2', -cellpadding=>'4'}); 605 print CGI::Tr({-align=>'left',-valign=>'VCENTER'}, 606 ############################################################################################# 607 # first column 608 ############################################################################################# 609 610 CGI::td("Message file: $input_file","\n",CGI::br(), 611 CGI::submit(-name=>'action', -value=>'Open'), ' ',"\n", 612 CGI::popup_menu(-name=>'openfilename', 613 -values=>\@sorted_messages, 614 -default=>$input_file 615 ), "\n",CGI::br(), 616 617 "Save file to: $output_file","\n",CGI::br(), 618 "\n", 'From:',' ', CGI::textfield(-name=>"from", -size=>30, -value=>$from, -override=>1), 619 "\n", CGI::br(),'Reply-To: ', CGI::textfield(-name=>"replyTo", -size=>30, -value=>$replyTo, -override=>1), 620 "\n", CGI::br(),'Subject: ', CGI::br(), CGI::textarea(-name=>'subject', -default=>$subject, -rows=>3,-columns=>35, -override=>1), 621 ), 622 ############################################################################################# 623 # second column 624 ############################################################################################# 625 CGI::td({-align=>'left'}, 626 CGI::radio_group(-name=>'radio', -values=>['all_students','studentID'], 627 -labels=>{all_students=>'All active students',studentID => 'Select recipients'}, 628 -default=>'studentID', 629 -linebreak=>1), 630 CGI::br(), 631 CGI::popup_menu(-name=>'classList', 632 -values=>\@users, 633 -labels=>\%classlistLabels, 634 -size => 10, 635 -multiple => 1, 636 -default=>$user 637 ), 638 639 640 ), 641 ############################################################################################# 642 # third column 643 ############################################################################################# 644 CGI::td({align=>'left'}, 645 "Merge file is: $merge_file", CGI::br(), 646 CGI::submit(-name=>'action', -value=>'Choose merge file'),CGI::br(), 647 CGI::popup_menu(-name=>'merge_file', 648 -values=>\@sorted_merge_files, 649 -default=>$merge_file, 650 ), "\n",CGI::hr(),CGI::br(), 651 CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview')," email to ", 652 CGI::popup_menu(-name=>'preview_user', 653 -values=>\@users, 654 #-labels=>\%classlistLabels, 655 -default=>$preview_user, 656 ), 657 CGI::hr(), 658 CGI::submit(-name=>'action', -value=>'resize', -label=>'Resize message window'),CGI::br(), 659 " Rows: ", CGI::textfield(-name=>'rows', -size=>3, -value=>$rows), 660 " Columns: ", CGI::textfield(-name=>'columns', -size=>3, -value=>$columns), 661 CGI::br(),CGI::br(), 662 #show available macros 663 CGI::popup_menu( 664 -name=>'dummyName', 665 -values=>['', '$SID', '$FN', '$LN', '$SECTION', '$RECITATION','$STATUS', '$EMAIL', '$LOGIN', '$COL[3]', '$COL[-1]'], 666 -labels=>{''=>'list of insertable macros', 667 '$SID'=>'$SID - Student ID', 668 '$FN'=>'$FN - First name', 669 '$LN'=>'$LN - Last name', 670 '$SECTION'=>'$SECTION', 671 '$RECITATION'=>'$RECITATION', 672 '$STATUS'=>'$STATUS - C, Audit, Drop, etc.', 673 '$EMAIL'=>'$EMAIL - Email address', 674 '$LOGIN'=>'$LOGIN - Login', 675 '$COL[3]'=>'$COL[3] - 3rd col', 676 '$COL[-1]'=>'$COL[-1] - Last column' 677 } 678 ), "\n", 679 ), 680 681 ); # end Tr 682 print CGI::end_table(); 683 ############################################################################################# 684 # end upper table 685 ############################################################################################# 686 687 # show merge file 688 # print "<pre>",(map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} 0..8),"</pre>"; 689 # print CGI::popup_menu( 690 # -name=>'dummyName2', 691 # -values=>\@merge_keys, 692 # -labels=>$rh_merge_data, 693 # -multiple=>1, 694 # -size =>2, 695 # 696 # ), "\n",CGI::br(); 697 # warn "merge keys ", join( " ",@merge_keys); 698 ############################################################################################# 699 # merge file fragment and message text area field 700 ############################################################################################# 701 702 my @tmp2= @{$rh_merge_data->{ $db->getUser($preview_user)->student_id } }; 703 print CGI::pre("",data_format(0..($#tmp2)),"\n", data_format(@tmp2)); 704 #create a textbox with the subject and a textarea with the message 705 #print actual body of message 706 707 print "\n", CGI::p( $self->{message}) if defined($self->{message}); 708 print "\n", CGI::p( CGI::textarea(-name=>'body', -default=>$text, -rows=>$rows, -columns=>$columns, -override=>1)); 709 710 ############################################################################################# 711 # action button table 712 ############################################################################################# 713 print CGI::table( { -border=>2,-cellpadding=>4}, 714 CGI::Tr( 715 CGI::td( CGI::submit(-name=>'action', -value=>'Send Email') ), "\n", 716 CGI::td(CGI::submit(-name=>'action', -value=>'Save')," to $output_file"), " \n", 717 CGI::td(CGI::submit(-name=>'action', -value=>'Save as:'), 718 CGI::textfield(-name=>'savefilename', -size => 20, -value=> "$output_file", -override=>1) 719 ), "\n", 720 CGI::td(CGI::submit(-name=>'action', -value=>'Save as Default')), 721 ) 722 ); 723 724 ############################################################################################################## 725 726 print CGI::end_form(); 727 return ""; 728 } 729 730 ############################################################################## 731 # Utility methods 732 ############################################################################## 733 sub submission_error { 734 my $self = shift; 735 my $msg = join( " ", @_); 736 $self->{submitError}= $msg; #CGI::b(HTML::Entities::encode($msg)); 737 # qq{Please hit the "<B>Back</B>" button on your browser to 738 # try again, or notify your web master 739 # if you believe this message is in error. 740 # }; 741 return; 742 } 743 744 sub saveProblem { 745 my $self = shift; 746 my ($body, $probFileName)= @_; 747 local(*PROBLEM); 748 open (PROBLEM, ">$probFileName") || 749 $self->submission_error("Could not open $probFileName for writing. 750 Check that the permissions for this problem are 660 (-rw-rw----)"); 751 print PROBLEM $body; 752 close PROBLEM; 753 chmod 0660, "$probFileName" || 754 $self->submission_error(" 755 CAN'T CHANGE PERMISSIONS ON FILE $probFileName"); 756 } 757 758 sub read_input_file { 759 my $self = shift; 760 my $filePath = shift; 761 my ($text, @text); 762 my $header = ''; 763 my ($subject, $from, $replyTo); 764 local(*FILE); 765 if (-e "$filePath" and -r "$filePath") { 766 open FILE, "$filePath" || do { $self->submission_error("Can't open $filePath"); return}; 767 while ($header !~ s/Message:\s*$//m and not eof(FILE)) { 768 $header .= <FILE>; 769 } 770 $text = join( '', <FILE>); 771 $text =~ s/^\s*//; # remove initial white space if any. 772 $header =~ /^From:\s(.*)$/m; 773 $from = $1 or $from = $self->{defaultFrom}; 774 775 $header =~ /^Reply-To:\s(.*)$/m; 776 $replyTo = $1 or $replyTo = $self->{defaultReply}; 777 778 $header =~ /^Subject:\s(.*)$/m; 779 $subject = $1; 780 781 } else { 782 $from = $self->{defaultFrom}; 783 $replyTo = $self->{defaultReply}; 784 $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist"; 785 $subject = "FIXME default subject"; 786 } 787 return ($from, $replyTo, $subject, \$text); 788 } 789 790 sub get_message_file_names { 791 my $self = shift; 792 my $emailDirectory = $self->{ce}->{courseDirs}->{email}; 793 #get all message files and create a list 794 local(*EMAILDIR); 795 opendir( EMAILDIR, $emailDirectory )|| die "Can't access directory $emailDirectory. Please check that webserver has permission to read this directory."; 796 my @messageFiles = grep /\.msg$/, readdir EMAILDIR; #all message files 797 closedir EMAILDIR; 798 799 return sort @messageFiles; 800 } 801 sub get_merge_file_names { 802 my $self = shift; 803 my $scoringDirectory = $self->{ce}->{courseDirs}->{scoring}; 804 #get all message files and create a list 805 local(*SCORINGDIR); 806 opendir( SCORINGDIR, $scoringDirectory )|| die "Can't access directory $scoringDirectory.", 807 "Please check that webserver has permission to read this directory."; 808 my @mergeFiles = grep( /\.csv$/, readdir SCORINGDIR); #all message files 809 closedir SCORINGDIR; 810 @mergeFiles = sort @mergeFiles; 811 # warn "FIXME scoring directory $scoringDirectory merge Files", join(" ", @mergeFiles); 812 unshift(@mergeFiles, 'None'); 813 return @mergeFiles; 814 } 815 816 sub read_merge_file { 817 my $self = shift; 818 my $fileName = shift; 819 my $delimiter = shift; 820 $delimiter = ',' unless defined($delimiter); 821 my $scoringDirectory= $self->{ce}->{courseDirs}->{scoring}; 822 my $filePath = "$scoringDirectory/$fileName"; 823 # Takes a delimited file as a parameter and returns an 824 # associative array with the first field as the key. 825 # Blank lines are skipped. White space is removed 826 my(@dbArray,$key,%assocArray,$dbString); 827 local(*FILE); 828 open(FILE, "$filePath") or $self->submission_error("Can't open file $filePath"); 829 my $index=0; 830 while (<FILE>){ 831 unless ($_ =~ /\S/) {next;} ## skip blank lines 832 chomp; 833 @{$dbArray[$index]} =$self->getRecord($_,$delimiter); 834 $key =$dbArray[$index][0]; 835 #@dbArray = map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} @dbArray; 836 #$dbString = join(" | ",@dbArray); 837 $assocArray{$key}=$dbArray[$index]; 838 $index++; 839 } 840 close(FILE); 841 return \%assocArray; 842 } 843 sub getRecord { 844 my $self = shift; 845 my $line = shift; 846 my $delimiter = shift; 847 $delimiter = ',' unless defined($delimiter); 848 849 # Takes a delimited line as a parameter and returns an 850 # array. Note that all white space is removed. If the 851 # last field is empty, the last element of the returned 852 # array is also empty (unlike what the perl split command 853 # would return). E.G. @lineArray=&getRecord(\$delimitedLine). 854 855 my(@lineArray); 856 $line.=$delimiter; # add 'A' to end of line so that 857 # last field is never empty 858 @lineArray = split(/\s*${delimiter}\s*/,$line); 859 $lineArray[0] =~s/^\s*//; # remove white space from first element 860 @lineArray; 861 } 862 863 sub process_message { 864 my $self = shift; 865 my $ur = shift; 866 my $rh_merge_data = shift; 867 my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: 868 'FIXME no text was produced by initialization!!'; 869 #user macros that can be used in the email message 870 my $SID = $ur->student_id; 871 my $FN = $ur->first_name; 872 my $LN = $ur->last_name; 873 my $SECTION = $ur->section; 874 my $RECITATION = $ur->recitation; 875 my $STATUS = $ur->status; 876 my $EMAIL = $ur->email_address; 877 my $LOGIN = $ur->user_id; 878 # get record from merge file 879 # FIXME this is inefficient. The info should be cached 880 my @COL = @{$rh_merge_data->{$SID} }; 881 882 my $endCol = @COL; 883 # for safety, only evaluate special variables 884 my $tmp = $text; 885 $tmp =~ s/(\$SID)/eval($1)/ge; 886 $tmp =~ s/(\$LN)/eval($1)/ge; 887 $tmp =~ s/(\$FN)/eval($1)/ge; 888 $tmp =~ s/(\$STATUS)/eval($1)/ge; 889 $tmp =~ s/(\$SECTION)/eval($1)/ge; 890 $tmp =~ s/(\$RECITATION)/eval($1)/ge; 891 $tmp =~ s/(\$EMAIL)/eval($1)/ge; 892 $tmp =~ s/(\$LOGIN)/eval($1)/ge; 893 $tmp =~ s/\$COL\[ *-/\$COL\[$endCol-/g; 894 $tmp =~ s/(\$COL\[.*?\])/eval($1)/ge; 895 896 my $preview_header = CGI::pre("",data_format(0..($#COL)),"\n", data_format(@COL)). 897 CGI::h3( "This sample mail would be sent to $EMAIL"); 898 899 900 my $msg = join("", 901 "To: " , $ur->email_address,"\n", 902 "From: " , $self->{from} , "\n" , 903 "Reply-To: " , $self->{replyTo} , "\n" , 904 "Subject: " , $self->{subject} , "\n" ,"\n" , 905 $tmp , "\n" 906 ); 907 908 $msg =~ s/\r//g; 909 return $msg, $preview_header; 910 } 911 sub data_format { 912 map {$_ =~s/\s/\./g;$_} map {sprintf('%-8.8s',$_);} @_; 913 } 914 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |