[system] / branches / rel-2-2-dev / webwork2 / lib / WeBWorK / DB.pm Repository:
ViewVC logotype

Diff of /branches/rel-2-2-dev/webwork2/lib/WeBWorK/DB.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 2105 Revision 2864
1################################################################################ 1################################################################################
2# WeBWorK Online Homework Delivery System 2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/DB.pm,v 1.46 2004/04/27 03:37:56 sh002i Exp $ 4# $CVSHeader: webwork2/lib/WeBWorK/DB.pm,v 1.55 2004/09/23 18:45:48 sh002i Exp $
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 6# This program is free software; you can redistribute it and/or modify it under
7# the terms of either: (a) the GNU General Public License as published by the 7# the terms of either: (a) the GNU General Public License as published by the
8# Free Software Foundation; either version 2, or (at your option) any later 8# Free Software Foundation; either version 2, or (at your option) any later
9# version, or (b) the "Artistic License" which comes with this package. 9# version, or (b) the "Artistic License" which comes with this package.
… …
149 149
150=head1 CONSTRUCTOR 150=head1 CONSTRUCTOR
151 151
152=over 152=over
153 153
154=item new($ce) 154=item new($dbLayout)
155 155
156The C<new> method creates a DB object and brings up the underlying 156The C<new> method creates a DB object and brings up the underlying schema/driver
157schema/driver structure according to the C<%dbLayout> hash in C<$ce>, a 157structure according to the hash referenced by C<$dbLayout>.
158WeBWorK::CourseEnvironment object.
159 158
160=back 159=back
161 160
162=head2 C<$dbLayout> Format 161=head2 C<$dbLayout> Format
163 162
… …
237=head1 METHODS 236=head1 METHODS
238 237
239=cut 238=cut
240 239
241################################################################################ 240################################################################################
241# general functions
242################################################################################
243
244=head2 General Methods
245
246=over
247
248=cut
249
250=item hashDatabaseOK($fix)
251
252If the schema module in use for the C<set> and C<problem> tables is
253WeBWorK::DB::Schema::GlobalTableEmulator, the database is checked to make sure
254that the "global user" exists and all sets and problems are assigned to it. If
255$fix is true, problems found will be fixed: A global user will be created and
256all sets/problems assigned to it.
257
258A list of values is returned. The first value is a boolean value indicating
259whether problems remain in the database after hashDatabaseOK() is called. The
260remaining values are a list of strings indicating the particular ways in which
261the database is (or was) broken.
262
263=cut
264
265sub hashDatabaseOK {
266 my ($self, $fix) = @_;
267
268 my $errorsExist;
269 my @results;
270
271 ##### do we need to run? #####
272
273 unless (ref $self->{set} eq "WeBWorK::DB::Schema::GlobalTableEmulator") {
274 #warn "hashDatabaseOK($fix): no checks necessary, set table does not use GlobalTableEmulator.\n";
275 return 1;
276 }
277
278 ##### is globalUserID defined? #####
279
280 my $globalUserID = $self->{set}->{params}->{globalUserID};
281 if ($globalUserID eq "") {
282 return 0, "globalUserID not specified (fix this in %dbLayout.)";
283 } else {
284 #warn "hashDatabaseOK($fix): globalUserID not empty ($globalUserID) -- good.\n";
285 }
286
287 ##### does a user with ID globalUserID exist? #####
288
289 my $GlobalUser = $self->getUser($globalUserID);
290 if (defined $GlobalUser) {
291 #warn "hashDatabaseOK($fix): user with ID '$globalUserID' exists -- good.\n";
292 } else {
293 #warn "hashDatabaseOK($fix): user with ID '$globalUserID' not found -- bad!\n";
294 if ($fix) {
295 $self->addUser($self->newUser(
296 user_id => $globalUserID,
297 first_name => "Global",
298 last_name => "User",
299 email_address => "",
300 student_id => $globalUserID,
301 status => "D",
302 section => "",
303 recitation => "",
304 comment => "This user is used to store data about global set and problem records when using a hash-style database.",
305 ));
306 push @results, "User $globalUserID does not exist -- FIXED.";
307 #warn "hashDatabaseOK($fix): created user with ID '$globalUserID' -- good.\n";
308 } else {
309 # at this point, we don't go on. no global user means everything below is going to fail.
310 return 0, "User $globalUserID does not exist.";
311 }
312 }
313
314 ##### are all sets assigned to the user with ID globalUserID? #####
315
316 # FIXME: this is way too slow!
317 #my @userSetIDs = $self->{set_user}->list(undef, undef);
318
319 # Timing Data
320 #
321 # old method:
322 # TIMING 36119 1 1087502726.923311 (0.139117) mth143: WeBWorK::DB::hashDatabaseOK: about to get orphaned UserSets
323 # TIMING 36119 1 1087502768.074221 (41.290027) mth143: WeBWorK::DB::hashDatabaseOK: done getting orphaned UserSets
324 #
325 # new method:
326 # TIMING 36134 0 1087502854.579133 (0.141437) mth143: WeBWorK::DB::hashDatabaseOK: about to get orphaned UserSets
327 # TIMING 36134 0 1087502856.852504 (2.414808) mth143: WeBWorK::DB::hashDatabaseOK: done getting orphaned UserSets
328 #
329 # yay!
330
331 $WeBWorK::timer->continue(__PACKAGE__ . "::hashDatabaseOK: about to get orphaned UserSets") if defined $WeBWorK::timer;
332
333 # ... so instead, we're going to do things manually
334
335 # key: setID, value: hash of userIDs of users to whom this set is assigned
336 my %orphanUserSets;
337
338 if (ref $self->{set_user} eq "WeBWorK::DB::Schema::WW1Hash") {
339 # we can only do this with WW1Hash
340 #warn "the fast way!\n";
341
342 # connect
343 $self->{set_user}->{driver}->connect("ro")
344 or return 0, @results, "Failed to connect to set_user database.";
345
346 # get PSVNs for global user ( N)
347 # this reads from "login<>global_user"
348 my @globalUserPSVNs = $self->{set_user}->getPSVNsForUser($globalUserID);
349 #warn "found ", scalar @globalUserPSVNs, " PSVNs for the global user.\n";
350
351 # get setIDs for PSVNs (M)
352 my @globalUserSetIDs;
353 foreach my $PSVN (@globalUserPSVNs) {
354 #warn "getting setID for PSVN '$PSVN'...\n";
355 my $string = $self->{set_user}->fetchString($PSVN);
356 my (undef, $setID) = $self->{set_user}->string2IDs($string); # discard userID, problemIDs
357 push @globalUserSetIDs, $setID;
358 #warn "got setID '$setID'\n";
359 }
360
361 # get PSVNs for each setID ( N*M)
362 # this reads from "set<>$_"
363 my @okPSVNs = map { $self->{set_user}->getPSVNsForSet($_) } @globalUserSetIDs;
364 #warn "found ", scalar @okPSVNs, " PSVNs for sets assigned to the global user.\n";
365
366 # get all PSVNs (N*M)
367 # uses: grep { m/^\d+$/ } keys %{ $self->{driver}->hash() }
368 my @allPSVNs = $self->{set_user}->getAllPSVNs;
369 #warn "found ", scalar @allPSVNs, " PSVNs total.\n";
370
371 # eliminate PSVNs of sets that are assigned to the global user
372 my %allPSVNs;
373 @allPSVNs{@allPSVNs} = ();
374
375 foreach my $PSVN (@okPSVNs) {
376 delete $allPSVNs{$PSVN};
377 }
378
379 #warn "the orphan PSVNs are: ", join(", ", keys %allPSVNs), "\n";
380
381 # get setIDs for orphan PSVNs
382 foreach my $PSVN (keys %allPSVNs) {
383 #warn "getting userID and setID for PSVN '$PSVN'...\n";
384 my $string = $self->{set_user}->fetchString($PSVN);
385 my ($userID, $setID) = $self->{set_user}->string2IDs($string);
386 $orphanUserSets{$setID}->{$userID} = 1;
387 #warn "got setID '$setID' for userID '$userID'\n";
388 }
389
390 # disconnect
391 $self->{set_user}->{driver}->disconnect;
392 } else {
393 # otherwise, do it the slow way (maybe it's not slow with some other schema?)
394 #warn "oddly enough, set_user isn't using WW1Hash, so we have to use the slow list() method";
395 my @userSetIDs = $self->{set_user}->list(undef, undef);
396
397 foreach my $userSetID (@userSetIDs) {
398 my ($userID, $setID) = @$userSetID;
399 $orphanUserSets{$setID}->{$userID} = 1;
400 }
401
402 foreach my $setID (keys %orphanUserSets) {
403 delete $orphanUserSets{$setID}
404 if exists $orphanUserSets{$setID}->{$globalUserID};
405 }
406 }
407
408 $WeBWorK::timer->continue(__PACKAGE__ . "::hashDatabaseOK: done getting orphaned UserSets") if defined $WeBWorK::timer;
409
410 if (keys %orphanUserSets) {
411 foreach my $setID (keys %orphanUserSets) {
412 # detect "false positives" -- sets that are assigned to the global user
413 # but for some reason don't appear in any set index.
414 if ($self->{set_user}->exists($globalUserID, $setID)) {
415 my @userIDs = keys %{$orphanUserSets{$setID}};
416 warn "Set ID '$setID' for users '@userIDs' do not appear in any set index. Index re-build recommended.\n";
417 push @results, "Set ID '$setID' for users '@userIDs' do not appear in any set index. Index re-build recommended.\n";
418 } else {
419 if ($fix) {
420 my ($userID) = keys %{$orphanUserSets{$setID}};
421
422 # grab the first UserSet of this set (connect and disconnect required for get1*)
423 $self->{set_user}->{driver}->connect("ro")
424 or return 0, @results, "Failed to connect to set_user database.";
425 my $RawUserSet = $self->{set_user}->get1NoFilter($userID, $setID);
426 my @RawUserProblems = $self->{problem_user}->getAllNoFilter($userID, $setID);
427 $self->{set_user}->{driver}->disconnect();
428 unless ($RawUserSet) {
429 warn "failed to fetch UserSet '$setID' for user '$userID'!\n";
430 next;
431 }
432
433 # change user ID to globalUserID and add to database
434 $RawUserSet->user_id($globalUserID);
435 $self->{set_user}->add($RawUserSet);
436 foreach my $RawUserProblem (@RawUserProblems) {
437 $RawUserProblem->user_id($globalUserID);
438 $self->{problem_user}->add($RawUserProblem);
439 #warn "hashDatabaseOK($fix): assigned problem '", $RawUserProblem->problem_id, "' from set '$setID' to global user '$globalUserID' -- good.\n";
440 }
441
442 #warn "hashDatabaseOK($fix): assigned set '$setID' to global user '$globalUserID' -- good.\n";
443 push @results, "Set '$setID' not assigned to global user '$globalUserID' -- FIXED.";
444 } else {
445 #warn "hashDatabaseOK($fix): set '$setID' not assigned to global user '$globalUserID' -- bad!\n";
446 push @results, "Set '$setID' not assigned to global user '$globalUserID'.";
447 }
448 }
449 }
450 } else {
451 #warn "hashDatabaseOK($fix): all sets assigned to global user '$globalUserID' -- good.\n";
452 }
453
454 ##### done! #####
455
456 my $status = not $errorsExist;
457 return $status, @results;
458}
459
460=back
461
462=cut
463
464################################################################################
242# password functions 465# password functions
243################################################################################ 466################################################################################
244 467
245=head2 Password Methods 468=head2 Password Methods
246 469
… …
340 563
341 for (my $i = 0; $i < @Passwords; $i++) { 564 for (my $i = 0; $i < @Passwords; $i++) {
342 my $Password = $Passwords[$i]; 565 my $Password = $Passwords[$i];
343 my $userID = $userIDs[$i]; 566 my $userID = $userIDs[$i];
344 if (not defined $Password) { 567 if (not defined $Password) {
345 #warn "not defined\n";
346 if ($self->{user}->exists($userID)) { 568 if ($self->{user}->exists($userID)) {
347 #warn "user exists\n";
348 $Password = $self->newPassword(user_id => $userID); 569 $Password = $self->newPassword(user_id => $userID);
349 eval { $self->addPassword($Password) }; 570 eval { $self->addPassword($Password) };
350 if ($@ and $@ !~ m/password exists/) { 571 if ($@ and $@ !~ m/password exists/) {
351 die "error while auto-creating password record for user $userID: \"$@\""; 572 die "error while auto-creating password record for user $userID: \"$@\"";
352 } 573 }
… …
359 580
360=item putPassword($Password) 581=item putPassword($Password)
361 582
362$Password is a record object. If a password record with the same user ID exists 583$Password is a record object. If a password record with the same user ID exists
363in the password table, the data in the record is replaced with the data in 584in the password table, the data in the record is replaced with the data in
364$Password. If a matching password record does not exist, an exception is 585$Password. If a matching password record does not exist, one will be created.
365thrown. 586(This is different from most other "put" methods.)
366 587
367=cut 588=cut
368 589
369sub putPassword($$) { 590sub putPassword($$) {
370 my ($self, $Password) = @_; 591 my ($self, $Password) = @_;
… …
374 croak "putPassword: argument 1 must be of type ", $self->{password}->{record} 595 croak "putPassword: argument 1 must be of type ", $self->{password}->{record}
375 unless ref $Password eq $self->{password}->{record}; 596 unless ref $Password eq $self->{password}->{record};
376 597
377 checkKeyfields($Password); 598 checkKeyfields($Password);
378 599
379 croak "putPassword: password not found (perhaps you meant to use addPassword?)" 600 # For Passwords and PermissionLevels, auto-create a record when it doesn't
601 # already exist. This should be safe.
380 unless $self->{password}->exists($Password->user_id); 602 if ($self->{password}->exists($Password->user_id)) {
381
382 return $self->{password}->put($Password); 603 return $self->{password}->put($Password);
604 } else {
605 return $self->addPassword($Password);
606 }
383} 607}
384 608
385=item deletePassword($userID) 609=item deletePassword($userID)
386 610
387If a password record with a user ID matching $userID exists in the password 611If a password record with a user ID matching $userID exists in the password
… …
507 731
508 for (my $i = 0; $i < @PermissionLevels; $i++) { 732 for (my $i = 0; $i < @PermissionLevels; $i++) {
509 my $PermissionLevel = $PermissionLevels[$i]; 733 my $PermissionLevel = $PermissionLevels[$i];
510 my $userID = $userIDs[$i]; 734 my $userID = $userIDs[$i];
511 if (not defined $PermissionLevel) { 735 if (not defined $PermissionLevel) {
512 #warn "not defined\n";
513 if ($self->{user}->exists($userID)) { 736 if ($self->{user}->exists($userID)) {
514 #warn "user exists\n";
515 $PermissionLevel = $self->newPermissionLevel(user_id => $userID); 737 $PermissionLevel = $self->newPermissionLevel(user_id => $userID);
516 warn $PermissionLevel->toString, "\n";
517 eval { $self->addPermissionLevel($PermissionLevel) }; 738 eval { $self->addPermissionLevel($PermissionLevel) };
518 if ($@ and $@ !~ m/permission level exists/) { 739 if ($@ and $@ !~ m/permission level exists/) {
519 die "error while auto-creating permission level record for user $userID: \"$@\""; 740 die "error while auto-creating permission level record for user $userID: \"$@\"";
520 } 741 }
521 $PermissionLevels[$i] = $PermissionLevel; 742 $PermissionLevels[$i] = $PermissionLevel;
… …
529=item putPermissionLevel($PermissionLevel) 750=item putPermissionLevel($PermissionLevel)
530 751
531$PermissionLevel is a record object. If a permission level record with the same 752$PermissionLevel is a record object. If a permission level record with the same
532user ID exists in the permission table, the data in the record is replaced with 753user ID exists in the permission table, the data in the record is replaced with
533the data in $PermissionLevel. If a matching permission level record does not 754the data in $PermissionLevel. If a matching permission level record does not
534exist, an exception is thrown. 755exist, one will be created. (This is different from most other "put" methods.)
535 756
536=cut 757=cut
537 758
538sub putPermissionLevel($$) { 759sub putPermissionLevel($$) {
539 my ($self, $PermissionLevel) = @_; 760 my ($self, $PermissionLevel) = @_;
… …
543 croak "putPermissionLevel: argument 1 must be of type ", $self->{permission}->{record} 764 croak "putPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}
544 unless ref $PermissionLevel eq $self->{permission}->{record}; 765 unless ref $PermissionLevel eq $self->{permission}->{record};
545 766
546 checkKeyfields($PermissionLevel); 767 checkKeyfields($PermissionLevel);
547 768
548 croak "putPermissionLevel: permission level not found (perhaps you meant to use addPermissionLevel?)" 769 # For Passwords and PermissionLevels, auto-create a record when it doesn't
770 # already exist. This should be safe.
549 unless $self->{permission}->exists($PermissionLevel->user_id); 771 if ($self->{permission}->exists($PermissionLevel->user_id)) {
550
551 return $self->{permission}->put($PermissionLevel); 772 return $self->{permission}->put($PermissionLevel);
773 } else {
774 return $self->{permission}->add($PermissionLevel);
775 }
552} 776}
553 777
554=item deletePermissionLevel($userID) 778=item deletePermissionLevel($userID)
555 779
556If a permission level record with a user ID matching $userID exists in the 780If a permission level record with a user ID matching $userID exists in the
… …
1017} 1241}
1018 1242
1019sub countSetUsers { 1243sub countSetUsers {
1020 my ($self, $setID) = @_; 1244 my ($self, $setID) = @_;
1021 1245
1246 croak "countSetUsers: requires 1 argument"
1247 unless @_ == 2;
1248 croak "countSetUsers: argument 1 must contain a set_id"
1249 unless defined $setID;
1250
1251 # inefficient way
1252 #return scalar $self->{set_user}->list(undef, $setID);
1253
1254 # efficient way
1255 return $self->{set_user}->count(undef, $setID);
1256}
1257
1258sub listSetUsers {
1259 my ($self, $setID) = @_;
1260
1261 carp "listSetUsers called in SCALAR context: use countSetUsers instead!\n"
1262 unless wantarray;
1263
1022 croak "listSetUsers: requires 1 argument" 1264 croak "listSetUsers: requires 1 argument"
1023 unless @_ == 2; 1265 unless @_ == 2;
1024 croak "listSetUsers: argument 1 must contain a set_id" 1266 croak "listSetUsers: argument 1 must contain a set_id"
1025 unless defined $setID; 1267 unless defined $setID;
1026 1268
1027 # inefficient way
1028 #return scalar $self->{set_user}->list(undef, $setID);
1029
1030 # efficient way
1031 return $self->{set_user}->count(undef, $setID);
1032}
1033
1034sub listSetUsers {
1035 my ($self, $setID) = @_;
1036
1037 carp "listSetUsers called in SCALAR context: use countSetUsers instead!\n"
1038 unless wantarray;
1039
1040 croak "listSetUsers: requires 1 argument"
1041 unless @_ == 2;
1042 croak "listSetUsers: argument 1 must contain a set_id"
1043 unless defined $setID;
1044
1045 return map { $_->[0] } # extract user_id 1269 return map { $_->[0] } # extract user_id
1046 $self->{set_user}->list(undef, $setID); 1270 $self->{set_user}->list(undef, $setID);
1271}
1272
1273sub countUserSets {
1274 my ($self, $userID) = @_;
1275
1276 croak "countUserSets: requires 1 argument"
1277 unless @_ == 2;
1278 croak "countUserSets: argument 1 must contain a user_id"
1279 unless defined $userID;
1280
1281 return $self->{set_user}->count($userID, undef);
1047} 1282}
1048 1283
1049sub listUserSets { 1284sub listUserSets {
1050 my ($self, $userID) = @_; 1285 my ($self, $userID) = @_;
1051 1286
… …
1583 for (my $i = 0; $i < @UserSets; $i++) { 1818 for (my $i = 0; $i < @UserSets; $i++) {
1584 my $UserSet = $UserSets[$i]; 1819 my $UserSet = $UserSets[$i];
1585 my $GlobalSet = $GlobalSets[$i]; 1820 my $GlobalSet = $GlobalSets[$i];
1586 next unless defined $UserSet and defined $GlobalSet; 1821 next unless defined $UserSet and defined $GlobalSet;
1587 foreach my $field (@commonFields) { 1822 foreach my $field (@commonFields) {
1588 next if defined $UserSet->$field; 1823 #next if defined $UserSet->$field;
1824 # ok, now we're testing for emptiness as well as definedness.
1825 next if defined $UserSet->$field and $UserSet->$field ne "";
1589 $UserSet->$field($GlobalSet->$field); 1826 $UserSet->$field($GlobalSet->$field);
1590 } 1827 }
1591 } 1828 }
1592 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer); 1829 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
1593 1830
… …
1684 next unless defined $UserProblem and defined $GlobalProblem; 1921 next unless defined $UserProblem and defined $GlobalProblem;
1685 foreach my $field (@commonFields) { 1922 foreach my $field (@commonFields) {
1686 # FIXME: WW1Hash upgrades undefined fileds to "" when creating record objects 1923 # FIXME: WW1Hash upgrades undefined fileds to "" when creating record objects
1687 # Shouldn't we be testing for emptiness rather than definedness? 1924 # Shouldn't we be testing for emptiness rather than definedness?
1688 # I think the spec says that if a field is EMPTY the global value is used. 1925 # I think the spec says that if a field is EMPTY the global value is used.
1689 next if defined $UserProblem->$field; 1926 #next if defined $UserProblem->$field;
1927 # ok, now we're testing for emptiness as well as definedness.
1928 next if defined $UserProblem->$field and $UserProblem->$field ne "";
1690 $UserProblem->$field($GlobalProblem->$field); 1929 $UserProblem->$field($GlobalProblem->$field);
1691 } 1930 }
1692 } 1931 }
1693 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer); 1932 $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
1694 1933
Legend:
Removed from v.2105  
changed lines
  Added in v.2864
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9