Parent Directory
| 
Revision Log
Revision 2 - (view) (download) (as text)
| 1 : | sam | 2 | #!/usr/bin/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 : | |||
| 384 : | |||
| 385 : | #### this will break if the codes are changed !!!!!!!! ############### | ||
| 386 : | |||
| 387 : | sub CL_byLastName { | ||
| 388 : | |||
| 389 : | $MYCLASSLIST{$a} =~ /stln=([^&]*)/; | ||
| 390 : | my $ln1 = $1; # last name sorted first | ||
| 391 : | $MYCLASSLIST{$a} =~ /stfn=([^&]*)/; | ||
| 392 : | my $fn1= $1; # then first name | ||
| 393 : | |||
| 394 : | $MYCLASSLIST{$b} =~ /stln=([^&]*)/; | ||
| 395 : | my $ln2 = $1; | ||
| 396 : | $MYCLASSLIST{$b} =~ /stfn=([^&]*)/; | ||
| 397 : | my $fn2= $1; | ||
| 398 : | |||
| 399 : | my $t = $ln1 cmp $ln2; # compare last name | ||
| 400 : | $t = $fn1 cmp $fn2 unless $t; # if last names equal, compare first names | ||
| 401 : | $t; | ||
| 402 : | } | ||
| 403 : | #### this will break if the codes are changed !!!!!!!! ############### | ||
| 404 : | sub CL_bySectionThenByName { | ||
| 405 : | |||
| 406 : | $MYCLASSLIST{$a} =~ /clsn=([^&]*)/; | ||
| 407 : | my $cs1 = $1; # class section sorted first | ||
| 408 : | $MYCLASSLIST{$a} =~ /stln=([^&]*)/; | ||
| 409 : | my $ln1 = $1; # then last name | ||
| 410 : | $MYCLASSLIST{$a} =~ /stfn=([^&]*)/; | ||
| 411 : | my $fn1= $1; # then first name | ||
| 412 : | |||
| 413 : | $MYCLASSLIST{$b} =~ /clsn=([^&]*)/; | ||
| 414 : | my $cs2 = $1; | ||
| 415 : | $MYCLASSLIST{$b} =~ /stln=([^&]*)/; | ||
| 416 : | my $ln2 = $1; | ||
| 417 : | $MYCLASSLIST{$b} =~ /stfn=([^&]*)/; | ||
| 418 : | my $fn2= $1; | ||
| 419 : | |||
| 420 : | |||
| 421 : | my $t = $cs1 cmp $cs2; # compare class section | ||
| 422 : | $t = $ln1 cmp $ln2 unless $t; # if class sections are equal compare last name | ||
| 423 : | $t = $fn1 cmp $fn2 unless $t; # if last names equal, compare first names | ||
| 424 : | $t; | ||
| 425 : | } | ||
| 426 : | |||
| 427 : | #### this will break if the codes are changed !!!!!!!! ############### | ||
| 428 : | sub CL_byRecitationThenByName { | ||
| 429 : | |||
| 430 : | $MYCLASSLIST{$a} =~ /clrc=([^&]*)/; | ||
| 431 : | my $cs1 = $1; # class recitation sorted first | ||
| 432 : | $MYCLASSLIST{$a} =~ /stln=([^&]*)/; | ||
| 433 : | my $ln1 = $1; # then last name | ||
| 434 : | $MYCLASSLIST{$a} =~ /stfn=([^&]*)/; | ||
| 435 : | my $fn1= $1; # then first name | ||
| 436 : | |||
| 437 : | $MYCLASSLIST{$b} =~ /clrc=([^&]*)/; | ||
| 438 : | my $cs2 = $1; | ||
| 439 : | $MYCLASSLIST{$b} =~ /stln=([^&]*)/; | ||
| 440 : | my $ln2 = $1; | ||
| 441 : | $MYCLASSLIST{$b} =~ /stfn=([^&]*)/; | ||
| 442 : | my $fn2= $1; | ||
| 443 : | |||
| 444 : | |||
| 445 : | my $t = $cs1 cmp $cs2; # compare class recitation | ||
| 446 : | $t = $ln1 cmp $ln2 unless $t; # if class recitations are equal compare last name | ||
| 447 : | $t = $fn1 cmp $fn2 unless $t; # if last names equal, compare first names | ||
| 448 : | $t; | ||
| 449 : | } | ||
| 450 : | |||
| 451 : | |||
| 452 : | |||
| 453 : | |||
| 454 : | |||
| 455 : | 1; | ||
| 456 : | |||
| 457 : | |||
| 458 : |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |