[system] / trunk / webwork2 / lib / WeBWorK / DB / Schema / WW1Hash.pm Repository:
ViewVC logotype

Diff of /trunk/webwork2/lib/WeBWorK/DB/Schema/WW1Hash.pm

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

Revision 807 Revision 808
1################################################################################ 1################################################################################
2# WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 2# WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
3# $Id$ 3# $Id$
4################################################################################ 4################################################################################
5 5
6package WeBWorK::DB::Schema::Classlist1Hash; 6package WeBWorK::DB::Schema::WW1Hash;
7 7
8=head1 NAME 8=head1 NAME
9 9
10WeBWorK::DB::Schema::Classlist1Hash - support access to the user table with a 10WeBWorK::DB::Schema::WW1Hash - support access to the set_user and problem_user
111.x-structured hash-style backend. 11tables with a WWDBv1 hash-style backend.
12 12
13=cut 13=cut
14 14
15use strict; 15use strict;
16use warnings; 16use warnings;
17use WeBWorK::DB::Record::User; 17use Data::Dumper;
18use WeBWorK::DB::Utils qw(record2hash hash2record hash2string string2hash); 18use WeBWorK::DB::Utils qw(record2hash hash2record hash2string string2hash);
19 19
20use constant TABLES => qw(user); 20use constant TABLES => qw(set_user problem_user);
21use constant STYLE => "hash"; 21use constant STYLE => "hash";
22
23use constant LOGIN_PREFIX => "login<>";
24use constant SET_PREFIX => "set<>";
25use constant MAX_PSVN_GENERATION_ATTEMPTS => 200;
22 26
23################################################################################ 27################################################################################
24# static functions 28# static functions
25################################################################################ 29################################################################################
26 30
… …
35################################################################################ 39################################################################################
36# constructor 40# constructor
37################################################################################ 41################################################################################
38 42
39sub new($$$) { 43sub new($$$) {
40 my ($proto, $driver, $table) = @_; 44 my ($proto, $driver, $table, $record, $params) = @_;
41 my $class = ref($proto) || $proto; 45 my $class = ref($proto) || $proto;
42 die "$table: unsupported table" 46 die "$table: unsupported table"
43 unless grep { $_ eq $table } $proto->tables(); 47 unless grep { $_ eq $table } $proto->tables();
44 die $driver->style(), ": style mismatch" 48 die $driver->style(), ": style mismatch"
45 unless $driver->style() eq $proto->style(); 49 unless $driver->style() eq $proto->style();
46 my $self = { 50 my $self = {
47 driver => $driver, 51 driver => $driver,
48 table => $table, 52 table => $table,
53 record => $record,
54 params => $params,
49 }; 55 };
50 bless $self, $class; 56 bless $self, $class;
51 return $self; 57 return $self;
52} 58}
53 59
54################################################################################ 60################################################################################
55# table access functions 61# table access functions
56################################################################################ 62################################################################################
57 63
58sub list($) { 64sub list($@) {
65 my ($self, @keyparts) = @_;
66 my ($matchUserID, $matchSetID) = @keyparts[0 .. 1];
67 my @matchingPSVNs;
68 if (defined $matchUserID and not defined $matchSetID) {
69 @matchingPSVNs = $self->getPSVNsForUser($matchUserID);
70 } elsif (defined $matchSetID and not defined $matchUserID) {
71 @matchingPSVNs = $self->getPSVNsForSet($matchSetID);
72 } elsif (defined $matchUserID and defined $matchSetID) {
73 @matchingPSVNs = $self->getPSVN($matchUserID, $matchSetID);
74 } else {
75 return unless $self->{driver}->connect("ro");
76 @matchingPSVNs =
77 grep { m/^\d+$/ }
78 keys %{ $self->{driver}->hash() };
79 }
80 my @result;
81 return () unless $self->{driver}->connect("ro");
82 if ($self->{table} eq "set_user") {
83 foreach (@matchingPSVNs) {
84 my $string = $self->{driver}->hash()->{$_};
85 my $UserSet = $self->string2records($string);
86 push @result, [$UserSet->user_id(), $UserSet->set_id()];
87 }
88 } elsif ($self->{table} eq "problem_user") {
89 foreach (@matchingPSVNs) {
90 my $string = $self->{driver}->hash()->{$_};
91 my (undef, @UserProblems) = $self->string2records($string);
92 foreach (@UserProblems) {
93 push @result, [$_->user_id(), $_->set_id(),
94 $_->problem_id()];
95 }
96 }
97 }
98 $self->{driver}->disconnect();
99 return @result;
100}
101
102sub exists($@) {
103 my ($self, @keyparts) = @_;
104 my ($userID, $setID) = @keyparts[0 .. 1];
105 my $PSVN = $self->getPSVN($userID, $setID);
106 if ($self->{table} eq "set_user") {
107 return $PSVN;
108 } elsif ($self->{table} eq "problem_user") {
109 my $problemID = $keyparts[2];
110 my $string = $self->fetchString($PSVN);
111 my (undef, @Problems) = $self->string2records($string);
112 return grep { $_->problem_id() eq $problemID } @Problems;
113 # optimization, if IDs are guaranteed to be numeric
114 # and in order: return (@Problems >= $keyparts[2])
115 }
116}
117
118sub add($$) {
119 my ($self, $Record) = @_;
120 my $userID = $Record->user_id();
121 my $setID = $Record->set_id();
122 if ($self->{table} eq "set_user") {
123 die "($userID, $setID): UserSet exists.\n"
124 if $self->getPSVN($userID, $setID);
125 my $PSVN = $self->setPSVN($userID, $setID);
126 my $string = $self->records2string($Record); # no problems
127 $self->storeString($PSVN, $string);
128 } elsif ($self->{table} eq "problem_user") {
129 my $problemID = $Record->problem_id();
130 my $PSVN = $self->getPSVN($userID, $setID);
131 die "($userID, $setID): UserSet not found.\n" unless $PSVN;
132 my $string = $self->fetchString($PSVN);
133 my ($Set, @Problems) = $self->string2records($string);
134 die "($userID, $setID, $problemID): UserProblem exists.\n"
135 if grep { $_->problem_id() eq $problemID } @Problems;
136 push @Problems, $Record;
137 $string = $self->records2string($Set, @Problems);
138 $self->storeString($PSVN, $string);
139 }
140}
141
142sub get($@) {
143 my ($self, @keyparts) = @_;
144 my ($userID, $setID) = @keyparts[0 .. 1];
145 die "userID not specified." unless defined $userID;
146 die "setID not specified." unless defined $setID;
147 my $PSVN = $self->getPSVN($userID, $setID);
148 return undef unless $PSVN;
149 my $string = $self->fetchString($PSVN);
150 if ($self->{table} eq "set_user") {
151 my $UserSet = $self->string2records($string);
152 $UserSet->psvn($PSVN);
153 return $UserSet;
154 } if ($self->{table} eq "problem_user") {
155 my ($problemID) = $keyparts[2];
156 die "problemID not specified." unless defined $problemID;
157 my (undef, @UserProblems) = $self->string2records($string);
158 return grep { $_->problem_id() eq $problemID } @UserProblems;
159 }
160}
161
162sub put($$) {
163 my ($self, $Record) = @_;
164 my $userID = $Record->user_id();
165 my $setID = $Record->set_id();
166 my $PSVN = $self->getPSVN($userID, $setID);
167 die "($userID, $setID): UserSet not found.\n" unless $PSVN;
168 my $string = $self->fetchString($PSVN);
169 my ($Set, @Problems) = $self->string2records($string);
170 if ($self->{table} eq "set_user") {
171 $string = $self->records2string($Record, @Problems);
172 } elsif ($self->{table} eq "problem_user") {
173 my $problemID = $Record->problem_id();
174 my $found = 0;
175 foreach (@Problems) {
176 if ($_->problem_id() eq $problemID) {
177 $found = 1;
178 $_ = $Record;
179 }
180 }
181 die "($userID, $setID, $problemID): UserProblem not found.\n"
182 unless $found;
183 $string = $self->records2string($Set, @Problems);
184 }
185 $self->storeString($PSVN, $string);
186}
187
188sub delete($@) {
189 my ($self, @keyparts) = @_;
190 my ($userID, $setID) = @keyparts[0 .. 1];
191 my $PSVN = $self->getPSVN($userID, $setID);
192 return 0 unless $PSVN;
193 if ($self->{table} eq "set_user") {
194 $self->deletePSVN($userID, $setID);
195 $self->deleteString($PSVN);
196 } elsif ($self->{table} eq "problem_user") {
197 my $problemID = $keyparts[2];
198 my $string = $self->fetchString($PSVN);
199 my ($Set, @Problems) = $self->string2records($string);
200 my $length = @Problems;
201 @Problems = grep { not $_->problem_id() eq $problemID } @Problems;
202 return 0 if $length == @Problems;
203 $string = $self->records2string($Set, @Problems);
204 $self->storeString($PSVN, $string);
205 }
206 return 1;
207}
208
209################################################################################
210# table multiplexing functions
211# both the set_user and problem_user tables are stored in one hash, keyed by
212# PSVN. we need to be able to split a hash value into two records, and combine
213# two records into a single hash value.
214################################################################################
215
216# here's a little issue... the schema API seems to allow the user to specify
217# what record class to use (per instance), but since WW1Hash has to monkey with
218# multiple record types in the same instance, we have to hardcode record
219# classes. this is fine, as long as no one tries to use non-default record
220# classes. I guess this is bad, so: ***!
221# NOTE: we can use the new params layout field to specify this.
222sub string2records($$) {
223 my ($self, $string) = @_;
224 my %hash = string2hash($string);
225 my $UserSet = hash2record("WeBWorK::DB::Record::UserSet", %hash);
226 return $UserSet unless wantarray;
227 my @UserProblems;
228 foreach (grep { s/^pfn// } keys %hash) {
229 my %problemHash = (
230 "stlg" => $hash{stlg},
231 "stnm" => $hash{stnm},
232 "#" => $_,
233 "pfn#" => $hash{"pfn$_"},
234 "pva#" => $hash{"pva$_"},
235 "pmia#" => $hash{"pmia$_"},
236 "pse#" => $hash{"pse$_"},
237 "pst#" => $hash{"pst$_"},
238 "pat#" => $hash{"pat$_"},
239 "pan#" => $hash{"pan$_"},
240 "pca#" => $hash{"pca$_"},
241 "pia#" => $hash{"pia$_"},
242 );
243 push @UserProblems, hash2record("WeBWorK::DB::Record::UserProblem", %problemHash);
244 }
245 return $UserSet, @UserProblems;
246}
247
248sub records2string($$@) {
249 my ($self, $Set, @Problems) = @_;
250 my %hash = record2hash($Set);
251 foreach (@Problems) {
252 my %problemHash = record2hash($_);
253 my $n = $problemHash{"#"};
254 foreach ('pfn#', 'pva#', 'pmia#', 'pse#', 'pst#', 'pat#', 'pan#', 'pca#', 'pia#') {
255 my $realKey = $_;
256 $realKey =~ s/#/$n/;
257 $hash{$realKey} = $problemHash{$_};
258 }
259 }
260 return hash2string(%hash);
261}
262
263################################################################################
264# PSVN and index functions
265# the PSVN pseudo-table and the set and user indexes are not visible to the
266# API, but we need to be able to update them to remain compatible with WWDBv1.
267################################################################################
268
269# retrieves a list of existing PSVNs from the user PSVN index
270sub getPSVNsForUser($$) {
271 my ($self, $userID) = @_;
272 my $setsForUser = $self->fetchString(LOGIN_PREFIX.$userID);
273 return unless defined $setsForUser;
274 my %sets = string2hash($setsForUser);
275 return values %sets;
276}
277
278# retrieves a list of existing PSVNs from the set PSVN index
279sub getPSVNsForSet($$) {
280 my ($self, $setID) = @_;
281 my $usersForSet = $self->fetchString(SET_PREFIX.$setID);
282 return unless defined $usersForSet;
283 my %users = string2hash($usersForSet);
284 return values %users;
285}
286
287# retrieves an existing PSVN from the PSVN indexes
288sub getPSVN($$$) {
289 my ($self, $userID, $setID) = @_;
290 return unless $self->{driver}->connect("ro");
291 my $setsForUser = $self->{driver}->hash()->{LOGIN_PREFIX.$userID};
292 my $usersForSet = $self->{driver}->hash()->{SET_PREFIX.$setID};
293 $self->{driver}->disconnect();
294 # * if setsForUser is non-empty, then there are sets built for this
295 # user.
296 # * if usersForSet is non-empty, then this set has been built for at
297 # least one user.
298 # * if either are empty, it is guaranteed that this set has not been
299 # built for this user.
300 return unless defined $setsForUser and defined $usersForSet; #shut up, shut up, shut up!
301 return unless $setsForUser and $usersForSet;
302 my %sets = string2hash($setsForUser);
303 my %users = string2hash($usersForSet);
304 return unless exists $sets{$setID} and exists $users{$userID};
305 # more sanity checks: the following should never happen.
306 # if they do, run screaming for the hills.
307 if (defined $sets{$setID} and not defined $users{$userID}) {
308 die "PSVN indexes inconsistent: set exists in user index ",
309 "but user does not exist in set index.";
310 } elsif (not defined $sets{$setID} and defined $users{$userID}) {
311 die "PSVN indexes inconsistent: user exists in set index ",
312 "but set does not exist in user index.";
313 } elsif ($sets{$setID} != $users{$userID}) {
314 die "PSVN indexes inconsistent: user index and set index ",
315 "gave different PSVN values.";
316 }
317 return $sets{$setID};
318}
319
320# generates a new PSVN, updates the PSVN indexes, returns the PSVN
321# if there is already a PSVN for this pair, reuse it
322sub setPSVN($$$) {
323 my ($self, $userID, $setID) = @_;
324 my $PSVN = $self->getPSVN($userID, $setID);
325 unless ($PSVN) {
326 # yeah, create a new PSVN here
327 my $min_psvn = 10**($self->{params}->{psvnLength} - 1);
328 my $max_psvn = 10**$self->{params}->{psvnLength} - 1;
329 my $attempts = 0;
330 do {
331 if (++$attempts > MAX_PSVN_GENERATION_ATTEMPTS) {
332 die "failed to find an unused PSVN within ",
333 MAX_PSVN_GENERATION_ATTEMPTS, " attempts.";
334 }
335 $PSVN = int(rand($max_psvn-$min_psvn+1)) + $min_psvn;
336 } while ($self->fetchString($PSVN));
337 $self->{driver}->connect("rw"); # open "rw" to lock
338 # get current PSVN indexes
339 my $setsForUser = $self->{driver}->hash()->{LOGIN_PREFIX.$userID};
340 my $usersForSet = $self->{driver}->hash()->{SET_PREFIX.$setID};
341 my %sets = string2hash($setsForUser); # sets built for user $userID
342 my %users = string2hash($usersForSet); # users for which set $setID has been built
343 # insert new PSVN into each hash
344 $sets{$setID} = $PSVN;
345 $users{$userID} = $PSVN;
346 # re-encode the hashes
347 $setsForUser = hash2string(%sets);
348 $usersForSet = hash2string(%users);
349 # store 'em in the database
350 $self->{driver}->hash()->{LOGIN_PREFIX.$userID} = $setsForUser;
351 $self->{driver}->hash()->{SET_PREFIX.$setID} = $usersForSet;
352 $self->{driver}->disconnect();
353 };
354 return $PSVN;
355}
356
357# remove an existing PSVN from the PSVN indexes
358sub deletePSVN($$$) {
359 my ($self, $userID, $setID) = @_;
360 my $PSVN = $self->getPSVN($userID, $setID);
361 return unless $PSVN;
362 $self->{driver}->connect("rw"); # open "rw" to lock
363 my $setsForUser = $self->{driver}->hash()->{LOGIN_PREFIX.$userID};
364 my $usersForSet = $self->{driver}->hash()->{SET_PREFIX.$setID};
365 my %sets = string2hash($setsForUser); # sets built for user $userID
366 my %users = string2hash($usersForSet); # users for which set $setID has been built
367 delete $sets{$setID};
368 delete $users{$userID};
369 $setsForUser = hash2string(%sets);
370 $usersForSet = hash2string(%users);
371 if ($setsForUser) {
372 $self->{driver}->hash()->{LOGIN_PREFIX.$userID} = $setsForUser;
373 } else {
374 delete $self->{driver}->hash()->{LOGIN_PREFIX.$userID};
375 }
376 if ($usersForSet) {
377 $self->{driver}->hash()->{SET_PREFIX.$setID} = $usersForSet;
378 } else {
379 delete $self->{driver}->hash()->{SET_PREFIX.$setID};
380 }
381 $self->{driver}->disconnect();
382 return 1;
383}
384
385################################################################################
386# hash string interface
387################################################################################
388
389sub fetchString($$) {
390 my ($self, $PSVN) = @_;
391 $self->{driver}->connect("ro");
392 my $string = $self->{driver}->hash()->{$PSVN};
393 $self->{driver}->disconnect();
394 return $string;
395}
396
397
398sub storeString($$$) {
399 my ($self, $PSVN, $string) = @_;
400 $self->{driver}->connect("rw");
401 $self->{driver}->hash()->{$PSVN} = $string;
402 $self->{driver}->disconnect();
403}
404
405sub deleteString($$) {
406 my ($self, $PSVN) = @_;
407 $self->{driver}->connect("rw");
408 delete $self->{driver}->hash()->{$PSVN};
409 $self->{driver}->disconnect();
410}
411
412################################################################################
413# debugging
414################################################################################
415
416sub dumpDB($) {
59 my ($self) = @_; 417 my ($self) = @_;
60 $self->{driver}->connect("ro"); 418 $self->{driver}->connect("ro");
61 my @keys = grep !/^>>/, keys %{ $self->{driver}->hash() }; 419 my $result = Dumper( $self->{driver}->hash() );
62 $self->{driver}->disconnect();
63 return @keys;
64}
65
66sub exists($$) {
67 my ($self, $userID) = @_;
68 $self->{driver}->connect("ro"); 420 $self->{driver}->disconnect();
69 my $exists = exists $self->{driver}->hash()->{$userID};
70 $self->{driver}->disconnect();
71 return $exists; 421 return $result;
72}
73
74sub add($$) {
75 my ($self, $User) = @_;
76 $self->{driver}->connect("rw");
77 my $hash = $self->{driver}->hash();
78 die $User->id, ": user exists" if exists $hash->{$User->id};
79 $hash->{$User->id} = hash2string(record2hash($User));
80 $self->{driver}->disconnect();
81}
82
83sub get($$) {
84 my ($self, $userID) = @_;
85 $self->{driver}->connect("ro");
86 my $string = $self->{driver}->hash()->{$userID};
87 $self->{driver}->disconnect();
88 return undef unless $string;
89 my $record = hash2record("WeBWorK::DB::Record::User", string2hash($string));
90 $record->id($userID);
91 return $record;
92}
93
94sub put($$) {
95 my ($self, $User) = @_;
96 $self->{driver}->connect("rw");
97 my $hash = $self->{driver}->hash();
98 die $User->id, ": user not found" unless exists $hash->{$User->id};
99 $hash->{$User->id} = hash2string(record2hash($User));
100 $self->{driver}->disconnect();
101}
102
103sub delete($$) {
104 my ($self, $userID) = @_;
105 $self->{driver}->connect("rw");
106 my $hash = $self->{driver}->hash();
107 die "$userID: user not found" unless exists $hash->{$userID};
108 delete $hash->{$userID};
109 $self->{driver}->disconnect();
110} 422}
111 423
1121; 4241;
Legend:
Removed from v.807  
changed lines
  Added in v.808
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9