[system] / trunk / webwork-modperl / lib / WeBWorK / DB.pm Repository:
ViewVC logotype

Annotation of /trunk/webwork-modperl/lib/WeBWorK/DB.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1104 - (view) (download) (as text)

1 : sh002i 775 ################################################################################
2 :     # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
3 :     # $Id$
4 :     ################################################################################
5 :    
6 :     package WeBWorK::DB;
7 :    
8 :     =head1 NAME
9 :    
10 : sh002i 956 WeBWorK::DB - interface with the WeBWorK databases.
11 : sh002i 775
12 : sh002i 1012 =head1 SYNOPSIS
13 :    
14 :     my $db = WeBWorK::DB->new($courseEnvironment);
15 :    
16 :     my @userIDs = $db->listUsers();
17 :     my $Sam = $db->{user}->{record}->new();
18 :    
19 :     $Sam->user_id("sammy");
20 :     $Sam->first_name("Sam");
21 :     $Sam->last_name("Hathaway");
22 :     # etc.
23 :    
24 :     $db->addUser($User);
25 :     my $Dennis = $db->getUser("dennis");
26 :     $Dennis->status("C");
27 :     $db->putUser->($Dennis);
28 :    
29 :     $db->deleteUser("sammy");
30 :    
31 : sh002i 956 =head1 DESCRIPTION
32 :    
33 :     WeBWorK::DB provides a consistent interface to a number of database backends.
34 :     Access and modification functions are provided for each logical table used by
35 :     the webwork system. The particular backend ("schema" and "driver"), record
36 : sh002i 1012 class, data source, and additional parameters are specified by the C<%dbLayout>
37 : sh002i 956 hash in the course environment.
38 :    
39 :     =head1 ARCHITECTURE
40 :    
41 :     The new database system uses a three-tier architecture to insulate each layer
42 :     from the adjacent layers.
43 :    
44 :     =head2 Top Layer: DB
45 :    
46 :     The top layer of the architecture is the DB module. It provides the methods
47 :     listed below, and uses schema modules (via tables) to implement those methods.
48 :    
49 :     / list* exists* add* get* put* delete* \ <- api
50 :     +------------------------------------------------------------------+
51 :     | DB |
52 :     +------------------------------------------------------------------+
53 :     \ password permission key user set set_user problem problem_user / <- tables
54 :    
55 :     =head2 Middle Layer: Schemas
56 :    
57 :     The middle layer of the architecture is provided by one or more schema modules.
58 :     They are called "schema" modules because they control the structure of the data
59 :     for a table. This includes odd things like the way multiple tables are encoded
60 : sh002i 1012 in a single hash in the WW1Hash schema, and the encoding scheme used.
61 : sh002i 956
62 :     The schema modules provide an API that matches the requirements of the DB
63 :     layer, on a per-table basis. Each schema module has a style that determines
64 :     which drivers it can interface with. For example, WW1Hash is a "hash" style
65 :     schema. SQL is a "dbi" style schema.
66 :    
67 :     =head3 Examples
68 :    
69 :     Both WeBWorK 1.x and 2.x courses use:
70 :    
71 :     / password permission key \ / user \ <- tables provided
72 :     +-----------------------------+ +----------------+
73 :     | Auth1Hash | | Classlist1Hash |
74 :     +-----------------------------+ +----------------+
75 :     \ hash / \ hash / <- driver style required
76 :    
77 :     WeBWorK 1.x courses also use:
78 :    
79 :     / set_user problem_user \ / set problem \
80 :     +-------------------------+ +---------------------+
81 :     | WW1Hash | | GlobalTableEmulator |
82 :     +-------------------------+ +---------------------+
83 :     \ hash / \ null /
84 :    
85 :     The GlobalTableEmulator schema emulates the global set and problem tables using
86 :     data from the set_user and problem_user tables.
87 :    
88 :     WeBWorK 2.x courses also use:
89 :    
90 :     / set set_user problem problem_user \
91 :     +-------------------------------------+
92 :     | WW2Hash |
93 :     +-------------------------------------+
94 :     \ hash /
95 :    
96 :     =head2 Bottom Layer: Drivers
97 :    
98 :     Driver modules implement a style for a schema. They provide physical access to
99 :     a data source containing the data for a table. The style of a driver determines
100 : sh002i 1012 what methods it provides. All drivers provide C<connect(MODE)> and
101 :     C<disconnect()> methods. A hash style driver provides a C<hash()> method which
102 :     returns the tied hash. A dbi style driver provides a C<handle()> method which
103 :     returns the DBI handle.
104 : sh002i 956
105 :     =head3 Examples
106 :    
107 :     / hash \ / hash \ / hash \ <- style
108 :     +--------+ +--------+ +--------+
109 :     | DB | | GDBM | | DB3 |
110 :     +--------+ +--------+ +--------+
111 :    
112 :     / dbi \ / ldap \
113 :     +-------+ +--------+
114 :     | SQL | | LDAP |
115 :     +-------+ +--------+
116 :    
117 : sh002i 1012 =head2 Record Types
118 :    
119 :     In C<%dblayout>, each table is assigned a record class, used for passing
120 :     complete records to and from the database. The default record classes are
121 :     subclasses of the WeBWorK::DB::Record class, and are named as follows: User,
122 :     Password, PermissionLevel, Key, Set, UserSet, Problem, UserProblem. In the
123 :     following documentation, a reference the the record class for a table means the
124 :     record class currently defined for that table in C<%dbLayout>.
125 :    
126 : sh002i 775 =cut
127 :    
128 :     use strict;
129 :     use warnings;
130 : sh002i 1096 use Carp;
131 : sh002i 904 use Data::Dumper;
132 : sh002i 775 use WeBWorK::Utils qw(runtime_use);
133 :    
134 : sh002i 798 use constant TABLES => qw(password permission key user set set_user problem problem_user);
135 : sh002i 775
136 :     ################################################################################
137 :     # constructor
138 :     ################################################################################
139 :    
140 : sh002i 956 =head1 CONSTRUCTOR
141 : sh002i 1012
142 : sh002i 956 =over
143 :    
144 : sh002i 1012 =item new($ce)
145 : sh002i 956
146 : sh002i 1012 The C<new> method creates a DB object and brings up the underlying
147 : sh002i 1035 schema/driver structure according to the C<%dbLayout> hash in C<$ce>, a
148 : sh002i 1012 WeBWorK::CourseEnvironment object.
149 :    
150 :     =back
151 :    
152 : sh002i 956 =cut
153 :    
154 : sh002i 775 sub new($$) {
155 : sh002i 814 my ($invocant, $ce) = @_;
156 : sh002i 775 my $class = ref($invocant) || $invocant;
157 : sh002i 798 my $self = {};
158 : sh002i 931 bless $self, $class; # bless this here so we can pass it to the schema
159 : sh002i 775
160 :     # load the modules required to handle each table, and create driver
161 :     foreach my $table (TABLES) {
162 : sh002i 1096 croak "table $table not specified in dbLayout"
163 :     unless defined $ce->{dbLayout}->{$table};
164 : sh002i 775
165 :     my $layout = $ce->{dbLayout}->{$table};
166 : sh002i 798 my $record = $layout->{record};
167 : sh002i 775 my $schema = $layout->{schema};
168 :     my $driver = $layout->{driver};
169 :     my $source = $layout->{source};
170 : sh002i 808 my $params = $layout->{params};
171 : sh002i 775
172 : sh002i 798 runtime_use($record);
173 : sh002i 1096
174 :     runtime_use($driver);
175 :     my $driverObject = eval { $driver->new($source, $params) };
176 :     croak "new: error instantiating DB driver $driver for table $table: $@"
177 :     if $@;
178 :    
179 : sh002i 798 runtime_use($schema);
180 : sh002i 1096 my $schemaObject = eval { $schema->new(
181 :     $self, $driver->new($source, $params),
182 :     $table, $record, $params) };
183 :     croak "new: error instantiating DB schema $schema for table $table: $@"
184 :     if $@;
185 :    
186 :     $self->{$table} = $schemaObject;
187 : sh002i 775 }
188 :    
189 :     return $self;
190 :     }
191 :    
192 : sh002i 1012 =head1 METHODS
193 :    
194 :     =cut
195 :    
196 : sh002i 775 ################################################################################
197 :     # password functions
198 :     ################################################################################
199 :    
200 : sh002i 1012 =head2 Password Methods
201 :    
202 :     =over
203 :    
204 :     =item listPasswords()
205 :    
206 :     Returns a list of user IDs representing the records in the password table.
207 :    
208 :     =cut
209 :    
210 : sh002i 1096 sub listPasswords {
211 : sh002i 775 my ($self) = @_;
212 : sh002i 1096
213 :     croak "listPasswords: requires 0 arguments"
214 :     unless @_ == 1;
215 :    
216 : sh002i 808 return map { $_->[0] }
217 :     $self->{password}->list(undef);
218 : sh002i 775 }
219 :    
220 : sh002i 1012 =item addPassword($Password)
221 :    
222 :     $Password is a record object. The password will be added to the password table
223 :     if a password with the same user ID does not already exist. If one does exist,
224 :     an exception is thrown. To add a password, a user with a matching user ID must
225 :     exist in the user table.
226 :    
227 :     =cut
228 :    
229 : sh002i 808 sub addPassword($$) {
230 : sh002i 775 my ($self, $Password) = @_;
231 : sh002i 1096
232 :     croak "addPassword: requires 1 argument"
233 :     unless @_ == 2;
234 :     croak "addPassword: argument 1 must be of type ", $self->{password}->{record}
235 :     unless ref $Password eq $self->{password}->{record};
236 :     croak "addPassword: password exists (perhaps you meant to use putPassword?)"
237 :     if $self->{password}->exists($Password->user_id);
238 :     croak "addPassword: user ", $Password->user_id, " not found"
239 : sh002i 775 unless $self->{user}->exists($Password->user_id);
240 : sh002i 1096
241 : sh002i 775 return $self->{password}->add($Password);
242 :     }
243 :    
244 : sh002i 1012 =item getPassword($userID)
245 :    
246 :     If a record with a matching user ID exists, a record object containting that
247 :     record's data will be returned. If no such record exists, an undefined value
248 :     will be returned.
249 :    
250 :     =cut
251 :    
252 : sh002i 775 sub getPassword($$) {
253 :     my ($self, $userID) = @_;
254 : sh002i 1096
255 :     croak "getPassword: requires 1 argument"
256 :     unless @_ == 2;
257 :     croak "getPassword: argument 1 must contain a user_id"
258 :     unless defined $userID;
259 :    
260 : sh002i 775 return $self->{password}->get($userID);
261 :     }
262 :    
263 : sh002i 1012 =item putPassword($Password)
264 :    
265 :     $Password is a record object. If a password record with the same user ID exists
266 :     in the password table, the data in the record is replaced with the data in
267 :     $Password. If a matching password record does not exist, an exception is
268 :     thrown.
269 :    
270 :     =cut
271 :    
272 : sh002i 775 sub putPassword($$) {
273 :     my ($self, $Password) = @_;
274 : sh002i 1096
275 :     croak "putPassword: requires 1 argument"
276 :     unless @_ == 2;
277 :     croak "putPassword: argument 1 must be of type ", $self->{password}->{record}
278 :     unless ref $Password eq $self->{password}->{record};
279 :     croak "putPassword: password not found (perhaps you meant to use addPassword?)"
280 :     unless $self->{password}->exists($Password->user_id);
281 :    
282 : sh002i 775 return $self->{password}->put($Password);
283 :     }
284 :    
285 : sh002i 1012 =item deletePassword($userID)
286 :    
287 :     If a password record with a user ID matching $userID exists in the password
288 :     table, it is removed and the method returns a true value. If one does exist,
289 :     a false value is returned.
290 :    
291 :     =cut
292 :    
293 : sh002i 775 sub deletePassword($$) {
294 :     my ($self, $userID) = @_;
295 : sh002i 1096
296 :     croak "putPassword: requires 1 argument"
297 :     unless @_ == 2;
298 :     croak "deletePassword: argument 1 must contain a user_id"
299 :     unless defined $userID;
300 :    
301 : sh002i 775 return $self->{password}->delete($userID);
302 :     }
303 :    
304 : sh002i 1012 =back
305 :    
306 :     =cut
307 :    
308 : sh002i 775 ################################################################################
309 :     # permission functions
310 :     ################################################################################
311 :    
312 :     sub listPermissionLevels($) {
313 :     my ($self) = @_;
314 : sh002i 1096
315 :     croak "listPermissionLevels: requires 0 arguments"
316 :     unless @_ == 1;
317 :    
318 : sh002i 808 return map { $_->[0] }
319 :     $self->{permission}->list(undef);
320 : sh002i 775 }
321 :    
322 : sh002i 808 sub addPermissionLevel($$) {
323 : sh002i 775 my ($self, $PermissionLevel) = @_;
324 : sh002i 1096
325 :     croak "addPermissionLevel: requires 1 argument"
326 :     unless @_ == 2;
327 :     croak "addPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}
328 :     unless ref $PermissionLevel eq $self->{permission}->{record};
329 :     croak "addPermissionLevel: permission level exists (perhaps you meant to use putPermissionLevel?)"
330 :     if $self->{permission}->exists($PermissionLevel->user_id);
331 :     croak "addPermissionLevel: user ", $PermissionLevel->user_id, " not found"
332 : sh002i 775 unless $self->{user}->exists($PermissionLevel->user_id);
333 : sh002i 1096
334 : sh002i 775 return $self->{permission}->add($PermissionLevel);
335 :     }
336 :    
337 :     sub getPermissionLevel($$) {
338 :     my ($self, $userID) = @_;
339 : sh002i 1096
340 :     croak "getPermissionLevel: requires 1 argument"
341 :     unless @_ == 2;
342 :     croak "getPermissionLevel: argument 1 must contain a user_id"
343 :     unless defined $userID;
344 :    
345 : sh002i 775 return $self->{permission}->get($userID);
346 :     }
347 :    
348 :     sub putPermissionLevel($$) {
349 :     my ($self, $PermissionLevel) = @_;
350 : sh002i 1096
351 :     croak "putPermissionLevel: requires 1 argument"
352 :     unless @_ == 2;
353 :     croak "putPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}
354 :     unless ref $PermissionLevel eq $self->{permission}->{record};
355 :     croak "putPermissionLevel: permission level not found (perhaps you meant to use addPermissionLevel?)"
356 :     unless $self->{permission}->exists($PermissionLevel->user_id);
357 :    
358 : sh002i 775 return $self->{permission}->put($PermissionLevel);
359 :     }
360 :    
361 :     sub deletePermissionLevel($$) {
362 :     my ($self, $userID) = @_;
363 : sh002i 1096
364 :     croak "deletePermissionLevel: requires 1 argument"
365 :     unless @_ == 2;
366 :     croak "deletePermissionLevel: argument 1 must contain a user_id"
367 :     unless defined $userID;
368 :    
369 : sh002i 775 return $self->{permission}->delete($userID);
370 :     }
371 :    
372 :     ################################################################################
373 :     # key functions
374 :     ################################################################################
375 :    
376 :     sub listKeys($) {
377 :     my ($self) = @_;
378 : sh002i 1096
379 :     croak "listKeys: requires 0 arguments"
380 :     unless @_ == 1;
381 :    
382 : sh002i 808 return map { $_->[0] }
383 :     $self->{key}->list(undef);
384 : sh002i 775 }
385 :    
386 : sh002i 808 sub addKey($$) {
387 : sh002i 775 my ($self, $Key) = @_;
388 : sh002i 1096
389 :     croak "addKey: requires 1 argument"
390 :     unless @_ == 2;
391 :     croak "addKey: argument 1 must be of type ", $self->{key}->{record}
392 :     unless ref $Key eq $self->{key}->{record};
393 :     croak "addKey: key exists (perhaps you meant to use putKey?)"
394 :     if $self->{key}->exists($Key->user_id);
395 :     croak "addKey: user ", $Key->user_id, " not found"
396 : sh002i 775 unless $self->{user}->exists($Key->user_id);
397 : sh002i 1096
398 : sh002i 775 return $self->{key}->add($Key);
399 :     }
400 :    
401 :     sub getKey($$) {
402 :     my ($self, $userID) = @_;
403 : sh002i 1096
404 :     croak "getKey: requires 1 argument"
405 :     unless @_ == 2;
406 :     croak "getKey: argument 1 must contain a user_id"
407 :     unless defined $userID;
408 :    
409 : sh002i 775 return $self->{key}->get($userID);
410 :     }
411 :    
412 :     sub putKey($$) {
413 :     my ($self, $Key) = @_;
414 : sh002i 1096
415 :     croak "putKey: requires 1 argument"
416 :     unless @_ == 2;
417 :     croak "putKey: argument 1 must be of type ", $self->{key}->{record}
418 :     unless ref $Key eq $self->{key}->{record};
419 :     croak "putKey: key not found (perhaps you meant to use addKey?)"
420 :     unless $self->{key}->exists($Key->user_id);
421 :    
422 : sh002i 775 return $self->{key}->put($Key);
423 :     }
424 :    
425 :     sub deleteKey($$) {
426 :     my ($self, $userID) = @_;
427 : sh002i 1096
428 :     croak "deleteKey: requires 1 argument"
429 :     unless @_ == 2;
430 :     croak "deleteKey: argument 1 must contain a user_id"
431 :     unless defined $userID;
432 :    
433 : sh002i 775 return $self->{key}->delete($userID);
434 :     }
435 :    
436 :     ################################################################################
437 :     # user functions
438 :     ################################################################################
439 :    
440 :     sub listUsers($) {
441 :     my ($self) = @_;
442 : sh002i 1096
443 :     croak "listUsers: requires 0 arguments"
444 :     unless @_ == 1;
445 :    
446 : sh002i 808 return map { $_->[0] }
447 :     $self->{user}->list(undef);
448 : sh002i 775 }
449 :    
450 : sh002i 808 sub addUser($$) {
451 : sh002i 775 my ($self, $User) = @_;
452 : sh002i 1096
453 :     croak "addUser: requires 1 argument"
454 :     unless @_ == 2;
455 :     croak "addUser: argument 1 must be of type ", $self->{user}->{record}
456 :     unless ref $User eq $self->{user}->{record};
457 :     croak "addUser: user exists (perhaps you meant to use putUser?)"
458 :     if $self->{user}->exists($User->user_id);
459 :    
460 : sh002i 775 return $self->{user}->add($User);
461 :     }
462 :    
463 :     sub getUser($$) {
464 :     my ($self, $userID) = @_;
465 : sh002i 1096
466 :     croak "getUser: requires 1 argument"
467 :     unless @_ == 2;
468 :     croak "getUser: argument 1 must contain a user_id"
469 :     unless defined $userID;
470 :    
471 : sh002i 775 return $self->{user}->get($userID);
472 :     }
473 :    
474 :     sub putUser($$) {
475 :     my ($self, $User) = @_;
476 : sh002i 1096
477 :     croak "putUser: requires 1 argument"
478 :     unless @_ == 2;
479 :     croak "putUser: argument 1 must be of type ", $self->{user}->{record}
480 :     unless ref $User eq $self->{user}->{record};
481 :     croak "putUser: user not found (perhaps you meant to use addUser?)"
482 :     unless $self->{user}->exists($User->user_id);
483 :    
484 : sh002i 775 return $self->{user}->put($User);
485 :     }
486 :    
487 :     sub deleteUser($$) {
488 :     my ($self, $userID) = @_;
489 : sh002i 1096
490 :     croak "deleteUser: requires 1 argument"
491 :     unless @_ == 2;
492 :     croak "deleteUser: argument 1 must contain a user_id"
493 :     unless defined $userID;
494 :    
495 :     $self->deleteUserSet($userID, $_)
496 :     foreach $self->listUserSets($userID);
497 : sh002i 775 $self->deletePassword($userID);
498 :     $self->deletePermissionLevel($userID);
499 :     $self->deleteKey($userID);
500 :     return $self->{user}->delete($userID);
501 :     }
502 :    
503 :     ################################################################################
504 :     # set functions
505 :     ################################################################################
506 :    
507 :     sub listGlobalSets($) {
508 :     my ($self) = @_;
509 : sh002i 1096
510 :     croak "listGlobalSets: requires 0 arguments"
511 :     unless @_ == 1;
512 :    
513 : sh002i 808 return map { $_->[0] }
514 :     $self->{set}->list(undef);
515 : sh002i 775 }
516 :    
517 : sh002i 808 sub addGlobalSet($$) {
518 : sh002i 775 my ($self, $GlobalSet) = @_;
519 : sh002i 1096
520 :     croak "addGlobalSet: requires 1 argument"
521 :     unless @_ == 2;
522 :     croak "addGlobalSet: argument 1 must be of type ", $self->{set}->{record}
523 :     unless ref $GlobalSet eq $self->{set}->{record};
524 :     croak "addGlobalSet: global set exists (perhaps you meant to use putGlobalSet?)"
525 :     if $self->{set}->exists($GlobalSet->set_id);
526 :    
527 : sh002i 775 return $self->{set}->add($GlobalSet);
528 :     }
529 :    
530 :     sub getGlobalSet($$) {
531 :     my ($self, $setID) = @_;
532 : sh002i 1096
533 :     croak "getGlobalSet: requires 1 argument"
534 :     unless @_ == 2;
535 :     croak "getGlobalSet: argument 1 must contain a set_id"
536 :     unless defined $setID;
537 :    
538 : sh002i 775 return $self->{set}->get($setID);
539 :     }
540 :    
541 :     sub putGlobalSet($$) {
542 :     my ($self, $GlobalSet) = @_;
543 : sh002i 1096
544 :     croak "putGlobalSet: requires 1 argument"
545 :     unless @_ == 2;
546 :     croak "putGlobalSet: argument 1 must be of type ", $self->{set}->{record}
547 :     unless ref $GlobalSet eq $self->{set}->{record};
548 :     croak "putGlobalSet: global set not found (perhaps you meant to use addGlobalSet?)"
549 :     unless $self->{set}->exists($GlobalSet->set_id);
550 :    
551 : sh002i 775 return $self->{set}->put($GlobalSet);
552 :     }
553 :    
554 :     sub deleteGlobalSet($$) {
555 :     my ($self, $setID) = @_;
556 : sh002i 1096
557 :     croak "deleteGlobalSet: requires 1 argument"
558 :     unless @_ == 2;
559 :     croak "deleteGlobalSet: argument 1 must contain a set_id"
560 :     unless defined $setID;
561 :    
562 :     $self->deleteUserSet($_, $setID)
563 :     foreach $self->listSetUsers($setID);
564 : sh002i 775 $self->deleteGlobalProblem($setID, $_)
565 :     foreach $self->listGlobalProblems($setID);
566 :     return $self->{set}->delete($setID);
567 :     }
568 :    
569 :     ################################################################################
570 :     # set_user functions
571 :     ################################################################################
572 :    
573 : sh002i 909 sub listSetUsers($$) {
574 :     my ($self, $setID) = @_;
575 : sh002i 1096
576 :     croak "listSetUsers: requires 1 argument"
577 :     unless @_ == 2;
578 :     croak "listSetUsers: argument 1 must contain a set_id"
579 :     unless defined $setID;
580 :    
581 : sh002i 909 return map { $_->[0] } # extract user_id
582 :     $self->{set_user}->list(undef, $setID);
583 :     }
584 :    
585 :     sub listUserSets($$) {
586 : sh002i 775 my ($self, $userID) = @_;
587 : sh002i 1096
588 :     croak "listUserSets: requires 1 argument"
589 :     unless @_ == 2;
590 :     croak "listUserSets: argument 1 must contain a user_id"
591 :     unless defined $userID;
592 :    
593 : sh002i 808 return map { $_->[1] } # extract set_id
594 :     $self->{set_user}->list($userID, undef);
595 : sh002i 775 }
596 :    
597 : sh002i 808 sub addUserSet($$) {
598 : sh002i 775 my ($self, $UserSet) = @_;
599 : sh002i 1096
600 :     croak "addUserSet: requires 1 argument"
601 :     unless @_ == 2;
602 :     croak "addUserSet: argument 1 must be of type ", $self->{set_user}->{record}
603 :     unless ref $UserSet eq $self->{set_user}->{record};
604 :     croak "addUserSet: user set exists (perhaps you meant to use putUserSet?)"
605 :     if $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
606 :     croak "addUserSet: user ", $UserSet->user_id, " not found"
607 : sh002i 775 unless $self->{user}->exists($UserSet->user_id);
608 : sh002i 1096 croak "addUserSet: set ", $UserSet->set_id, " not found"
609 : sh002i 775 unless $self->{set}->exists($UserSet->set_id);
610 : sh002i 1096
611 : sh002i 775 return $self->{set_user}->add($UserSet);
612 :     }
613 :    
614 : sh002i 909 sub getUserSet($$$) {
615 : sh002i 775 my ($self, $userID, $setID) = @_;
616 : sh002i 1096
617 :     croak "getUserSet: requires 2 arguments"
618 :     unless @_ == 3;
619 :     croak "getUserSet: argument 1 must contain a user_id"
620 :     unless defined $userID;
621 :     croak "getUserSet: argument 2 must contain a set_id"
622 :     unless defined $setID;
623 :    
624 : sh002i 775 return $self->{set_user}->get($userID, $setID);
625 :     }
626 :    
627 :     sub putUserSet($$) {
628 :     my ($self, $UserSet) = @_;
629 : sh002i 1096
630 :     croak "putUserSet: requires 1 argument"
631 :     unless @_ == 2;
632 :     croak "putUserSet: argument 1 must be of type ", $self->{set_user}->{record}
633 :     unless ref $UserSet eq $self->{set_user}->{record};
634 :     croak "putUserSet: user set not found (perhaps you meant to use addUserSet?)"
635 :     unless $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
636 :     croak "putUserSet: user ", $UserSet->user_id, " not found"
637 :     unless $self->{user}->exists($UserSet->user_id);
638 :     croak "putUserSet: set ", $UserSet->set_id, " not found"
639 :     unless $self->{set}->exists($UserSet->set_id);
640 :    
641 : sh002i 775 return $self->{set_user}->put($UserSet);
642 :     }
643 :    
644 : sh002i 909 sub deleteUserSet($$$) {
645 : sh002i 775 my ($self, $userID, $setID) = @_;
646 : sh002i 1096
647 :     croak "getUserSet: requires 2 arguments"
648 :     unless @_ == 3;
649 :     croak "getUserSet: argument 1 must contain a user_id"
650 :     unless defined $userID;
651 :     croak "getUserSet: argument 2 must contain a set_id"
652 :     unless defined $userID;
653 :    
654 : sh002i 775 $self->deleteUserProblem($userID, $setID, $_)
655 :     foreach $self->listUserProblems($userID, $setID);
656 :     return $self->{set_user}->delete($userID, $setID);
657 :     }
658 :    
659 :     ################################################################################
660 :     # problem functions
661 :     ################################################################################
662 :    
663 :     sub listGlobalProblems($$) {
664 :     my ($self, $setID) = @_;
665 : sh002i 1096
666 :     croak "listGlobalProblems: requires 1 arguments"
667 :     unless @_ == 2;
668 :     croak "listGlobalProblems: argument 1 must contain a set_id"
669 :     unless defined $setID;
670 :    
671 : sh002i 775 return map { $_->[1] }
672 : sh002i 1096 $self->{problem}->list($setID, undef);
673 : sh002i 775 }
674 :    
675 : sh002i 808 sub addGlobalProblem($$) {
676 : sh002i 775 my ($self, $GlobalProblem) = @_;
677 : sh002i 1096
678 :     croak "addGlobalProblem: requires 1 argument"
679 :     unless @_ == 2;
680 :     croak "addGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
681 :     unless ref $GlobalProblem eq $self->{problem}->{record};
682 :     croak "addGlobalProblem: global problem exists (perhaps you meant to use putGlobalProblem?)"
683 :     if $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
684 :     croak "addGlobalProblem: set ", $GlobalProblem->set_id, " not found"
685 : sh002i 775 unless $self->{set}->exists($GlobalProblem->set_id);
686 : sh002i 1096
687 : sh002i 775 return $self->{problem}->add($GlobalProblem);
688 :     }
689 :    
690 :     sub getGlobalProblem($$$) {
691 :     my ($self, $setID, $problemID) = @_;
692 : sh002i 1096
693 :     croak "getGlobalProblem: requires 2 arguments"
694 :     unless @_ == 3;
695 :     croak "getGlobalProblem: argument 1 must contain a set_id"
696 :     unless defined $setID;
697 :     croak "getGlobalProblem: argument 2 must contain a problem_id"
698 :     unless defined $problemID;
699 :    
700 : sh002i 916 return $self->{problem}->get($setID, $problemID);
701 : sh002i 775 }
702 :    
703 :     sub putGlobalProblem($$) {
704 :     my ($self, $GlobalProblem) = @_;
705 : sh002i 1096
706 :     croak "putGlobalProblem: requires 1 argument"
707 :     unless @_ == 2;
708 :     croak "putGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
709 :     unless ref $GlobalProblem eq $self->{problem}->{record};
710 :     croak "putGlobalProblem: global problem not found (perhaps you meant to use addGlobalProblem?)"
711 :     unless $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
712 :     croak "putGlobalProblem: set ", $GlobalProblem->set_id, " not found"
713 :     unless $self->{set}->exists($GlobalProblem->set_id);
714 :    
715 : sh002i 775 return $self->{problem}->put($GlobalProblem);
716 :     }
717 :    
718 :     sub deleteGlobalProblem($$$) {
719 :     my ($self, $setID, $problemID) = @_;
720 : sh002i 1096
721 :     croak "getGlobalProblem: requires 2 arguments"
722 :     unless @_ == 3;
723 :     croak "getGlobalProblem: argument 1 must contain a set_id"
724 :     unless defined $setID;
725 :     croak "getGlobalProblem: argument 2 must contain a problem_id"
726 :     unless defined $problemID;
727 :    
728 : sh002i 775 $self->deleteUserProblem($_, $setID, $problemID)
729 : sh002i 1096 foreach $self->listProblemUsers($setID, $problemID);
730 : sh002i 775 return $self->{problem}->delete($setID, $problemID);
731 :     }
732 :    
733 :     ################################################################################
734 :     # problem_user functions
735 :     ################################################################################
736 :    
737 : sh002i 923 sub listProblemUsers($$$) {
738 :     my ($self, $setID, $problemID) = @_;
739 : sh002i 1096
740 :     croak "listProblemUsers: requires 2 arguments"
741 :     unless @_ == 3;
742 :     croak "listProblemUsers: argument 1 must contain a set_id"
743 :     unless defined $setID;
744 :     croak "listProblemUsers: argument 2 must contain a problem_id"
745 :     unless defined $problemID;
746 :    
747 : sh002i 923 return map { $_->[0] } # extract user_id
748 :     $self->{problem_user}->list(undef, $setID, $problemID);
749 :     }
750 :    
751 : sh002i 775 sub listUserProblems($$$) {
752 :     my ($self, $userID, $setID) = @_;
753 : sh002i 1096
754 :     croak "listUserProblems: requires 2 arguments"
755 :     unless @_ == 3;
756 :     croak "listUserProblems: argument 1 must contain a user_id"
757 :     unless defined $userID;
758 :     croak "listUserProblems: argument 2 must contain a set_id"
759 :     unless defined $setID;
760 :    
761 : sh002i 923 return map { $_->[2] } # extract problem_id
762 : sh002i 808 $self->{problem_user}->list($userID, $setID, undef);
763 : sh002i 775 }
764 :    
765 : sh002i 808 sub addUserProblem($$) {
766 : sh002i 775 my ($self, $UserProblem) = @_;
767 : sh002i 1096
768 :     croak "addUserProblem: requires 1 argument"
769 :     unless @_ == 2;
770 :     croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
771 :     unless ref $UserProblem eq $self->{problem_user}->{record};
772 :     croak "addUserProblem: user problem exists (perhaps you meant to use putUserProblem?)"
773 :     if $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
774 :     croak "addUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
775 : sh002i 808 unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
776 : sh002i 1096 croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
777 : sh002i 914 unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
778 : sh002i 1096
779 : sh002i 775 return $self->{problem_user}->add($UserProblem);
780 :     }
781 :    
782 : sh002i 798 sub getUserProblem($$$$) {
783 : sh002i 775 my ($self, $userID, $setID, $problemID) = @_;
784 : sh002i 1096
785 :     croak "getUserProblem: requires 3 arguments"
786 :     unless @_ == 4;
787 :     croak "getUserProblem: argument 1 must contain a user_id"
788 :     unless defined $userID;
789 :     croak "getUserProblem: argument 2 must contain a set_id"
790 :     unless defined $setID;
791 :     croak "getUserProblem: argument 3 must contain a problem_id"
792 :     unless defined $problemID;
793 :    
794 : sh002i 775 return $self->{problem_user}->get($userID, $setID, $problemID);
795 :     }
796 :    
797 :     sub putUserProblem($$) {
798 :     my ($self, $UserProblem) = @_;
799 : sh002i 1096
800 :     croak "putUserProblem: requires 1 argument"
801 :     unless @_ == 2;
802 :     croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
803 :     unless ref $UserProblem eq $self->{problem_user}->{record};
804 :     croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
805 :     unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
806 : malsyned 1104 croak "putUserProblem: user problem not found (perhaps you meant to use addUserProblem?)"
807 :     unless $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
808 : sh002i 1096 croak "putUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
809 :     unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
810 :    
811 : sh002i 775 return $self->{problem_user}->put($UserProblem);
812 :     }
813 :    
814 : sh002i 798 sub deleteUserProblem($$$$) {
815 : sh002i 775 my ($self, $userID, $setID, $problemID) = @_;
816 : sh002i 1096
817 :     croak "getUserProblem: requires 3 arguments"
818 :     unless @_ == 4;
819 :     croak "getUserProblem: argument 1 must contain a user_id"
820 :     unless defined $userID;
821 :     croak "getUserProblem: argument 2 must contain a set_id"
822 :     unless defined $setID;
823 :     croak "getUserProblem: argument 3 must contain a problem_id"
824 :     unless defined $problemID;
825 :    
826 : sh002i 775 return $self->{problem_user}->delete($userID, $setID, $problemID);
827 :     }
828 :    
829 :     ################################################################################
830 :     # set+set_user functions
831 :     ################################################################################
832 :    
833 : sh002i 1096 sub getGlobalUserSet {
834 :     carp "getGlobalUserSet: this method is deprecated -- use getMergedSet instead";
835 :     return shift->getMergedSet(@_);
836 :     }
837 :    
838 :     sub getMergedSet {
839 : sh002i 798 my ($self, $userID, $setID) = @_;
840 : sh002i 1096
841 :     croak "getGlobalUserSet: requires 2 arguments"
842 :     unless @_ == 3;
843 :     croak "getGlobalUserSet: argument 1 must contain a user_id"
844 :     unless defined $userID;
845 :     croak "getGlobalUserSet: argument 2 must contain a set_id"
846 :     unless defined $setID;
847 :    
848 : sh002i 814 my $UserSet = $self->getUserSet($userID, $setID);
849 :     return unless $UserSet;
850 :     my $GlobalSet = $self->getGlobalSet($setID);
851 :     if ($GlobalSet) {
852 :     foreach ($UserSet->FIELDS()) {
853 :     next unless $GlobalSet->can($_);
854 :     next if $UserSet->$_();
855 :     $UserSet->$_($GlobalSet->$_());
856 :     }
857 :     }
858 :     return $UserSet;
859 : sh002i 798 }
860 : sh002i 775
861 :     ################################################################################
862 :     # problem+problem_user functions
863 :     ################################################################################
864 :    
865 : sh002i 1096 sub getGlobalUserProblem {
866 :     carp "getGlobalUserProblem: this method is deprecated -- use getMergedProblem instead";
867 :     return shift->getMergedProblem(@_);
868 :     }
869 :    
870 :     sub getMergedProblem {
871 : sh002i 798 my ($self, $userID, $setID, $problemID) = @_;
872 : sh002i 1096
873 :     croak "getGlobalUserSet: requires 3 arguments"
874 :     unless @_ == 4;
875 :     croak "getGlobalUserSet: argument 1 must contain a user_id"
876 :     unless defined $userID;
877 :     croak "getGlobalUserSet: argument 2 must contain a set_id"
878 :     unless defined $setID;
879 :     croak "getGlobalUserSet: argument 3 must contain a problem_id"
880 :     unless defined $problemID;
881 :    
882 : sh002i 814 my $UserProblem = $self->getUserProblem($userID, $setID, $problemID);
883 :     return unless $UserProblem;
884 :     my $GlobalProblem = $self->getGlobalProblem($setID, $problemID);
885 :     if ($GlobalProblem) {
886 :     foreach ($UserProblem->FIELDS()) {
887 :     next unless $GlobalProblem->can($_);
888 :     next if $UserProblem->$_();
889 :     $UserProblem->$_($GlobalProblem->$_());
890 :     }
891 :     }
892 :     return $UserProblem;
893 : sh002i 798 }
894 : sh002i 775
895 : sh002i 808 ################################################################################
896 :     # debugging
897 :     ################################################################################
898 :    
899 :     sub dumpDB($$) {
900 :     my ($self, $table) = @_;
901 :     return $self->{$table}->dumpDB();
902 :     }
903 :    
904 : sh002i 1012 =head1 AUTHOR
905 :    
906 :     Written by Sam Hathaway, sh002i (at) math.rochester.edu.
907 :    
908 : sh002i 1035 =cut
909 : gage 1023
910 : sh002i 775 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9