Parent Directory
|
Revision Log
initial import
1 #!/usr/bin/perl 2 3 4 #################################################################### 5 # Copyright @ 1995-1998 University of Rochester 6 # All Rights Reserved 7 #################################################################### 8 9 ## This script is profEditClasslistDB.pl ## 10 11 ############################################################################### 12 ############ PRELIMINARY SETUP ####################### 13 ############################################################################### 14 15 use lib '/ww/webwork/development/'; # mainWeBWorKDirectory; 16 17 use Global; 18 use CGI qw(:standard); 19 use Auth; 20 use TimeLocal; # the module Time::Local.pm has a bug which interacts 21 # with DProf. (They call a subroutine assuming @_ doesn't change. 22 23 use strict; 24 25 my $logTimingData = 0; 26 my $beginTime; 27 28 # begin Timing code 29 if ($logTimingData == 1) { 30 use Benchmark; 31 $beginTime = new Benchmark; 32 } 33 # end Timing code 34 35 my $cgi = new CGI; 36 37 &CGI::ReadParse(*main::inputs); 38 my %inputs=%main::inputs; 39 40 # get primary data from CGI form 41 my $User = $inputs{'user'}; 42 my $Course = $inputs{'course'}; 43 my $Key = $inputs{'key'}; 44 45 46 # set course environment 47 &Global::getCourseEnvironment($Course); 48 49 my $scriptDirectory = getWebworkScriptDirectory($Course); 50 my $databaseDirectory = getCourseDatabaseDirectory($Course); 51 my $cgiURL = getWebworkCgiURL($Course); 52 my $htmlURL = getCourseHtmlURL($Course); 53 my $logsDirectory = getCourseLogsDirectory($Course); 54 55 require "${scriptDirectory}$Global::DBglue_pl"; 56 require "${scriptDirectory}$Global::classlist_DBglue_pl"; 57 require "${scriptDirectory}$Global::FILE_pl"; 58 require "${scriptDirectory}HTMLglue.pl"; 59 60 my $keyFile = getCourseKeyFile($Course); 61 &verify_key($inputs{'user'}, $inputs{'key'}, "$keyFile", $inputs{'course'}); 62 63 my $passwordFile = &Global::getCoursePasswordFile($inputs{'course'}); 64 my $permissionsFile = &Global::getCoursePermissionsFile($inputs{'course'}); 65 my $permissions = &get_permissions($inputs{'user'}, $permissionsFile); 66 67 if ($permissions != $Global::instructor_permissions ) { 68 print "permissions = $permissions instructor_permissions = $Global::instructor_permissions\n"; 69 print &html_NO_PERMISSION; 70 } 71 72 73 # get additional data from calling CGI form 74 my ($Mode, $studentLogin,$action); 75 76 $Mode = "HTML"; #default viewing mode 77 $Mode = $inputs{'Mode'} if defined($inputs{'Mode'}); 78 $studentLogin = $inputs{'studentLogin'}; 79 $action = $inputs{'action'}; 80 81 wwerror("No Student Selected", "Go back and select the student whose record you want to view or edit") 82 unless defined $studentLogin; 83 84 # the following are used to send warning messages if a unique section 85 # or recitation name is saved. They are set in updateDatabase() 86 my $section_status = 'non_unique'; 87 my $recitation_status = 'non_unique'; 88 my $section_status_ref = \$section_status; 89 my $recitation_status_ref = \$recitation_status; 90 91 if (defined( $inputs{'save'} ) and ($inputs{'save'} eq "ON" ) and ($action =~ /SAVE/) ) { 92 # in this case we obtain the data from the CGI from and store it in the database 93 94 my $status = get_CL_database_status(); 95 if ($status eq 'locked') { 96 wwerror("The Classlist Database is LOCKED", "This means the database can not be updated from the internet. 97 Go back and unlock the Classlist Database before proceeding."); 98 } 99 # update the database from the CGI script: 100 101 $studentLogin = &updateDatabase($studentLogin); 102 # loads the information into %CLRecord, 103 # modifies the data and saves it back to the database 104 105 #log the changes: -- the format for loggin the changes needs improvement 106 &logChanges( getClassListRecord() ); 107 &print_modification_form; 108 109 } 110 111 elsif (defined( $inputs{'save'} ) and ($inputs{'save'} eq "ON" ) and ($action =~ /REMOVE/) ) { 112 113 my $status = get_CL_database_status(); 114 if ($status eq 'locked') { 115 wwerror("The Classlist Database is LOCKED", "This means the database can not be updated from the internet. 116 Go back and unlock the Classlist Database before proceeding."); 117 } 118 &removeRecord($studentLogin); 119 &record_successfully_deleted_message($studentLogin); 120 } 121 122 elsif (defined($inputs{'save'}) && $inputs{'save'} eq "OFF" ){ 123 # No new information in the calling CGI form 124 # and the information has already been loaded into %probSetRecord using &fetchProbSetRecord($psvn); 125 # Nothing needs to be done in this case except print the form 126 &print_modification_form; 127 128 } else { 129 130 # The calling CGI script must define the 'save' variable or the 'deleteMode' variable 131 wwerror( $0, "No value for 'save' mode in the calling CGI form"); 132 } 133 134 # begin Timing code 135 if ($logTimingData == 1) { 136 my $endTime = new Benchmark; 137 &Global::logTimingInfo($beginTime,$endTime,'profEditClasslistDB.pl',$Course,$User); 138 } 139 # end Timing code 140 exit; 141 142 #### END of main program 143 144 ############################################################################### 145 ############################ SUBROUTINES ############################ 146 ############################################################################### 147 148 149 ############################################################################### 150 ########################## PRINT FORM ############################## 151 ############################################################################### 152 sub print_modification_form { 153 print &htmlTOP('Classlist database edit form'); 154 print <<END_OF_HTML; 155 156 <A HREF="${cgiURL}profClasslist.pl?user=$inputs{'user'}&key=$inputs{'key'}&course=$inputs{'course'}&format=section"> 157 <IMG SRC="${Global::upImgUrl}" align="right" BORDER=1 ALT="[Up]"></A><p> 158 <H3 ALIGN ="CENTER">Course Name: <FONT COLOR="#AA4400"> $inputs{'course'}</FONT> 159 Data for Student Login: <FONT COLOR="#AA4400">$studentLogin</FONT></H3> 160 <HR SIZE =2> 161 <FORM ACTION="${cgiURL}profEditClasslistDB.pl" METHOD=POST> 162 163 Changes can be saved only if the Read/Write Mode button is selected: <BR> 164 165 <INPUT TYPE="radio" CHECKED NAME="save" VALUE="OFF" > Read Only Mode <BR> 166 <INPUT TYPE="radio" NAME="save" VALUE="ON"> Read/Write Mode <BR> 167 <INPUT TYPE='HIDDEN' NAME='firsttime' VALUE= 0> 168 169 END_OF_HTML 170 171 172 ###################################################### 173 # return messages 174 #print message about saving to the database and current mode of CGI form 175 if (defined( $inputs{'firsttime'} ) && $inputs{'firsttime'} == 0 ) { 176 if (defined( $inputs{'save'} ) && $inputs{'save'} eq "ON" ) { 177 print "<P><FONT COLOR='#ff00aa'><B>CLASSLIST DATABASE MODIFIED</B></font> <P>"; 178 } elsif (defined($inputs{'save'}) && $inputs{'save'} eq "OFF" ){ 179 180 print "<P><FONT COLOR='#ff00aa'><B>READ ONLY MODE: CLASSLIST DATABASE UNCHANGED</B></font> <P>"; 181 182 } else { 183 # When initially entering this CGI the 'save' mode is undefined. 184 wwerror( $0, "No value for 'save' mode.</B><P>"); 185 } 186 } 187 188 # Get set data 189 190 attachCLRecord($studentLogin); 191 ## student 192 my $StudentLastName = CL_getStudentLastName($studentLogin); 193 my $StudentFirstName = CL_getStudentFirstName($studentLogin); 194 my $StudentStatus = CL_getStudentStatus($studentLogin); 195 my $StudentComment = CL_getComment($studentLogin); 196 my $ClassSection = CL_getClassSection($studentLogin); 197 my $ClassRecitation = CL_getClassRecitation($studentLogin); 198 my $StudentEmail = CL_getStudentEmailAddress($studentLogin); 199 my $StudentID = CL_getStudentID($studentLogin); 200 201 202 if ($section_status eq 'unique') { 203 print "<P><FONT COLOR='#ff00aa'><B>$StudentFirstName $StudentLastName is the only 204 person in the section $ClassSection</B></font> <P>"; 205 } 206 207 if ($recitation_status eq 'unique') { 208 print "<P><FONT COLOR='#ff00aa'><B>$StudentFirstName $StudentLastName is the only 209 person in the recitation $ClassRecitation</B></font> <P>"; 210 } 211 212 213 # submit button 214 215 print qq!<INPUT TYPE='SUBMIT' NAME = 'action' VALUE='SAVE CHANGES'><INPUT TYPE = "RESET" VALUE= "RESET FORM"><INPUT TYPE='SUBMIT' NAME = 'action' VALUE='REMOVE THIS RECORD'> <BR>!; 216 217 # Get set data 218 219 220 # continue printing form ###################################################### 221 print &sessionKeyInputs(\%inputs); 222 print qq!<INPUT TYPE='HIDDEN' NAME='studentLogin' VALUE="$studentLogin">!; 223 print qq! <TABLE BORDER="1" CELLPADDING="1" CELLSPACING="2" > <FONT SIZE=-2>!; 224 225 print "<TR>\n"; 226 print &formatHeaderCell("Last Name"); 227 print &formatHeaderCell("First Name"); 228 print &formatHeaderCell("Student ID" ); 229 print "</TR>\n"; 230 print "<TR>\n"; 231 print &formatDataCell("StudentLastName",$StudentLastName, "20"); 232 print &formatDataCell("StudentFirstName", $StudentFirstName, "20"); 233 print &formatDataCell("StudentID", $StudentID, "30"); 234 print "</TR>\n"; 235 236 print "<TR>\n"; 237 print &formatHeaderCell("Student login name"); 238 print &formatHeaderCell("Enrollment Status"); 239 print &formatHeaderCell('Comment' ); 240 print "</TR>\n"; 241 print "<TR>\n"; 242 print &formatDataCell('StudentLogin',$studentLogin, "20"); 243 print &formatDataCell('StudentStatus',$StudentStatus, "20"); 244 print &formatDataCell('Comment', $StudentComment, "30"); 245 print "</TR>\n"; 246 247 print "<TR>\n"; 248 print &formatHeaderCell('Section'); 249 print &formatHeaderCell('Recitation'); 250 print &formatHeaderCell('Email Address'); 251 print "</TR>\n"; 252 253 print "<TR>\n"; 254 print &formatDataCell('ClassSection', $ClassSection, "20"); 255 print &formatDataCell('ClassRecitation', $ClassRecitation, "20"); 256 print &formatDataCell('StudentEmail', $StudentEmail, "30"); 257 print "</TR>\n"; 258 259 260 261 print ' </FONT></TABLE>'; 262 263 print '<BR>The drop down lists below are for information only. Selecting items from them 264 does nothing.<BR> Enter the section, recitation, and enrollment status, if any, above. <BR>'; 265 # Current Sections list 266 267 print $cgi -> popup_menu( -name => 'currentSections', 268 -values => ['List of current sections', keys (%{getAllSections()})] 269 ); 270 271 # Current Recitations list 272 print $cgi -> popup_menu( -name => 'currentRecitations', 273 -values => ['List of current recitations', keys (%{getAllRecitations()})] 274 ); 275 # Current Drop List 276 277 my @drop_status_labels = getStatusDrop(); 278 279 print $cgi -> popup_menu( -name => 'dropStatus', 280 -values => ['Valid Drop Status',@drop_status_labels] 281 ); 282 print 'Any other status (e.g. "C") indicates a current student.'; 283 284 print q!</FORM>!; 285 286 print &htmlBOTTOM('profEditClasslistDB.pl', \%inputs); 287 288 } # end of print_modification_form 289 290 291 sub updateDatabase { 292 293 my $studentLogin = shift @_; 294 attachCLRecord($studentLogin); 295 296 my $orgStudentLastName = CL_getStudentLastName($studentLogin); 297 my $orgStudentFirstName = CL_getStudentFirstName($studentLogin); 298 my $orgStudentID = CL_getStudentID($studentLogin); 299 my $orgStudentStatus = CL_getStudentStatus($studentLogin); 300 my $orgStudentLogin = $studentLogin; 301 302 my $newStudentLastName = stripWhiteSpace($inputs{'StudentLastName'}); 303 my $newStudentFirstName = stripWhiteSpace($inputs{'StudentFirstName'}); 304 my $newStudentStatus = stripWhiteSpace($inputs{'StudentStatus'}); 305 my $newComment = stripWhiteSpace($inputs{'Comment'}); 306 my $newClassSection = stripWhiteSpace($inputs{'ClassSection'}); 307 my $newClassRecitation = stripWhiteSpace($inputs{'ClassRecitation'}); 308 my $newStudentEmail = stripWhiteSpace($inputs{'StudentEmail'}); 309 my $newStudentID = stripWhiteSpace($inputs{'StudentID'}); 310 my $newStudentLogin = stripWhiteSpace($inputs{'StudentLogin'}); 311 312 ## test entries for bad characters. 313 my @entries = ($newStudentLastName, $newStudentFirstName, $newStudentStatus, $newComment, $newClassSection, 314 $newClassRecitation, $newStudentEmail); 315 my $item =''; 316 foreach $item (@entries) { 317 my $msg = test_entry($item); 318 unless ($msg eq 'OK') { 319 &wwerror('Bad Entry',$msg); 320 } 321 } 322 323 ## test student login and ID for validity. 324 my $studentLoginChanged = 0; 325 if ($newStudentLogin ne $orgStudentLogin) { 326 $studentLoginChanged = 1; 327 my $msg = testNewStudentLogin($newStudentLogin,$newStudentID); 328 unless ($msg eq 'OK') { 329 &wwerror('Bad Login Name',$msg);} 330 } 331 my $studentIDChanged = 0; 332 if ($newStudentID ne $orgStudentID) { 333 $studentIDChanged = 1; 334 my $msg = testNewStudentID($newStudentID,$newStudentLogin); 335 unless ($msg eq 'OK') { 336 &wwerror('Bad Student ID',"$msg");} 337 } 338 339 if ($studentLoginChanged and $studentIDChanged) { 340 warningMsgPage(\%inputs,$orgStudentFirstName,$orgStudentLastName,$newStudentFirstName,$newStudentLastName); 341 exit(0); 342 } 343 344 # these will be set to zero if the new section or recitation is unique 345 my $uniqueSection = 0; 346 my %section_hash = %{getAllSections()}; 347 $uniqueSection = $section_hash{$newClassSection} if defined $section_hash{$newClassSection}; 348 349 my $uniqueRecitation = 0; 350 my %recitation_hash = %{getAllRecitations()}; 351 $uniqueRecitation = $recitation_hash{$newClassRecitation} if defined $recitation_hash{$newClassRecitation}; 352 353 $$section_status_ref = 'unique' unless $uniqueSection; 354 $$recitation_status_ref = 'unique' unless $uniqueRecitation; 355 356 # update the webwork database if it exists 357 358 if ( -e "${databaseDirectory}$Global::database" ){ 359 my %setNumberHash=&getAllSetNumbersForStudentLoginHash($studentLogin); 360 my @PSVNs = values %setNumberHash; 361 my $psvn; 362 foreach $psvn (@PSVNs) { 363 attachProbSetRecord($psvn); 364 putStudentLastName( $newStudentLastName ,$psvn); 365 putStudentFirstName( $newStudentFirstName,$psvn); 366 putStudentStatus( $newStudentStatus ,$psvn); 367 putClassSection( $newClassSection ,$psvn); 368 putClassRecitation( $newClassRecitation ,$psvn); 369 putStudentEmailAddress( $newStudentEmail ,$psvn); 370 putStudentID( $newStudentID ,$psvn); 371 putStudentLogin( $newStudentLogin ,$psvn); 372 detachProbSetRecord($psvn); 373 } 374 } 375 # update the password and permissions databases 376 377 if ($studentLoginChanged) { 378 change_user_in_password_file($newStudentLogin, $orgStudentLogin,$passwordFile); 379 change_user_in_permissions_file($newStudentLogin, $orgStudentLogin,$permissionsFile); 380 } 381 382 if (&dropStatus($newStudentStatus) != &dropStatus($orgStudentStatus)) { 383 if (&dropStatus($newStudentStatus)) { 384 delete_password($newStudentLogin,$passwordFile); 385 delete_permissions($newStudentLogin,$permissionsFile); 386 } 387 else { 388 new_password($newStudentLogin,$newStudentID,$passwordFile); 389 put_permissions(0,$newStudentLogin,$permissionsFile); 390 } 391 } 392 # update the classlist database 393 394 if ($studentLoginChanged) { 395 deleteClassListRecord($orgStudentLogin); 396 $studentLogin = $newStudentLogin; 397 } 398 399 &CL_putStudentLastName( $newStudentLastName ,$studentLogin); 400 &CL_putStudentFirstName( $newStudentFirstName,$studentLogin); 401 &CL_putStudentStatus( $newStudentStatus ,$studentLogin); 402 &CL_putComment( $newComment ,$studentLogin); 403 &CL_putClassSection( $newClassSection ,$studentLogin); 404 &CL_putClassRecitation( $newClassRecitation ,$studentLogin); 405 &CL_putStudentEmailAddress( $newStudentEmail ,$studentLogin); 406 &CL_putStudentID( $newStudentID ,$studentLogin); 407 408 # save the updated information to the database 409 saveCLRecord($studentLogin); 410 $studentLogin; ## return the possibly new studentLogin 411 412 } 413 414 sub removeRecord { 415 my ($studentLogin) = shift @_; 416 attachCLRecord($studentLogin); 417 deleteClassListRecord($studentLogin); 418 delete_password($studentLogin,$passwordFile); 419 delete_permissions($studentLogin,$permissionsFile); 420 } 421 422 # logs the incremental changes to a log file 423 sub logChanges { 424 my @dataArray = @_; 425 my $fullLogFileName ="${logsDirectory}classlist_DB.log"; 426 open(LOGFILE,">>$fullLogFileName") || &Global::error( "Can't open $fullLogFileName"); 427 428 my $timeNow = formatDateAndTime(time); 429 print LOGFILE "\n$Course, student is $studentLogin, user is $User, time is $timeNow, data is: "; 430 my $dataString = join( ' ',@dataArray); 431 print LOGFILE "@dataArray\n" ; 432 close(LOGFILE); 433 } 434 435 436 sub formatDataCell { 437 my ($name,$value,$size) = @_; 438 # if the data hasn't been entered it appears as a blank: 439 $value = '' unless defined($value); 440 441 my $out = qq! 442 <TD ALIGN=CENTER VALIGN=MIDDLE > 443 <INPUT TYPE="TEXT" NAME="$name" VALUE="$value", SIZE="$size"> 444 </TD> 445 !; 446 $out; 447 } 448 sub formatFixedDataCell { 449 my ($name,$value,$size) = @_; 450 # if the data hasn't been entered it appears as a blank: 451 $value = '' unless defined($value); 452 453 my $out = qq! 454 <TD ALIGN=CENTER VALIGN=MIDDLE > 455 <INPUT TYPE='HIDDEN' NAME="$name" VALUE="$value"> 456 $value 457 </TD> 458 !; 459 $out; 460 } 461 sub formatHeaderCell { 462 my ($item,$options) = @_; 463 $options = '' unless defined($options); 464 my $out = qq! 465 <TH ALIGN=CENTER VALIGN=MIDDLE $options> 466 $item 467 </TH> 468 !; 469 $out; 470 } 471 472 473 474 sub record_successfully_deleted_message { 475 my $studentLogin =shift; 476 print &htmlTOP("The student record with login $studentLogin has been deleted from the $Course classlist database."); 477 print <<END_OF_HTML; 478 <A HREF="${cgiURL}profLogin.pl?user=$inputs{'user'}&key=$inputs{'key'}&course=$inputs{'course'}"> 479 <IMG SRC="${Global::upImgUrl}" align="right" BORDER=1 ALT="[Up]"></A> 480 END_OF_HTML 481 print qq!<P><B> The student record with login $studentLogin has been deleted from the classlist database.</B><P>!; 482 print &htmlBOTTOM('profEditClasslistDB.pl', \%inputs); 483 484 } 485 486 487 488 sub warningMsgPage { 489 490 my ($inputref,$ofn,$oln,$nfn,$nln) = @_; 491 my %inputs = %$inputref; 492 # print HTML text 493 print &htmlTOP("Data for the classlist record for $studentLogin"); 494 495 # print navigation buttons 496 print qq! 497 <A HREF="${Global::cgiWebworkURL}profLogin.pl?user=$inputs{'user'}&key=$inputs{'key'}&course=$inputs{'course'}"> 498 <IMG SRC="${Global::upImgUrl}" align="right" BORDER=1 ALT="[Up]"></A><p> 499 !; 500 501 print <<EOF; 502 <HR><BR> 503 <h3 align="left">WeBWorK WARNING message for Student Login $studentLogin</h3> 504 EOF 505 print qq!You have attempted to change (edit) both the Student Login and Student ID for <BR><BR> 506 Original Name: $ofn $oln <BR> 507 Edited Name: $nfn $nln <BR><BR> 508 509 <P><FONT COLOR='#ff00aa'><B>NO CHANGES HAVE BEEN MADE</B></font> <P> 510 It is possible you are making a mistake by trying to use this form to enter a new user. If you want to 511 enter a new user, goto the Professor's page and click on "Enter Add Student(s) Page". <BR><BR> 512 513 If you really want to make these extensive changes to $ofn ${oln}'s classlist record, you must do it 514 in two steps. You can not change both the Student Login and Student ID at the same time. Use your 515 browser's "Back Button" to go back and change just one of these. Then edit the record again changing the other one. 516 <BR><BR> 517 To Quit and return to the Professor's page, select the "Up" button or the button below.!; 518 519 520 521 print &htmlBOTTOM('profEditClasslistDB.pl', \%inputs); 522 exit; 523 } #end of warning Page
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |