Parent Directory
|
Revision Log
Several changes to the DB system: Made all schemas subclasses of WeBWorK::DB::Schema, factored common constructor code out into Schema.pm. Made all drivers subclasses of WeBWorK::DB::Schema, factored common constructor code out into Driver.pm. Removed superfluous style() and tables() functions from schemas and drivers. (You can treat the constants in which these are defined as functions, and call them like $object->STYLE or $object->STYLE().) WeBWorK::DB now tries to build all tables defined in %dbLayout, instead of using its own internal list. (TODO: add warnings if known tables are not built or unknown tables are built.) Made the error messages given during DB instantiation a little more intelligent. Changed the behavior of the exists() and delete() schema methods in all schemas (and updated the docs) s.t. not all elements of @keyparts have to be defined. Changed WeBWorK::DB to allow undefined values to be passed instead of IDs in delete* method calls, but only if the call was made from WeBWorK::DB itself (to protect you from accidentally passing an undefined value and clobbering your whole database). Changed delete functions to be more efficient. For example, deleteGlobalSet no longer has to say: $self->deleteUserSet($_, $setID) foreach $self->listSetUsers($setID); $self->deleteGlobalProblem($setID, $_) foreach $self->listGlobalProblems($setID); Instead it says: $self->deleteUserSet(undef, $setID); $self->deleteGlobalProblem($setID, undef); This is somewhat more efficient with hash-style schemas, and MUCH more efficient with the SQL schema. As usual, be wary of lingering bugs. w00t! -sam
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::DB::Schema::GlobalTableEmulator; 7 use base qw(WeBWorK::DB::Schema); 8 9 =head1 NAME 10 11 WeBWorK::DB::Schema::GlobalTableEmulator - emulate the global 'set' and 12 'problem' tables using access to the 'set_user' and 'problem_user' tables. 13 14 =cut 15 16 use strict; 17 use warnings; 18 use Data::Dumper; 19 use WeBWorK::DB::Utils qw(global2user user2global initializeUserProblem findDefaults); 20 21 use constant TABLES => qw(set problem); 22 use constant STYLE => "null"; 23 24 ################################################################################ 25 # constructor 26 ################################################################################ 27 28 sub new($$$) { 29 my ($proto, $db, $driver, $table, $record, $params) = @_; 30 31 die "parameter globalUserID not found" 32 unless exists $params->{globalUserID}; 33 34 my $self = $proto->SUPER::new($db, $driver, $table, $record, $params); 35 36 return $self; 37 } 38 39 ################################################################################ 40 # table access functions 41 ################################################################################ 42 43 sub list($@) { 44 my ($self, @keyparts) = @_; 45 46 my $db = $self->{db}; 47 my $table = $self->{table}; 48 my $userSchema = $db->{"${table}_user"}; 49 my $globalUserID = $self->{params}->{globalUserID}; 50 51 my @userRecordIDs = $userSchema->list($globalUserID, @keyparts); 52 my @recordIDs; 53 foreach my $userRecordID (@userRecordIDs) { 54 shift @$userRecordID; # take off the userID 55 push @recordIDs, $userRecordID; 56 } 57 58 return @recordIDs; 59 } 60 61 sub exists($@) { 62 my ($self, @keyparts) = @_; 63 64 my $db = $self->{db}; 65 my $table = $self->{table}; 66 my $userSchema = $db->{"${table}_user"}; 67 my $globalUserID = $self->{params}->{globalUserID}; 68 69 return $userSchema->exists($globalUserID, @keyparts); 70 } 71 72 sub add($$) { 73 my ($self, $Record) = @_; 74 75 my $db = $self->{db}; 76 my $table = $self->{table}; 77 my $userSchema = $db->{"${table}_user"}; 78 my $globalUserID = $self->{params}->{globalUserID}; 79 80 # make sure record doesn't already exist 81 my $setID = $Record->set_id(); 82 if ($self->{table} eq "set") { 83 die "($setID): Set exists.\n" 84 if $self->exists($setID); 85 } elsif ($self->{table} eq "problem") { 86 my $problemID = $Record->problem_id(); 87 die "($setID, $problemID): Problem exists.\n" 88 if $self->exists($setID, $problemID); 89 } 90 91 # convert global record to a user record for user $globalUserID 92 my $UserRecord = global2user($userSchema->{record}, $Record); 93 $UserRecord->user_id($globalUserID); 94 95 # if this is the problem table, set the user-specific fields of the user 96 # problem to sane defaults (and generate a problem seed). this allows 97 # the user $globalUserID to use this problem as a user problem. 98 if ($table eq "problem") { 99 initializeUserProblem($UserRecord); 100 } 101 102 # add the record to the database 103 return $userSchema->add($UserRecord); 104 } 105 106 sub get($@) { 107 my ($self, @keyparts) = @_; 108 109 my $db = $self->{db}; 110 my $table = $self->{table}; 111 my $userSchema = $db->{"${table}_user"}; 112 my $globalUserID = $self->{params}->{globalUserID}; 113 114 my $UserRecord = $userSchema->get($globalUserID, @keyparts); 115 return unless $UserRecord; # maybe it didn't exist? 116 return user2global($self->{record}, $UserRecord); 117 } 118 119 sub put($$) { 120 my ($self, $Record) = @_; 121 122 my $db = $self->{db}; 123 my $table = $self->{table}; 124 my $userSchema = $db->{"${table}_user"}; 125 my $classlistSchema = $db->{"user"}; # oh god. 126 my $globalUserID = $self->{params}->{globalUserID}; 127 128 my @keyparts = map { $Record->$_() } $Record->KEYFIELDS(); 129 130 # retrieve the current global values for this record 131 my $CurrentUserRecord = $userSchema->get($globalUserID, @keyparts); 132 my $CurrentGlobalRecord = user2global($self->{record}, $CurrentUserRecord); 133 134 # convert new global record to a user record for user $globalUserID 135 my $NewUserRecord = global2user($userSchema->{record}, $Record); 136 $NewUserRecord->user_id($globalUserID); 137 138 # if this is the problem table, copy the user-specific fields of the 139 # user problem from the old global record. this allows the user 140 # $globalUserID to use this problem as a user problem. 141 if ($table eq "problem") { 142 foreach my $field (qw(status attempted num_correct num_incorrect problem_seed)) { 143 my $currentValue = $CurrentUserRecord->$field; 144 $NewUserRecord->$field($currentValue); 145 } 146 } 147 # *** WARNING: here is a place where field names are referenced directly 148 149 # store user record containing new global values 150 my $result = $userSchema->put($NewUserRecord); 151 152 # distribute new global values to each user 153 # don't overwrite the user record that's storing global values 154 my @userIDs = grep { $_ ne $globalUserID } $classlistSchema->list(undef); 155 $self->distGlobalValues($CurrentGlobalRecord, $Record, @userIDs); 156 157 return $result; 158 } 159 160 sub delete($@) { 161 my ($self, @keyparts) = @_; 162 163 my $db = $self->{db}; 164 my $table = $self->{table}; 165 my $userSchema = $db->{"${table}_user"}; 166 my $globalUserID = $self->{params}->{globalUserID}; 167 168 # we can assume that DB has already deleted all the user-specific 169 # records it could find. we can just go ahead and delete the one 170 # that's being used as a global record (if it exists). 171 172 return $userSchema->delete($globalUserID, @keyparts); 173 } 174 175 ################################################################################ 176 # function to distribute new global values to each user-specific record 177 ################################################################################ 178 179 sub distGlobalValues($$$@) { 180 my ($self, $OldGlobalRecord, $NewGlobalRecord, @userIDs) = @_; 181 182 my $db = $self->{db}; 183 my $table = $self->{table}; 184 my $userSchema = $db->{"${table}_user"}; 185 186 my @keyparts = map { $NewGlobalRecord->$_() } $NewGlobalRecord->KEYFIELDS(); 187 188 # figure out which fields (if any) were changed 189 my @changedFields; 190 foreach my $field ($OldGlobalRecord->FIELDS()) { 191 if ($OldGlobalRecord->$field() ne $NewGlobalRecord->$field()) { 192 push @changedFields, $field; 193 } 194 } 195 196 # if no fields were changed, we're done 197 return 0 unless @changedFields; 198 199 # impose the new values for each user 200 my $anyChanged = 0; 201 foreach my $userID (@userIDs) { 202 my $UserRecord = $userSchema->get($userID, @keyparts); 203 next unless defined $UserRecord; 204 my $changed = 0; 205 foreach my $field (@changedFields) { 206 if ($UserRecord->$field() eq $OldGlobalRecord->$field()) { 207 $changed = 1; 208 $UserRecord->$field($NewGlobalRecord->$field()); 209 } 210 } 211 if ($changed) { 212 $anyChanged = 1; 213 $userSchema->put($UserRecord); 214 } 215 } 216 217 return $anyChanged; 218 } 219 220 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |