Parent Directory
| 
Revision Log
Revision 10 - (view) (download) (as text)
| 1 : | sam | 10 | #!/usr/local/bin/perl |
| 2 : | gage | 6 | |
| 3 : | # ############################################################# | ||
| 4 : | # Copyright © 1995,1996,1997,1998 University of Rochester | ||
| 5 : | # All Rights Reserved | ||
| 6 : | # ############################################################# | ||
| 7 : | |||
| 8 : | # file: DBglue7.pl | ||
| 9 : | |||
| 10 : | # These are the tools for accessing the database which contains | ||
| 11 : | # all of the information for a given PIN number. Within the pinRecord there are methods | ||
| 12 : | # for accessing the data in the record, such as the student's name, ID, the set number | ||
| 13 : | # the problems in the set, the due dates and so forth. The only direct "ties" un "untie" | ||
| 14 : | # to the database on disk are through the two routines read_psvn_record and | ||
| 15 : | # save_psvn_record. | ||
| 16 : | |||
| 17 : | # The directory names are defined in the header. | ||
| 18 : | |||
| 19 : | # Define file name for databases. | ||
| 20 : | use strict; | ||
| 21 : | |||
| 22 : | |||
| 23 : | # define global file variables | ||
| 24 : | my %PROBSET; | ||
| 25 : | my %probSetRecord; | ||
| 26 : | my $Database = $Global::database; | ||
| 27 : | my $databaseDirectory = $Global::databaseDirectory; | ||
| 28 : | |||
| 29 : | my $scriptDirectory = &Global::getWebworkScriptDirectory(); | ||
| 30 : | |||
| 31 : | my $wwDbObj; # Object for referencing the database | ||
| 32 : | my %MYPROBSET; # used for temporary sorting by last name and by section or recitation; | ||
| 33 : | # how do we make this a local variable (or can we?) | ||
| 34 : | my $LOCK_SH = 1 ; # shared lock | ||
| 35 : | my $LOCK_EX = 2 ; # exclusive lock | ||
| 36 : | my $LOCK_NB = 4 ; # non-blocking | ||
| 37 : | my $LOCK_UN = 8 ; # unlock | ||
| 38 : | |||
| 39 : | |||
| 40 : | # These open and close the database containing the pinRecords. | ||
| 41 : | # They should only be used internally to this file. | ||
| 42 : | |||
| 43 : | sub attachDBMpin { # returns 1 if succesful | ||
| 44 : | my $mode = $_[0] || 'reader'; | ||
| 45 : | my ($flag); | ||
| 46 : | &Global::error("DB error", "attachDBMpin doesn't know mode $mode") | ||
| 47 : | unless ($mode eq 'reader' || $mode eq 'writer'); | ||
| 48 : | |||
| 49 : | if ($mode eq 'reader') {$flag = 'R'} | ||
| 50 : | else {$flag = 'W'} | ||
| 51 : | &read_psvn_record(\$wwDbObj, \%PROBSET, "${databaseDirectory}${Database}", $flag, $Global::standard_tie_permission); | ||
| 52 : | } | ||
| 53 : | |||
| 54 : | |||
| 55 : | sub detachDBMpin { | ||
| 56 : | &save_psvn_record(\$wwDbObj, \%PROBSET,"${databaseDirectory}${Database}"); | ||
| 57 : | 1; # Explicitly return 1 if successful, if not it has already died | ||
| 58 : | } | ||
| 59 : | |||
| 60 : | |||
| 61 : | |||
| 62 : | sub fetchProbSetRecord { # synonym for attachProbSetRecord | ||
| 63 : | attachProbSetRecord(@_); | ||
| 64 : | } | ||
| 65 : | sub attachProbSetRecord { | ||
| 66 : | my($probSetKey)=@_; | ||
| 67 : | return 0 unless defined($probSetKey); # can't find record if you don't tell me the record id. | ||
| 68 : | my($flag)=0; | ||
| 69 : | %probSetRecord=(); | ||
| 70 : | &attachDBMpin(); #attaches DBM file to %PROBSET | ||
| 71 : | # unpack the line into %probSetRecord | ||
| 72 : | if ( $flag=defined($PROBSET{"$probSetKey"}) ) { | ||
| 73 : | my $string = $PROBSET{"$probSetKey"}; | ||
| 74 : | $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. | ||
| 75 : | my @probSetRecord=split(/[\&=]/,$string); | ||
| 76 : | # if (scalar(@probSetRecord) % 2 == 1) { | ||
| 77 : | # print "<BR>size of probSetRecord = ",scalar(@probSetRecord),"<BR>"; | ||
| 78 : | # print "<BR>hash list= <BR>|$PROBSET{$probSetKey}|<BR><BR>"; | ||
| 79 : | # #print "probSetRecord", join("|<BR>|\n",@probSetRecord), "<BR><BR>"; | ||
| 80 : | # } | ||
| 81 : | %probSetRecord=@probSetRecord; | ||
| 82 : | } | ||
| 83 : | &detachDBMpin; | ||
| 84 : | # The problem set record corresponding to the $probSetKey is now in %probSetRecord | ||
| 85 : | $flag; # 1 means you got something | ||
| 86 : | } | ||
| 87 : | sub saveProbSetRecord { # synonym for detachProbSetRecord | ||
| 88 : | detachProbSetRecord(@_); | ||
| 89 : | } | ||
| 90 : | sub detachProbSetRecord { #data is in probSetRecord | ||
| 91 : | my($probSetKey)=@_; | ||
| 92 : | my ($out,@ind,@setList,%setList,@loginList,%loginList); | ||
| 93 : | my ($setNumber, $loginID, $oldLoginID,$oldSetNumber, $recordString); | ||
| 94 : | &attachDBMpin('writer'); #attaches DBM file to %PROBSET | ||
| 95 : | # &attachDBMpin; # used to replace line above when experimenting with database attachment speed. | ||
| 96 : | # First get the old record so that we can see if either the loginID or the setNumber | ||
| 97 : | # has changed | ||
| 98 : | my %old_record_string = (); | ||
| 99 : | if (defined($PROBSET{$probSetKey}) ) { | ||
| 100 : | my $old_record_string = $PROBSET{$probSetKey}; | ||
| 101 : | $old_record_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. | ||
| 102 : | my @old_record_string = split(/[\&=]/,$old_record_string); | ||
| 103 : | %old_record_string = @old_record_string; | ||
| 104 : | } | ||
| 105 : | |||
| 106 : | |||
| 107 : | $oldLoginID = defined($old_record_string{'stlg'}) ? $old_record_string{'stlg'} : ""; | ||
| 108 : | $oldSetNumber = defined($old_record_string{'stnm'}) ? $old_record_string{'stnm'} : ""; | ||
| 109 : | $setNumber = $probSetRecord{'stnm'}; | ||
| 110 : | $loginID = $probSetRecord{'stlg'}; | ||
| 111 : | # Next prepare the new record and place it into %PROBSET DBM file | ||
| 112 : | $out=""; | ||
| 113 : | @ind=keys(%probSetRecord); | ||
| 114 : | my $i; | ||
| 115 : | foreach $i (@ind) { | ||
| 116 : | $out=$out . $i . '=' . $probSetRecord{$i} . "&" ; | ||
| 117 : | }; | ||
| 118 : | chop($out); #remove the final & from the string. | ||
| 119 : | |||
| 120 : | |||
| 121 : | $PROBSET{$probSetKey}=$out; | ||
| 122 : | |||
| 123 : | ## Updating the set index and the login index only has to be done if one of the | ||
| 124 : | ## items loginID or setNumber has changed or if they didn't exist before. | ||
| 125 : | |||
| 126 : | if ( defined($PROBSET{$probSetKey}) and | ||
| 127 : | ( $loginID eq $oldLoginID) and | ||
| 128 : | ($setNumber eq $oldSetNumber) | ||
| 129 : | ) { | ||
| 130 : | |||
| 131 : | # warn "saving DB -- no changes to indices"; | ||
| 132 : | } else { | ||
| 133 : | ## The rest of the code updates the index files if that is necessary. | ||
| 134 : | |||
| 135 : | ## First delete out of date information if setNumber or loginID has changed | ||
| 136 : | if ( defined($oldSetNumber) and defined($oldLoginID) and | ||
| 137 : | ( $setNumber ne $oldSetNumber or $loginID ne $oldLoginID ) | ||
| 138 : | ) { | ||
| 139 : | ## delete out of date reference to the oldLogin in the oldSetNumber | ||
| 140 : | |||
| 141 : | $recordString = $PROBSET{"set<>$oldSetNumber"}; | ||
| 142 : | $recordString = "" unless defined($recordString); | ||
| 143 : | my @oldSetList=split(/[\&=]/,$recordString); | ||
| 144 : | my %oldSetList=@oldSetList; | ||
| 145 : | delete $oldSetList{"$oldLoginID"}; | ||
| 146 : | $out = ""; | ||
| 147 : | my $indx; | ||
| 148 : | foreach $indx (keys %oldSetList) { | ||
| 149 : | $out=$out . $indx . '=' . $oldSetList{$indx} . "&" ; | ||
| 150 : | }; | ||
| 151 : | chop($out); #remove the final & from the string. | ||
| 152 : | if ($out eq "") { | ||
| 153 : | delete $PROBSET {"set<>$oldSetNumber"}; | ||
| 154 : | } else { | ||
| 155 : | $PROBSET{"set<>$oldSetNumber"}= $out; | ||
| 156 : | } | ||
| 157 : | |||
| 158 : | $recordString = $PROBSET{"login<>$oldLoginID"}; | ||
| 159 : | $recordString = "" unless defined($recordString); | ||
| 160 : | @loginList=split(/[\&=]/,$recordString); | ||
| 161 : | %loginList=@loginList; | ||
| 162 : | delete $loginList{"$oldSetNumber"}; | ||
| 163 : | $out = ""; | ||
| 164 : | my $i; | ||
| 165 : | foreach $i (keys %loginList) { | ||
| 166 : | $out=$out . $i . '=' . $loginList{$i} . "&" ; | ||
| 167 : | }; | ||
| 168 : | chop($out); #remove the final & from the string. | ||
| 169 : | if ($out eq "") { | ||
| 170 : | delete $PROBSET{"login<>$oldLoginID"}; | ||
| 171 : | } | ||
| 172 : | else { | ||
| 173 : | $PROBSET{"login<>$oldLoginID"}= $out; | ||
| 174 : | } | ||
| 175 : | } | ||
| 176 : | |||
| 177 : | |||
| 178 : | # Update index for sets: | ||
| 179 : | # For every set, this is a list containing all the loginID's for the set and the corresponding | ||
| 180 : | # psvn's. Each loginID and psvn can occur only once. Format loginID = psvn | ||
| 181 : | ## Now enter new data | ||
| 182 : | |||
| 183 : | $recordString = $PROBSET{"set<>$setNumber"}; | ||
| 184 : | $recordString = "" unless defined($recordString); | ||
| 185 : | @setList=split(/[\&=]/,$recordString); | ||
| 186 : | %setList=@setList; | ||
| 187 : | $setList{"$loginID"}=$probSetKey; | ||
| 188 : | @ind=keys(%setList); | ||
| 189 : | $out = ""; | ||
| 190 : | foreach $i (@ind) { | ||
| 191 : | $out=$out . $i . '=' . $setList{$i} . "&" ; | ||
| 192 : | }; | ||
| 193 : | chop($out); #remove the final & from the string. | ||
| 194 : | if ($out eq "") { | ||
| 195 : | delete $PROBSET {"set<>$setNumber"}; | ||
| 196 : | } | ||
| 197 : | else { | ||
| 198 : | $PROBSET{"set<>$setNumber"}= $out; | ||
| 199 : | } | ||
| 200 : | |||
| 201 : | # Update index for loginID's: | ||
| 202 : | # For every loginID, this is a list containing all sets for the loginID and the corresponding | ||
| 203 : | # psvn's. Each setNumber and psvn can occur only once. Format setNumber = psvn | ||
| 204 : | |||
| 205 : | |||
| 206 : | |||
| 207 : | ## Now enter new data | ||
| 208 : | # $recordString = ""; | ||
| 209 : | $recordString = $PROBSET{"login<>$loginID"}; | ||
| 210 : | $recordString = "" unless defined($recordString); | ||
| 211 : | @loginList=split(/[\&=]/,$recordString); | ||
| 212 : | %loginList=@loginList; | ||
| 213 : | $loginList{"$setNumber"}=$probSetKey; | ||
| 214 : | @ind=keys(%loginList); | ||
| 215 : | $out = ""; | ||
| 216 : | foreach $i (@ind) { | ||
| 217 : | $out=$out . $i . '=' . $loginList{$i} . "&" ; | ||
| 218 : | }; | ||
| 219 : | chop($out); #remove the final & from the string. | ||
| 220 : | if ($out eq "") { | ||
| 221 : | delete $PROBSET{"login<>$loginID"}; | ||
| 222 : | } | ||
| 223 : | else { | ||
| 224 : | $PROBSET{"login<>$loginID"}= $out; | ||
| 225 : | } | ||
| 226 : | my $temp_key; | ||
| 227 : | |||
| 228 : | |||
| 229 : | } | ||
| 230 : | if (&detachDBMpin) { | ||
| 231 : | return 1; # returns 1 if successful | ||
| 232 : | } else { | ||
| 233 : | wwerror("$0","DBglue.pl Error at line __LINE__ while saving database","",""); | ||
| 234 : | return 0; | ||
| 235 : | } | ||
| 236 : | # The contents of %probSetRecord has now been placed in the problem set record data | ||
| 237 : | # base with key given by $probSetRecord | ||
| 238 : | } | ||
| 239 : | |||
| 240 : | |||
| 241 : | |||
| 242 : | sub getProbSetRecord { #returns the contents of the current record hash | ||
| 243 : | %probSetRecord; | ||
| 244 : | } | ||
| 245 : | |||
| 246 : | sub deleteProbSetRecord { #also assumes that %kprobSetRecord is correctly loaded. | ||
| 247 : | my ($probSetKey)=@_; | ||
| 248 : | my ($out,@ind,@setList,%setList,@loginList,%loginList); | ||
| 249 : | my ($setNumber,$loginID,$recordString); | ||
| 250 : | my $flag = 1; | ||
| 251 : | $flag = $flag && &attachDBMpin('writer'); #attaches DBM file to %PROBSET # get the necessary data | ||
| 252 : | $setNumber = $probSetRecord{'stnm'}; | ||
| 253 : | $loginID = $probSetRecord{'stlg'}; | ||
| 254 : | # Update index for sets: | ||
| 255 : | |||
| 256 : | $recordString = $PROBSET{"set<>$setNumber"}; | ||
| 257 : | @setList=split(/[\&=]/,$recordString); | ||
| 258 : | %setList=@setList; | ||
| 259 : | delete $setList{"$loginID"}; | ||
| 260 : | @ind=keys(%setList); | ||
| 261 : | $out = ""; | ||
| 262 : | my $i; | ||
| 263 : | foreach $i (@ind) { | ||
| 264 : | $out=$out . $i . '=' . $setList{$i} . "&" ; | ||
| 265 : | }; | ||
| 266 : | chop($out); #remove the final & from the string. | ||
| 267 : | if ($out eq "") { | ||
| 268 : | delete( $PROBSET{"set<>$setNumber"}); | ||
| 269 : | } else { | ||
| 270 : | $PROBSET{"set<>$setNumber"}= $out; | ||
| 271 : | } | ||
| 272 : | |||
| 273 : | $recordString = $PROBSET{"login<>$loginID"}; | ||
| 274 : | @loginList=split(/[\&=]/,$recordString); | ||
| 275 : | %loginList=@loginList; | ||
| 276 : | delete $loginList{"$setNumber"}; | ||
| 277 : | @ind=keys(%loginList); | ||
| 278 : | $out=""; | ||
| 279 : | foreach $i (@ind) { | ||
| 280 : | $out=$out . $i . '=' . $loginList{$i} . '&' ; | ||
| 281 : | }; | ||
| 282 : | chop($out); #remove the final & from the string. | ||
| 283 : | if ($out eq "") { | ||
| 284 : | delete $PROBSET{"login<>$loginID"}; | ||
| 285 : | } | ||
| 286 : | else { | ||
| 287 : | $PROBSET{"login<>$loginID"}= $out; | ||
| 288 : | } | ||
| 289 : | # erase the record itself | ||
| 290 : | $flag=$flag && defined($PROBSET{$probSetKey}); | ||
| 291 : | delete $PROBSET{$probSetKey}; | ||
| 292 : | &detachDBMpin(); | ||
| 293 : | } | ||
| 294 : | |||
| 295 : | |||
| 296 : | #######StudentLogin########################### | ||
| 297 : | sub putStudentLogin { | ||
| 298 : | my ($val,$probSetKey) = @_; | ||
| 299 : | $probSetRecord{"stlg"}=$val; | ||
| 300 : | } | ||
| 301 : | sub getStudentLogin { | ||
| 302 : | my ($probSetKey) = @_; | ||
| 303 : | return( $probSetRecord{"stlg"} ); | ||
| 304 : | } | ||
| 305 : | |||
| 306 : | sub deleteStudentLogin { | ||
| 307 : | my ($probSetKey) = @_; | ||
| 308 : | delete $probSetRecord{"stlg"}; | ||
| 309 : | } | ||
| 310 : | |||
| 311 : | |||
| 312 : | #######SetNumber########################### | ||
| 313 : | sub putSetNumber { | ||
| 314 : | my ($val,$probSetKey) = @_; | ||
| 315 : | $probSetRecord{"stnm"}=$val; | ||
| 316 : | } | ||
| 317 : | sub getSetNumber { | ||
| 318 : | my ($probSetKey) = @_; | ||
| 319 : | return( $probSetRecord{"stnm"} ); | ||
| 320 : | } | ||
| 321 : | |||
| 322 : | sub deleteSetNumber { | ||
| 323 : | my ($probSetKey) = @_; | ||
| 324 : | delete $probSetRecord{"stnm"}; | ||
| 325 : | } | ||
| 326 : | |||
| 327 : | #######SetHeaderFileName########################### | ||
| 328 : | sub putSetHeaderFileName { | ||
| 329 : | my ($val,$probSetKey) = @_; | ||
| 330 : | $probSetRecord{"shfn"}=$val; | ||
| 331 : | } | ||
| 332 : | sub getSetHeaderFileName { | ||
| 333 : | my ($probSetKey) = @_; | ||
| 334 : | return( $probSetRecord{"shfn"} ); | ||
| 335 : | } | ||
| 336 : | |||
| 337 : | sub deleteSetHeaderFileName { | ||
| 338 : | my ($probSetKey) = @_; | ||
| 339 : | delete $probSetRecord{"shfn"}; | ||
| 340 : | } | ||
| 341 : | |||
| 342 : | #######ProbHeaderFileName########################### | ||
| 343 : | sub putProbHeaderFileName { | ||
| 344 : | my ($val,$probSetKey) = @_; | ||
| 345 : | $probSetRecord{"phfn"}=$val; | ||
| 346 : | } | ||
| 347 : | sub getProbHeaderFileName { | ||
| 348 : | my ($probSetKey) = @_; | ||
| 349 : | return( $probSetRecord{"phfn"} ); | ||
| 350 : | } | ||
| 351 : | |||
| 352 : | sub deleteProbHeaderFileName { | ||
| 353 : | my ($probSetKey) = @_; | ||
| 354 : | delete $probSetRecord{"phfn"}; | ||
| 355 : | } | ||
| 356 : | |||
| 357 : | #######OpenDate########################### | ||
| 358 : | sub putOpenDate { | ||
| 359 : | my ($val,$probSetKey) = @_; | ||
| 360 : | $probSetRecord{"opdt"}=$val; | ||
| 361 : | } | ||
| 362 : | sub getOpenDate { | ||
| 363 : | my ($probSetKey) = @_; | ||
| 364 : | return( $probSetRecord{"opdt"} ); | ||
| 365 : | } | ||
| 366 : | |||
| 367 : | sub deleteOpenDate { | ||
| 368 : | my ($probSetKey) = @_; | ||
| 369 : | delete $probSetRecord{"opdt"}; | ||
| 370 : | } | ||
| 371 : | |||
| 372 : | #######DueDate########################### | ||
| 373 : | sub putDueDate { | ||
| 374 : | my ($val,$probSetKey) = @_; | ||
| 375 : | $probSetRecord{"dudt"}=$val; | ||
| 376 : | } | ||
| 377 : | sub getDueDate { | ||
| 378 : | my ($probSetKey) = @_; | ||
| 379 : | return( $probSetRecord{"dudt"} ); | ||
| 380 : | } | ||
| 381 : | |||
| 382 : | sub deleteDueDate { | ||
| 383 : | my ($probSetKey) = @_; | ||
| 384 : | delete $probSetRecord{"dudt"}; | ||
| 385 : | } | ||
| 386 : | |||
| 387 : | #######AnswerDate########################### | ||
| 388 : | sub putAnswerDate { | ||
| 389 : | my ($val,$probSetKey) = @_; | ||
| 390 : | $probSetRecord{"andt"}=$val; | ||
| 391 : | } | ||
| 392 : | sub getAnswerDate { | ||
| 393 : | my ($probSetKey) = @_; | ||
| 394 : | return( $probSetRecord{"andt"} ); | ||
| 395 : | } | ||
| 396 : | |||
| 397 : | sub deleteAnswerDate { | ||
| 398 : | my ($probSetKey) = @_; | ||
| 399 : | delete $probSetRecord{"andt"}; | ||
| 400 : | } | ||
| 401 : | |||
| 402 : | |||
| 403 : | |||
| 404 : | #######ProblemFileName########################### | ||
| 405 : | sub putProblemFileName { | ||
| 406 : | my ($val,$probNum,$probSetKey) = @_; | ||
| 407 : | $probSetRecord{"pfn$probNum"}=$val; | ||
| 408 : | } | ||
| 409 : | sub getProblemFileName { | ||
| 410 : | my ($probNum,$probSetKey) = @_; | ||
| 411 : | return( $probSetRecord{"pfn$probNum"} ); | ||
| 412 : | } | ||
| 413 : | |||
| 414 : | sub deleteProblemFileName { | ||
| 415 : | my ($probNum,$probSetKey) = @_; | ||
| 416 : | delete $probSetRecord{"pfn$probNum"}; | ||
| 417 : | } | ||
| 418 : | |||
| 419 : | #######ProblemStudentAnswer########################### | ||
| 420 : | sub putProblemStudentAnswer { | ||
| 421 : | my ($val,$probNum,$probSetKey) = @_; | ||
| 422 : | $probSetRecord{"pan$probNum"}=$val; | ||
| 423 : | } | ||
| 424 : | sub getProblemStudentAnswer { | ||
| 425 : | my ($probNum,$probSetKey) = @_; | ||
| 426 : | return( $probSetRecord{"pan$probNum"} ); | ||
| 427 : | } | ||
| 428 : | |||
| 429 : | sub deleteProblemStudentAnswer { | ||
| 430 : | my ($probNum,$probSetKey) = @_; | ||
| 431 : | delete $probSetRecord{"pan$probNum"}; | ||
| 432 : | } | ||
| 433 : | |||
| 434 : | #######ProblemAttempted########################### | ||
| 435 : | sub putProblemAttempted { | ||
| 436 : | my ($val,$probNum,$probSetKey) = @_; | ||
| 437 : | $probSetRecord{"pat$probNum"}=$val; | ||
| 438 : | } | ||
| 439 : | sub getProblemAttempted { | ||
| 440 : | my ($probNum,$probSetKey) = @_; | ||
| 441 : | return( $probSetRecord{"pat$probNum"} ); | ||
| 442 : | } | ||
| 443 : | |||
| 444 : | sub deleteProblemAttempted { | ||
| 445 : | my ($probNum,$probSetKey) = @_; | ||
| 446 : | delete $probSetRecord{"pat$probNum"}; | ||
| 447 : | } | ||
| 448 : | |||
| 449 : | |||
| 450 : | #######ProblemStatus########################### | ||
| 451 : | sub putProblemStatus { | ||
| 452 : | my ($val,$probNum,$probSetKey) = @_; | ||
| 453 : | $val = 0 unless ($val =~/\w/); | ||
| 454 : | $probSetRecord{"pst$probNum"}=$val; | ||
| 455 : | } | ||
| 456 : | sub getProblemStatus { | ||
| 457 : | my ($probNum,$probSetKey) = @_; | ||
| 458 : | return( $probSetRecord{"pst$probNum"} ); | ||
| 459 : | } | ||
| 460 : | |||
| 461 : | sub deleteProblemStatus { | ||
| 462 : | my ($probNum,$probSetKey) = @_; | ||
| 463 : | delete $probSetRecord{"pst$probNum"}; | ||
| 464 : | } | ||
| 465 : | |||
| 466 : | #######ProblemNumOfCorrectAns########################### | ||
| 467 : | sub putProblemNumOfCorrectAns { | ||
| 468 : | my ($val,$probNum,$probSetKey) = @_; | ||
| 469 : | $probSetRecord{"pca$probNum"}=$val; | ||
| 470 : | } | ||
| 471 : | sub getProblemNumOfCorrectAns { | ||
| 472 : | my ($probNum,$probSetKey) = @_; | ||
| 473 : | my $out = 0; | ||
| 474 : | $out = $probSetRecord{"pca$probNum"} if defined($probSetRecord{"pca$probNum"}); | ||
| 475 : | return($out); | ||
| 476 : | } | ||
| 477 : | |||
| 478 : | sub deleteProblemNumOfCorrectAns { | ||
| 479 : | my ($probNum,$probSetKey) = @_; | ||
| 480 : | delete $probSetRecord{"pca$probNum"}; | ||
| 481 : | } | ||
| 482 : | |||
| 483 : | #######ProblemNumOfIncorrectAns########################### | ||
| 484 : | sub putProblemNumOfIncorrectAns { | ||
| 485 : | my ($val,$probNum,$probSetKey) = @_; | ||
| 486 : | $probSetRecord{"pia$probNum"}=$val; | ||
| 487 : | } | ||
| 488 : | sub getProblemNumOfIncorrectAns { | ||
| 489 : | my ($probNum,$probSetKey) = @_; | ||
| 490 : | my $out = 0; | ||
| 491 : | $out = $probSetRecord{"pia$probNum"} if defined($probSetRecord{"pia$probNum"}); | ||
| 492 : | return($out); | ||
| 493 : | } | ||
| 494 : | |||
| 495 : | sub deleteProblemNumOfIncorrectAns { | ||
| 496 : | my ($probNum,$probSetKey) = @_; | ||
| 497 : | delete $probSetRecord{"pia$probNum"}; | ||
| 498 : | } | ||
| 499 : | #######ProblemMaxNumOfIncorrectAttemps########################### | ||
| 500 : | sub putProblemMaxNumOfIncorrectAttemps { | ||
| 501 : | my ($val,$probNum,$probSetKey) = @_; | ||
| 502 : | $probSetRecord{"pmia$probNum"}=$val; | ||
| 503 : | } | ||
| 504 : | sub getProblemMaxNumOfIncorrectAttemps { | ||
| 505 : | my ($probNum,$probSetKey) = @_; | ||
| 506 : | my $out = $probSetRecord{"pmia$probNum"}; | ||
| 507 : | if ( (!defined($out)) or ($out eq '') or ($out < 0) | ||
| 508 : | ) { | ||
| 509 : | $out = -1; | ||
| 510 : | } else { | ||
| 511 : | $out = int($out); | ||
| 512 : | } | ||
| 513 : | return($out); | ||
| 514 : | } | ||
| 515 : | |||
| 516 : | sub deleteProblemMaxNumOfIncorrectAttemps { | ||
| 517 : | my ($probNum,$probSetKey) = @_; | ||
| 518 : | delete $probSetRecord{"pmia$probNum"}; | ||
| 519 : | } | ||
| 520 : | #######ProblemSeed########################### | ||
| 521 : | sub putProblemSeed { | ||
| 522 : | my ($val,$probNum,$probSetKey) = @_; | ||
| 523 : | $probSetRecord{"pse$probNum"}=$val; | ||
| 524 : | } | ||
| 525 : | sub getProblemSeed { | ||
| 526 : | my ($probNum,$probSetKey) = @_; | ||
| 527 : | return( $probSetRecord{"pse$probNum"} ); | ||
| 528 : | } | ||
| 529 : | |||
| 530 : | sub deleteProblemSeed { | ||
| 531 : | my ($probNum,$probSetKey) = @_; | ||
| 532 : | delete $probSetRecord{"pse$probNum"}; | ||
| 533 : | } | ||
| 534 : | |||
| 535 : | #######ProblemValue########################### | ||
| 536 : | sub putProblemValue { | ||
| 537 : | my ($val,$probNum,$probSetKey) = @_; | ||
| 538 : | $probSetRecord{"pva$probNum"}=$val; | ||
| 539 : | } | ||
| 540 : | sub getProblemValue { | ||
| 541 : | my ($probNum,$probSetKey) = @_; | ||
| 542 : | return( $probSetRecord{"pva$probNum"} ); | ||
| 543 : | } | ||
| 544 : | |||
| 545 : | sub deleteProblemValue { | ||
| 546 : | my ($probNum,$probSetKey) = @_; | ||
| 547 : | delete $probSetRecord{"pva$probNum"}; | ||
| 548 : | } | ||
| 549 : | |||
| 550 : | |||
| 551 : | ############Other methods######################### | ||
| 552 : | # &getAllProbSetKeys() | ||
| 553 : | |||
| 554 : | sub getAllProbSetKeys { | ||
| 555 : | &attachDBMpin(); | ||
| 556 : | my (@lst)=grep(/^[0-9]+$/ , keys %PROBSET); | ||
| 557 : | &detachDBMpin(); | ||
| 558 : | @lst; | ||
| 559 : | } | ||
| 560 : | # &getAllProbSetKeysForStudentLogin($StudentLogin) | ||
| 561 : | |||
| 562 : | sub getAllProbSetKeysForStudentLogin { | ||
| 563 : | my($studentLogin)=@_; | ||
| 564 : | my %hash = &getAllSetNumbersForStudentLoginHash($studentLogin); | ||
| 565 : | values %hash; | ||
| 566 : | } | ||
| 567 : | sub getAllSetNumbersForStudentLoginHash { | ||
| 568 : | my($studentLogin)=@_; | ||
| 569 : | my ($recordString,@loginList,%loginList); | ||
| 570 : | &attachDBMpin(); | ||
| 571 : | if (defined( $PROBSET{"login<>$studentLogin"}) ) { | ||
| 572 : | $recordString = $PROBSET{"login<>$studentLogin"}; | ||
| 573 : | } | ||
| 574 : | else { | ||
| 575 : | &Global::error("getAllSetNumbersForStudentLoginHash: Can't find index for login $studentLogin"); | ||
| 576 : | } | ||
| 577 : | &detachDBMpin(); | ||
| 578 : | @loginList=split(/[\&=]/,$recordString); | ||
| 579 : | %loginList=@loginList; | ||
| 580 : | # print "\n\n\n<p><H1>studentLogin $studentLogin</H1>\n\n"; | ||
| 581 : | # print "\n\n\n<p><H1>recordString $recordString</H1>\n\n"; | ||
| 582 : | # print "\n\n\n<p><H1>loginList %loginList</H1>\n\n"; | ||
| 583 : | %loginList; # (setNumber, psvn, 2, 5678, ...) | ||
| 584 : | } | ||
| 585 : | |||
| 586 : | # &getAllProbSetKeysForSet($setNumber); | ||
| 587 : | |||
| 588 : | sub getAllProbSetKeysForSet { | ||
| 589 : | my ($setNumber)=@_; | ||
| 590 : | my ($recordString,@setList,%setList); | ||
| 591 : | &attachDBMpin(); | ||
| 592 : | # read appropriate set index | ||
| 593 : | if (defined( $PROBSET{"set<>$setNumber"}) ){ | ||
| 594 : | $recordString = $PROBSET{"set<>$setNumber"}; | ||
| 595 : | @setList = split(/[\&=]/,$recordString); | ||
| 596 : | %setList=@setList; | ||
| 597 : | } | ||
| 598 : | else { | ||
| 599 : | &Global::error("DBglue: getAllProbSetKeysForSet: Can't find index for set number $setNumber" , | ||
| 600 : | 'One reason you will see this error is if there are no existing problem sets. For example | ||
| 601 : | you will get this error if you delete all problem sets and then return to the prof page or | ||
| 602 : | if you login and then goto Begin Problem Set when no problem sets exist. If this is the | ||
| 603 : | case (i.e. you have deleted all sets), you can log into the server, goto the directory | ||
| 604 : | .../DATA/ and rename (or delete) the file webwork-database (MAKE SURE YOU ARE DELETING OR | ||
| 605 : | RENAMING THE webwork-database FOR THE CORRECT COURSE). Then when you go to the prof page, | ||
| 606 : | you will be able to build new problem sets.' ); | ||
| 607 : | } | ||
| 608 : | &detachDBMpin(); | ||
| 609 : | |||
| 610 : | values %setList; # (psvn, psvn, ...) | ||
| 611 : | } | ||
| 612 : | |||
| 613 : | # &getLoginHashForSet($setNumber) | ||
| 614 : | # this is a hash containing all the loginID's (keys) for the set and the corresponding | ||
| 615 : | # psvn's (values). | ||
| 616 : | |||
| 617 : | sub getLoginHashForSet { | ||
| 618 : | my ($setNumber)=@_; | ||
| 619 : | my ($recordString,@setList,%setList); | ||
| 620 : | &attachDBMpin(); | ||
| 621 : | # read appropriate set index | ||
| 622 : | if (defined( $PROBSET{"set<>$setNumber"}) ){ | ||
| 623 : | $recordString = $PROBSET{"set<>$setNumber"}; | ||
| 624 : | @setList = split(/[\&=]/,$recordString); | ||
| 625 : | %setList=@setList; | ||
| 626 : | } | ||
| 627 : | else { | ||
| 628 : | &Global::error("DBglue: getLoginHashForSet: Can't find index for set number $setNumber" , | ||
| 629 : | 'One reason you will see this error is if there are no existing problem sets. For example you | ||
| 630 : | will get this error if you delete all problem sets and then return to the prof page or | ||
| 631 : | if you login and then goto Begin Problem Set when no problem sets exist.' ); | ||
| 632 : | } | ||
| 633 : | &detachDBMpin(); | ||
| 634 : | |||
| 635 : | \%setList; | ||
| 636 : | } | ||
| 637 : | |||
| 638 : | # &getPSVNHashForSet($setNumber) | ||
| 639 : | # this is a hash containing all the psvn's (keys) for the set and the corresponding | ||
| 640 : | # loginID's (values). | ||
| 641 : | |||
| 642 : | |||
| 643 : | sub getPSVNHashForSet { | ||
| 644 : | my ($setNumber)=@_; | ||
| 645 : | my %PSVNHashForSet = reverse %{getLoginHashForSet($setNumber)}; | ||
| 646 : | \%PSVNHashForSet; | ||
| 647 : | } | ||
| 648 : | |||
| 649 : | # &probSetExists($setNumber); | ||
| 650 : | |||
| 651 : | sub probSetExists { | ||
| 652 : | my ($setNumber)=@_; | ||
| 653 : | &attachDBMpin(); | ||
| 654 : | my $probSetExists = 0; | ||
| 655 : | if (defined( $PROBSET{"set<>$setNumber"}) ){$probSetExists = 1;} | ||
| 656 : | &detachDBMpin(); | ||
| 657 : | |||
| 658 : | $probSetExists; | ||
| 659 : | } | ||
| 660 : | |||
| 661 : | #sub getAllProbSetKeysForSetSortedByName { | ||
| 662 : | # my ($setNumber)=@_; | ||
| 663 : | # my @out = &getAllProbSetKeysForSet($setNumber); | ||
| 664 : | # &attachDBMpin(); | ||
| 665 : | # %MYPROBSET = %PROBSET; # byLastName needs this hash to sort with | ||
| 666 : | # &detachDBMpin(); | ||
| 667 : | # @out=sort (byLastName @out); | ||
| 668 : | # @out; | ||
| 669 : | #} | ||
| 670 : | |||
| 671 : | #sub getAllProbSetKeysForSetSortedBySectionThenByName { | ||
| 672 : | # my ($setNumber)=@_; | ||
| 673 : | # my @out = &getAllProbSetKeysForSet($setNumber); | ||
| 674 : | # &attachDBMpin(); | ||
| 675 : | # %MYPROBSET = %PROBSET; # bySectionThenByName needs this hash to sort with | ||
| 676 : | # &detachDBMpin(); | ||
| 677 : | # | ||
| 678 : | # | ||
| 679 : | # @out=sort (bySectionThenByName @out); | ||
| 680 : | # @out; | ||
| 681 : | #} | ||
| 682 : | |||
| 683 : | #sub getAllProbSetKeysForSetSortedByRecitationThenByName { | ||
| 684 : | # my ($setNumber)=@_; | ||
| 685 : | # my @out = &getAllProbSetKeysForSet($setNumber); | ||
| 686 : | # &attachDBMpin(); | ||
| 687 : | # %MYPROBSET = %PROBSET; # byRecitationThenByName needs this hash to sort with | ||
| 688 : | # &detachDBMpin(); | ||
| 689 : | # | ||
| 690 : | # | ||
| 691 : | # @out=sort (byRecitationThenByName @out); | ||
| 692 : | # @out; | ||
| 693 : | #} | ||
| 694 : | |||
| 695 : | #sub getStudentName { | ||
| 696 : | # my($probSetKey) = @_; | ||
| 697 : | # my($fname) = &getStudentFirstName($probSetKey); | ||
| 698 : | # my($lname) = &getStudentLastName($probSetKey); | ||
| 699 : | # $fname = '' unless defined $fname; | ||
| 700 : | # $lname = '' unless defined $lname; | ||
| 701 : | # my($out) = "$fname $lname"; | ||
| 702 : | # $out =~ s/\s\s+/ /g; # remove any extra spaces | ||
| 703 : | # $out; | ||
| 704 : | # } | ||
| 705 : | |||
| 706 : | sub getAllProblemsForProbSetRecord { | ||
| 707 : | my($probSetKey) = @_; | ||
| 708 : | my(@keyList) = sort grep ( s/pfn//, keys %probSetRecord ); | ||
| 709 : | @keyList; | ||
| 710 : | #Since each problem has a problem file name keyed by "pfn$probNum" | ||
| 711 : | # We select all keys beginning with pfn and delete the pfn part. | ||
| 712 : | # This method will break if the key names for the data base is changed. | ||
| 713 : | |||
| 714 : | } | ||
| 715 : | |||
| 716 : | #####################others ###################### | ||
| 717 : | #sub getAllProbSetKeysSortedByName { | ||
| 718 : | # | ||
| 719 : | # | ||
| 720 : | # &attachDBMpin(); | ||
| 721 : | # %MYPROBSET = %PROBSET; | ||
| 722 : | # &detachDBMpin(); | ||
| 723 : | # my @keyList = grep (/^\d+$/,keys %MYPROBSET); # allow only the psvn numbers to get through | ||
| 724 : | # @keyList = sort( byLastName @keyList); | ||
| 725 : | # @keyList; | ||
| 726 : | #} | ||
| 727 : | |||
| 728 : | |||
| 729 : | |||
| 730 : | |||
| 731 : | |||
| 732 : | |||
| 733 : | sub getAllProbSetNumbersHash { | ||
| 734 : | # get the entire hash array from GDBM and close the GDBM file | ||
| 735 : | &attachDBMpin(); | ||
| 736 : | my %MYPROBSET = %PROBSET; | ||
| 737 : | &detachDBMpin(); | ||
| 738 : | |||
| 739 : | my(%setNoHash); my($setNo); my %probSetRecord; my @probSetRecord; | ||
| 740 : | my(@keys) = grep(/^[0-9]+$/,keys %MYPROBSET); | ||
| 741 : | my $key; | ||
| 742 : | foreach $key (@keys) { | ||
| 743 : | # Split the record for each psvn and place it in the hash probSetRecord | ||
| 744 : | @probSetRecord=split(/[\&=]/, $MYPROBSET{$key}); | ||
| 745 : | push(@probSetRecord, " ") unless @probSetRecord %2 ==0; | ||
| 746 : | # a blank entry at the end of the string produces an odd number of elements. | ||
| 747 : | # I hope this hack doesn't mask other errors. | ||
| 748 : | %probSetRecord=@probSetRecord; | ||
| 749 : | # Extract the setnumber and build a has whose key is the set number and whose | ||
| 750 : | # value is a representative psvn (problem set version number) | ||
| 751 : | # The psvn provides a primary key for referencing other information in the database. | ||
| 752 : | $setNo = $probSetRecord{'stnm'}; | ||
| 753 : | $setNoHash{$setNo}=$key unless $setNoHash{$setNo}; | ||
| 754 : | } | ||
| 755 : | %setNoHash; | ||
| 756 : | } | ||
| 757 : | #### this will break if the codes are changed !!!!!!!! ############### | ||
| 758 : | |||
| 759 : | #sub byLastName { | ||
| 760 : | # $MYPROBSET{$a} =~ /stnm=([^&]*)/; | ||
| 761 : | # my $sn1 = $1; #set number sorted first | ||
| 762 : | # $MYPROBSET{$a} =~ /stln=([^&]*)/; | ||
| 763 : | # my $ln1 = $1; # then last name | ||
| 764 : | # $MYPROBSET{$a} =~ /stfn=([^&]*)/; | ||
| 765 : | # my $fn1= $1; # then first name | ||
| 766 : | # | ||
| 767 : | # $MYPROBSET{$b} =~ /stnm=([^&]*)/; | ||
| 768 : | # my $sn2 = $1; | ||
| 769 : | # $MYPROBSET{$b} =~ /stln=([^&]*)/; | ||
| 770 : | # my $ln2 = $1; | ||
| 771 : | # $MYPROBSET{$b} =~ /stfn=([^&]*)/; | ||
| 772 : | # my $fn2= $1; | ||
| 773 : | # my $t = $sn1 cmp $sn2; #compare set numbers (which might be names) | ||
| 774 : | # $t = $ln1 cmp $ln2 unless $t; # if set numbers are equal compare last name | ||
| 775 : | # $t = $fn1 cmp $fn2 unless $t; # if last names equal, compare first names | ||
| 776 : | # $t; | ||
| 777 : | #} | ||
| 778 : | ##### this will break if the codes are changed !!!!!!!! ############### | ||
| 779 : | #sub bySectionThenByName { | ||
| 780 : | # $MYPROBSET{$a} =~ /stnm=([^&]*)/; | ||
| 781 : | # my $sn1 = $1; #set number sorted first | ||
| 782 : | # $MYPROBSET{$a} =~ /clsn=([^&]*)/; | ||
| 783 : | # my $cs1 = $1; # then by class section | ||
| 784 : | # $MYPROBSET{$a} =~ /stln=([^&]*)/; | ||
| 785 : | # my $ln1 = $1; # then last name | ||
| 786 : | # $MYPROBSET{$a} =~ /stfn=([^&]*)/; | ||
| 787 : | # my $fn1= $1; # then first name | ||
| 788 : | # | ||
| 789 : | # $MYPROBSET{$b} =~ /stnm=([^&]*)/; | ||
| 790 : | # my $sn2 = $1; | ||
| 791 : | # $MYPROBSET{$b} =~ /clsn=([^&]*)/; | ||
| 792 : | # my $cs2 = $1; # then by class section | ||
| 793 : | # $MYPROBSET{$b} =~ /stln=([^&]*)/; | ||
| 794 : | # my $ln2 = $1; | ||
| 795 : | # $MYPROBSET{$b} =~ /stfn=([^&]*)/; | ||
| 796 : | # my $fn2= $1; | ||
| 797 : | # | ||
| 798 : | # my $t = $sn1 cmp $sn2; #compare set numbers (which might be names) | ||
| 799 : | # $t = $cs1 cmp $cs2 unless $t; # if set numbers are equal compare class section | ||
| 800 : | # $t = $ln1 cmp $ln2 unless $t; # if class sections are equal compare last name | ||
| 801 : | # $t = $fn1 cmp $fn2 unless $t; # if last names equal, compare first names | ||
| 802 : | # $t; | ||
| 803 : | #} | ||
| 804 : | # | ||
| 805 : | #sub byRecitationThenByName { | ||
| 806 : | # $MYPROBSET{$a} =~ /stnm=([^&]*)/; | ||
| 807 : | # my $sn1 = $1; #set number sorted first | ||
| 808 : | # $MYPROBSET{$a} =~ /clrc=([^&]*)/; | ||
| 809 : | # my $rc1 = $1; # then by class recitation | ||
| 810 : | # $MYPROBSET{$a} =~ /stln=([^&]*)/; | ||
| 811 : | # my $ln1 = $1; # then last name | ||
| 812 : | # $MYPROBSET{$a} =~ /stfn=([^&]*)/; | ||
| 813 : | # my $fn1= $1; # then first name | ||
| 814 : | # | ||
| 815 : | # $MYPROBSET{$b} =~ /stnm=([^&]*)/; | ||
| 816 : | # my $sn2 = $1; | ||
| 817 : | # $MYPROBSET{$b} =~ /clrc=([^&]*)/; | ||
| 818 : | # my $rc2 = $1; # then by class recitation | ||
| 819 : | # $MYPROBSET{$b} =~ /stln=([^&]*)/; | ||
| 820 : | # my $ln2 = $1; | ||
| 821 : | # $MYPROBSET{$b} =~ /stfn=([^&]*)/; | ||
| 822 : | # my $fn2= $1; | ||
| 823 : | # | ||
| 824 : | # my $t = $sn1 cmp $sn2; #compare set numbers (which might be names) | ||
| 825 : | # $t = $rc1 cmp $rc2 unless $t; # if set numbers are equal compare class recitation | ||
| 826 : | # $t = $ln1 cmp $ln2 unless $t; # if class sections are equal compare last name | ||
| 827 : | # $t = $fn1 cmp $fn2 unless $t; # if last names equal, compare first names | ||
| 828 : | # $t; | ||
| 829 : | #} | ||
| 830 : | |||
| 831 : | sub read_psvn_record { | ||
| 832 : | my ($dbObj_ref,$hash_ref, $file_name, $mode_flag, $permission) = @_; | ||
| 833 : | &Global::tie_hash('WW_FH',$dbObj_ref,$hash_ref, $file_name, $mode_flag, $permission); | ||
| 834 : | } | ||
| 835 : | |||
| 836 : | |||
| 837 : | sub save_psvn_record { | ||
| 838 : | my ($dbObj_ref, $hash_ref, $file_name) = @_; | ||
| 839 : | &Global::untie_hash('WW_FH',$dbObj_ref,$hash_ref, $file_name); | ||
| 840 : | } | ||
| 841 : | |||
| 842 : | |||
| 843 : | |||
| 844 : | #sub getLoginName_StudentID_Hash_from_WW_DB { | ||
| 845 : | # my @keylist = getAllProbSetKeys(); | ||
| 846 : | # my $key; | ||
| 847 : | # my %loginName_StudentID_Hash_from_WW_DB =(); | ||
| 848 : | # foreach $key (@keylist) { | ||
| 849 : | # attachProbSetRecord($key); | ||
| 850 : | # $loginName_StudentID_Hash_from_WW_DB{getStudentLogin($key)} = getStudentID($key); | ||
| 851 : | # } | ||
| 852 : | # \%loginName_StudentID_Hash_from_WW_DB; | ||
| 853 : | #} | ||
| 854 : | 1; | ||
| 855 : | |||
| 856 : | |||
| 857 : |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |