Parent Directory
| 
Revision Log
another setup script test (changed #! lines)
1 #!/usr/local/bin/webwork-perl 2 3 4 # file: classlist_DBglue.pl 5 6 # These are the tools for accessing the classlist database which contains 7 # all of the information for a given student. Within the record there are methods 8 # for accessing the data in the record, such as the student's name, ID, and so forth. \ 9 # The only direct "ties" un "untie" to the database on disk are through the two routines 10 # read_class_list_record and save_class_list_record. 11 12 # The normal key for a record is the student login id, e.g. apizer . 13 # Special keys (e.g. >>lock_status) always begin with >> . 14 15 # The directory names are defined in the header. 16 17 # Define file name for databases. 18 use strict; 19 20 21 # define global file variables 22 my %CLASSLIST; 23 my %MYCLASSLIST; # used for temporary sorting by last name and by section; 24 my %CL_Record; 25 my $CL_Database = $Global::CL_Database; 26 my $databaseDirectory = $Global::databaseDirectory; 27 28 my $scriptDirectory = &Global::getWebworkScriptDirectory(); 29 30 my $CL_DbObj; # Object for referencing the database 31 # how do we make this a local variable (or can we?) 32 my $LOCK_SH = 1 ; # shared lock 33 my $LOCK_EX = 2 ; # exclusive lock 34 my $LOCK_NB = 4 ; # non-blocking 35 my $LOCK_UN = 8 ; # unlock 36 37 38 # These open and close the database containing the classList Records. 39 # They should only be used internally to this file. 40 41 sub attachCL { # returns 1 if succesful 42 my $mode = $_[0] || 'reader'; 43 my ($flag); 44 &Global::error("DB error", "attachCL doesn't know mode $mode") 45 unless ($mode eq 'reader' || $mode eq 'writer'); 46 47 if ($mode eq 'reader') {$flag = 'R'} 48 else {$flag = 'W'} 49 &read_CL_record(\$CL_DbObj, \%CLASSLIST, "${databaseDirectory}${CL_Database}", $flag, $Global::standard_tie_permission); 50 51 if ($flag eq 'W') { 52 my $status = $CLASSLIST{'>>lock_status'}; 53 unless ((!defined $status) or ($status eq 'unlocked') or ((defined $Global::over_ride_CLBD_lock) 54 and $Global::over_ride_CLBD_lock)) { 55 &save_CL_record(\$CL_DbObj, \%CLASSLIST,"${databaseDirectory}${CL_Database}"); 56 wwerror("The Classlist Database is LOCKED", "This means the database can not be updated from the internet 57 (e.g. students can not change their email addresses). Probably your professor is working on the database. 58 if this problem persists, tell your peofessor. Perhaps he or she forgot to unlock the database."); 59 60 } 61 62 } 63 } 64 65 66 sub detachCL { 67 &save_CL_record(\$CL_DbObj, \%CLASSLIST,"${databaseDirectory}${CL_Database}"); 68 1; # Explicitly return 1 if successful, if not it has already died 69 } 70 71 sub read_CL_record { 72 my ($dbObj_ref,$hash_ref, $file_name, $mode_flag, $permission) = @_; 73 &Global::tie_hash('CL_FH',$dbObj_ref,$hash_ref, $file_name, $mode_flag, $permission); 74 } 75 76 77 sub save_CL_record { 78 my ($dbObj_ref, $hash_ref, $file_name) = @_; 79 &Global::untie_hash('CL_FH',$dbObj_ref,$hash_ref, $file_name); 80 } 81 82 sub attachCLRecord { 83 my($user)=@_; 84 return 0 unless defined($user); # can't find record if you don't tell me the record id. 85 my($flag)=0; 86 %CL_Record=(); 87 &attachCL(); #attaches DBM file to %CLASSLIST 88 # unpack the line into %CL_Record 89 if ( $flag=defined($CLASSLIST{"$user"}) ) { 90 my $string = $CLASSLIST{"$user"}; 91 $string =~ s/=$/= /; # this makes sure that the last element has a value. It may cause trouble if this value was supposed to be nil instead of a space. 92 my @CL_Record=split(/[\&=]/,$string); 93 94 %CL_Record=@CL_Record; 95 } 96 &detachCL; 97 # The classlist record corresponding to the $user is now in %CL_Record 98 $flag; # 1 means you got something 99 } 100 101 sub saveCLRecord { #data is in CL_Record 102 my($user)=@_; 103 my ($out,@ind,@setList,%setList,@loginList,%loginList); 104 my ($setNumber, $loginID, $oldLoginID,$oldSetNumber, $recordString); 105 &attachCL('writer'); #attaches DBM file to %CLASSLIST 106 107 # Prepare the new record and place it into %CLASSLIST DBM file 108 $out=''; 109 @ind=keys(%CL_Record); 110 my $i; 111 foreach $i (@ind) { 112 $out=$out . $i . '=' . $CL_Record{$i} . "&" ; 113 }; 114 chop($out); #remove the final & from the string. 115 116 117 $CLASSLIST{$user}=$out; 118 119 if (&detachCL) { 120 return 1; # returns 1 if successful 121 } else { 122 wwerror("$0","classlist_DBglue.pl Error at line __LINE__ while saving database","",""); 123 return 0; 124 } 125 # The contents of %CL_Record has now been placed in the problem set record data 126 # base with key given by $CL_Record 127 } 128 129 130 131 sub getClassListRecord { #returns the contents of the current record hash 132 %CL_Record; 133 } 134 135 sub deleteClassListRecord { 136 my ($user)=@_; 137 my $flag = 1; 138 $flag = $flag && &attachCL('writer'); #attaches DBM file to %CLASSLIST # get the necessary data 139 140 # erase the record itself 141 $flag=$flag && defined($CLASSLIST{$user}); 142 delete $CLASSLIST{$user}; 143 &detachCL(); 144 } 145 146 #######StudentLastName########################### 147 sub CL_putStudentLastName { 148 my($val,$user) = @_; 149 $CL_Record{'stln'}=$val; 150 } 151 sub CL_getStudentLastName { 152 my ($user) = @_; 153 return( $CL_Record{'stln'} ); 154 } 155 156 sub CL_deleteStudentLastName { 157 my ($user) = @_; 158 delete $CL_Record{'stln'}; 159 } 160 161 #######StudentFirstName########################### 162 sub CL_putStudentFirstName { 163 my ($val,$user) = @_; 164 $CL_Record{'stfn'}=$val; 165 } 166 sub CL_getStudentFirstName { 167 my ($user) = @_; 168 return( $CL_Record{'stfn'} ); 169 } 170 171 sub CL_deleteStudentFirstName { 172 my ($user) = @_; 173 delete $CL_Record{'stfn'}; 174 } 175 176 #######EmailAddress######################## 177 178 sub CL_putStudentEmailAddress { 179 my ($val, $user) = @_; 180 $CL_Record{'stea'}=$val; 181 } 182 sub CL_getStudentEmailAddress { 183 my ($user) = @_; 184 return( $CL_Record{'stea'} ); 185 } 186 sub CL_deleteStudentEmailAddress { 187 my ($user) = @_; 188 delete $CL_Record{'stea'}; 189 } 190 191 #######StudentID########################### 192 sub CL_putStudentID { 193 my ($val,$user) = @_; 194 $CL_Record{'stid'}=$val; 195 } 196 sub CL_getStudentID { 197 my ($user) = @_; 198 return( $CL_Record{'stid'} ); 199 } 200 201 sub CL_deleteStudentID { 202 my ($user) = @_; 203 delete $CL_Record{'stid'}; 204 } 205 206 207 #######StudentStatus########################### 208 sub CL_putStudentStatus { 209 my ($val,$user) = @_; 210 $CL_Record{'stst'}=$val; 211 } 212 sub CL_getStudentStatus { 213 my ($user) = @_; 214 return( $CL_Record{'stst'} ); 215 } 216 217 sub CL_deleteStudentStatus { 218 my ($user) = @_; 219 delete $CL_Record{'stst'}; 220 } 221 222 223 #######ClassSection########################### 224 sub CL_putClassSection { 225 my ($val,$user) = @_; 226 $CL_Record{'clsn'}=$val; 227 } 228 sub CL_getClassSection { 229 my ($user) = @_; 230 return( $CL_Record{'clsn'} ); 231 } 232 233 sub CL_deleteClassSection { 234 my ($user) = @_; 235 delete $CL_Record{'clsn'}; 236 } 237 238 #######ClassRecitation########################### 239 sub CL_putClassRecitation { 240 my ($val,$user) = @_; 241 $CL_Record{'clrc'}=$val; 242 } 243 sub CL_getClassRecitation { 244 my ($user) = @_; 245 return( $CL_Record{'clrc'} ); 246 } 247 248 sub CL_deleteClassRecitation { 249 my ($user) = @_; 250 delete $CL_Record{'clrc'}; 251 } 252 253 #######Comment########################### 254 sub CL_putComment { 255 my ($val,$user) = @_; 256 $CL_Record{'comt'}=$val; 257 } 258 sub CL_getComment { 259 my ($user) = @_; 260 return( $CL_Record{'comt'} ); 261 } 262 263 sub CL_deleteComment { 264 my ($user) = @_; 265 delete $CL_Record{'comt'}; 266 } 267 268 ############Other methods######################### 269 270 ## lock and unlock CL database 271 272 sub lock_CL_database { 273 $Global::over_ride_CLBD_lock = 0; ## reset just to be sure 274 &attachCL('writer'); 275 $CLASSLIST{'>>lock_status'}='locked'; 276 if (&detachCL) { 277 return 1; # returns 1 if successful 278 } else { 279 wwerror("$0","classlist_DBglue.pl Error at line __LINE__ while saving database","",""); 280 return 0; 281 } 282 } 283 284 sub unlock_CL_database { ## we have to by pass standard routines since we want to unlock a locked database over the web 285 $Global::over_ride_CLBD_lock = 0; ## reset just to be sure 286 &read_CL_record(\$CL_DbObj, \%CLASSLIST, "${databaseDirectory}${CL_Database}", 'W', $Global::standard_tie_permission); 287 $CLASSLIST{'>>lock_status'}='unlocked'; 288 &save_CL_record(\$CL_DbObj, \%CLASSLIST,"${databaseDirectory}${CL_Database}"); 289 } 290 291 sub get_CL_database_status { 292 &attachCL(); 293 return $CLASSLIST{'>>lock_status'}; 294 &detachCL(); 295 } 296 297 # &getAllLoginNames 298 299 sub getAllLoginNames { 300 &attachCL(); 301 my (@lst)=grep(/^[^>>]/ , keys %CLASSLIST); ##all special keys begin with >> 302 &detachCL(); 303 \@lst; 304 } 305 306 sub getAllLoginNamesSortedByName { 307 308 &attachCL(); 309 my (@out)=grep(/^[^>>]/ , keys %CLASSLIST); ##all special keys begin with >> 310 %MYCLASSLIST = %CLASSLIST; # CL_byLastName needs this hash to sort with 311 &detachCL(); 312 313 @out=sort (CL_byLastName @out); 314 \@out; 315 } 316 317 sub getAllLoginNamesSortedBySectionThenByName { 318 319 &attachCL(); 320 my (@out)=grep(/^[^>>]/ , keys %CLASSLIST); ##all special keys begin with >> 321 %MYCLASSLIST = %CLASSLIST; # CL_byLastName needs this hash to sort with 322 &detachCL(); 323 324 @out=sort (CL_bySectionThenByName @out); 325 \@out; 326 } 327 328 sub getAllLoginNamesSortedByRecitationThenByName { 329 330 &attachCL(); 331 my (@out)=grep(/^[^>>]/ , keys %CLASSLIST); ##all special keys begin with >> 332 %MYCLASSLIST = %CLASSLIST; # CL_byLastName needs this hash to sort with 333 &detachCL(); 334 335 @out=sort (CL_byRecitationThenByName @out); 336 \@out; 337 } 338 339 340 sub getLoginName_StudentID_Hash { 341 342 my @userNames = @{getAllLoginNames()}; 343 my ($user, %loginName_StudentID_Hash); 344 foreach $user (@userNames) { 345 attachCLRecord($user); 346 $loginName_StudentID_Hash{$user} = CL_getStudentID($user); 347 } 348 \%loginName_StudentID_Hash; 349 } 350 351 sub getStudentID_LoginName_Hash { 352 353 my %studentID_LoginName_Hash = reverse %{getLoginName_StudentID_Hash()}; 354 \%studentID_LoginName_Hash; 355 } 356 357 sub getAllSections{ 358 359 my @userNames = @{getAllLoginNames()}; 360 my ($user, $section,%section_Hash); 361 foreach $user (@userNames) { 362 attachCLRecord($user); 363 $section= CL_getClassSection($user); 364 $section_Hash{$section}++; 365 } 366 367 \%section_Hash; 368 } 369 370 sub getAllRecitations{ 371 372 my @userNames = @{getAllLoginNames()}; 373 my ($user, $recitation,%recitation_Hash); 374 foreach $user (@userNames) { 375 attachCLRecord($user); 376 $recitation= CL_getClassRecitation($user); 377 $recitation_Hash{$recitation}++; 378 } 379 380 \%recitation_Hash; 381 } 382 383 sub CL_getStudentName { 384 my($user) = @_; 385 my($fname) = &CL_getStudentFirstName($user); 386 my($lname) = &CL_getStudentLastName($user); 387 $fname = '' unless defined $fname; 388 $lname = '' unless defined $lname; 389 my($out) = "$fname $lname"; 390 $out =~ s/\s\s+/ /g; # remove any extra spaces 391 $out; 392 } 393 394 #### this will break if the codes are changed !!!!!!!! ############### 395 396 sub CL_byLastName { 397 398 $MYCLASSLIST{$a} =~ /stln=([^&]*)/; 399 my $ln1 = $1; # last name sorted first 400 $MYCLASSLIST{$a} =~ /stfn=([^&]*)/; 401 my $fn1= $1; # then first name 402 403 $MYCLASSLIST{$b} =~ /stln=([^&]*)/; 404 my $ln2 = $1; 405 $MYCLASSLIST{$b} =~ /stfn=([^&]*)/; 406 my $fn2= $1; 407 408 my $t = $ln1 cmp $ln2; # compare last name 409 $t = $fn1 cmp $fn2 unless $t; # if last names equal, compare first names 410 $t; 411 } 412 #### this will break if the codes are changed !!!!!!!! ############### 413 sub CL_bySectionThenByName { 414 415 $MYCLASSLIST{$a} =~ /clsn=([^&]*)/; 416 my $cs1 = $1; # class section sorted first 417 $MYCLASSLIST{$a} =~ /stln=([^&]*)/; 418 my $ln1 = $1; # then last name 419 $MYCLASSLIST{$a} =~ /stfn=([^&]*)/; 420 my $fn1= $1; # then first name 421 422 $MYCLASSLIST{$b} =~ /clsn=([^&]*)/; 423 my $cs2 = $1; 424 $MYCLASSLIST{$b} =~ /stln=([^&]*)/; 425 my $ln2 = $1; 426 $MYCLASSLIST{$b} =~ /stfn=([^&]*)/; 427 my $fn2= $1; 428 429 430 my $t = $cs1 cmp $cs2; # compare class section 431 $t = $ln1 cmp $ln2 unless $t; # if class sections are equal compare last name 432 $t = $fn1 cmp $fn2 unless $t; # if last names equal, compare first names 433 $t; 434 } 435 436 #### this will break if the codes are changed !!!!!!!! ############### 437 sub CL_byRecitationThenByName { 438 439 $MYCLASSLIST{$a} =~ /clrc=([^&]*)/; 440 my $cs1 = $1; # class recitation sorted first 441 $MYCLASSLIST{$a} =~ /stln=([^&]*)/; 442 my $ln1 = $1; # then last name 443 $MYCLASSLIST{$a} =~ /stfn=([^&]*)/; 444 my $fn1= $1; # then first name 445 446 $MYCLASSLIST{$b} =~ /clrc=([^&]*)/; 447 my $cs2 = $1; 448 $MYCLASSLIST{$b} =~ /stln=([^&]*)/; 449 my $ln2 = $1; 450 $MYCLASSLIST{$b} =~ /stfn=([^&]*)/; 451 my $fn2= $1; 452 453 454 my $t = $cs1 cmp $cs2; # compare class recitation 455 $t = $ln1 cmp $ln2 unless $t; # if class recitations are equal compare last name 456 $t = $fn1 cmp $fn2 unless $t; # if last names equal, compare first names 457 $t; 458 } 459 460 461 462 463 464 1; 465 466 467
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |