| … | |
… | |
| 125 | |
125 | |
| 126 | =cut |
126 | =cut |
| 127 | |
127 | |
| 128 | use strict; |
128 | use strict; |
| 129 | use warnings; |
129 | use warnings; |
|
|
130 | use Carp; |
| 130 | use Data::Dumper; |
131 | use Data::Dumper; |
| 131 | use WeBWorK::Utils qw(runtime_use); |
132 | use WeBWorK::Utils qw(runtime_use); |
| 132 | |
133 | |
| 133 | use constant TABLES => qw(password permission key user set set_user problem problem_user); |
134 | use constant TABLES => qw(password permission key user set set_user problem problem_user); |
| 134 | |
135 | |
| … | |
… | |
| 156 | my $self = {}; |
157 | my $self = {}; |
| 157 | bless $self, $class; # bless this here so we can pass it to the schema |
158 | bless $self, $class; # bless this here so we can pass it to the schema |
| 158 | |
159 | |
| 159 | # load the modules required to handle each table, and create driver |
160 | # load the modules required to handle each table, and create driver |
| 160 | foreach my $table (TABLES) { |
161 | foreach my $table (TABLES) { |
|
|
162 | croak "table $table not specified in dbLayout" |
| 161 | unless (defined $ce->{dbLayout}->{$table}) { |
163 | unless defined $ce->{dbLayout}->{$table}; |
| 162 | warn "ignoring table $table: layout not specified in dbLayout"; # *** |
|
|
| 163 | next; |
|
|
| 164 | } |
|
|
| 165 | |
164 | |
| 166 | my $layout = $ce->{dbLayout}->{$table}; |
165 | my $layout = $ce->{dbLayout}->{$table}; |
| 167 | my $record = $layout->{record}; |
166 | my $record = $layout->{record}; |
| 168 | my $schema = $layout->{schema}; |
167 | my $schema = $layout->{schema}; |
| 169 | my $driver = $layout->{driver}; |
168 | my $driver = $layout->{driver}; |
| 170 | my $source = $layout->{source}; |
169 | my $source = $layout->{source}; |
| 171 | my $params = $layout->{params}; |
170 | my $params = $layout->{params}; |
| 172 | |
171 | |
| 173 | runtime_use($record); |
172 | runtime_use($record); |
|
|
173 | |
|
|
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 | |
| 174 | runtime_use($schema); |
179 | runtime_use($schema); |
| 175 | runtime_use($driver); |
180 | my $schemaObject = eval { $schema->new( |
| 176 | $self->{$table} = $schema->new( |
|
|
| 177 | $self, |
|
|
| 178 | $driver->new($source, $params), |
181 | $self, $driver->new($source, $params), |
| 179 | $table, |
182 | $table, $record, $params) }; |
| 180 | $record, |
183 | croak "new: error instantiating DB schema $schema for table $table: $@" |
| 181 | $params |
184 | if $@; |
| 182 | ); |
185 | |
|
|
186 | $self->{$table} = $schemaObject; |
| 183 | } |
187 | } |
| 184 | |
188 | |
| 185 | return $self; |
189 | return $self; |
| 186 | } |
190 | } |
| 187 | |
191 | |
| … | |
… | |
| 201 | |
205 | |
| 202 | Returns a list of user IDs representing the records in the password table. |
206 | Returns a list of user IDs representing the records in the password table. |
| 203 | |
207 | |
| 204 | =cut |
208 | =cut |
| 205 | |
209 | |
| 206 | sub listPasswords($) { |
210 | sub listPasswords { |
| 207 | my ($self) = @_; |
211 | my ($self) = @_; |
|
|
212 | |
|
|
213 | croak "listPasswords: requires 0 arguments" |
|
|
214 | unless @_ == 1; |
|
|
215 | |
| 208 | return map { $_->[0] } |
216 | return map { $_->[0] } |
| 209 | $self->{password}->list(undef); |
217 | $self->{password}->list(undef); |
| 210 | } |
218 | } |
| 211 | |
219 | |
| 212 | =item addPassword($Password) |
220 | =item addPassword($Password) |
| … | |
… | |
| 218 | |
226 | |
| 219 | =cut |
227 | =cut |
| 220 | |
228 | |
| 221 | sub addPassword($$) { |
229 | sub addPassword($$) { |
| 222 | my ($self, $Password) = @_; |
230 | my ($self, $Password) = @_; |
| 223 | die __PACKAGE__, ": addPassword($Password) failed: user not found.\n" |
231 | |
|
|
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" |
| 224 | unless $self->{user}->exists($Password->user_id); |
239 | unless $self->{user}->exists($Password->user_id); |
|
|
240 | |
| 225 | return $self->{password}->add($Password); |
241 | return $self->{password}->add($Password); |
| 226 | } |
242 | } |
| 227 | |
243 | |
| 228 | =item getPassword($userID) |
244 | =item getPassword($userID) |
| 229 | |
245 | |
| … | |
… | |
| 233 | |
249 | |
| 234 | =cut |
250 | =cut |
| 235 | |
251 | |
| 236 | sub getPassword($$) { |
252 | sub getPassword($$) { |
| 237 | my ($self, $userID) = @_; |
253 | my ($self, $userID) = @_; |
| 238 | die __PACKAGE__, ": getPassword() failed: you must specify a userID.\n" |
254 | |
|
|
255 | croak "getPassword: requires 1 argument" |
|
|
256 | unless @_ == 2; |
|
|
257 | croak "getPassword: argument 1 must contain a user_id" |
| 239 | unless $userID; |
258 | unless defined $userID; |
|
|
259 | |
| 240 | return $self->{password}->get($userID); |
260 | return $self->{password}->get($userID); |
| 241 | } |
261 | } |
| 242 | |
262 | |
| 243 | =item putPassword($Password) |
263 | =item putPassword($Password) |
| 244 | |
264 | |
| … | |
… | |
| 249 | |
269 | |
| 250 | =cut |
270 | =cut |
| 251 | |
271 | |
| 252 | sub putPassword($$) { |
272 | sub putPassword($$) { |
| 253 | my ($self, $Password) = @_; |
273 | my ($self, $Password) = @_; |
|
|
274 | |
|
|
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 | |
| 254 | return $self->{password}->put($Password); |
282 | return $self->{password}->put($Password); |
| 255 | } |
283 | } |
| 256 | |
284 | |
| 257 | =item deletePassword($userID) |
285 | =item deletePassword($userID) |
| 258 | |
286 | |
| … | |
… | |
| 262 | |
290 | |
| 263 | =cut |
291 | =cut |
| 264 | |
292 | |
| 265 | sub deletePassword($$) { |
293 | sub deletePassword($$) { |
| 266 | my ($self, $userID) = @_; |
294 | my ($self, $userID) = @_; |
|
|
295 | |
|
|
296 | croak "putPassword: requires 1 argument" |
|
|
297 | unless @_ == 2; |
|
|
298 | croak "deletePassword: argument 1 must contain a user_id" |
|
|
299 | unless defined $userID; |
|
|
300 | |
| 267 | return $self->{password}->delete($userID); |
301 | return $self->{password}->delete($userID); |
| 268 | } |
302 | } |
| 269 | |
303 | |
| 270 | =back |
304 | =back |
| 271 | |
305 | |
| … | |
… | |
| 275 | # permission functions |
309 | # permission functions |
| 276 | ################################################################################ |
310 | ################################################################################ |
| 277 | |
311 | |
| 278 | sub listPermissionLevels($) { |
312 | sub listPermissionLevels($) { |
| 279 | my ($self) = @_; |
313 | my ($self) = @_; |
|
|
314 | |
|
|
315 | croak "listPermissionLevels: requires 0 arguments" |
|
|
316 | unless @_ == 1; |
|
|
317 | |
| 280 | return map { $_->[0] } |
318 | return map { $_->[0] } |
| 281 | $self->{permission}->list(undef); |
319 | $self->{permission}->list(undef); |
| 282 | } |
320 | } |
| 283 | |
321 | |
| 284 | sub addPermissionLevel($$) { |
322 | sub addPermissionLevel($$) { |
| 285 | my ($self, $PermissionLevel) = @_; |
323 | my ($self, $PermissionLevel) = @_; |
|
|
324 | |
|
|
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); |
| 286 | die "addPermissionLevel failed: user ", $PermissionLevel->user_id, " does not exist.\n" |
331 | croak "addPermissionLevel: user ", $PermissionLevel->user_id, " not found" |
| 287 | unless $self->{user}->exists($PermissionLevel->user_id); |
332 | unless $self->{user}->exists($PermissionLevel->user_id); |
|
|
333 | |
| 288 | return $self->{permission}->add($PermissionLevel); |
334 | return $self->{permission}->add($PermissionLevel); |
| 289 | } |
335 | } |
| 290 | |
336 | |
| 291 | sub getPermissionLevel($$) { |
337 | sub getPermissionLevel($$) { |
| 292 | my ($self, $userID) = @_; |
338 | my ($self, $userID) = @_; |
|
|
339 | |
|
|
340 | croak "getPermissionLevel: requires 1 argument" |
|
|
341 | unless @_ == 2; |
|
|
342 | croak "getPermissionLevel: argument 1 must contain a user_id" |
|
|
343 | unless defined $userID; |
|
|
344 | |
| 293 | return $self->{permission}->get($userID); |
345 | return $self->{permission}->get($userID); |
| 294 | } |
346 | } |
| 295 | |
347 | |
| 296 | sub putPermissionLevel($$) { |
348 | sub putPermissionLevel($$) { |
| 297 | my ($self, $PermissionLevel) = @_; |
349 | my ($self, $PermissionLevel) = @_; |
|
|
350 | |
|
|
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 | |
| 298 | return $self->{permission}->put($PermissionLevel); |
358 | return $self->{permission}->put($PermissionLevel); |
| 299 | } |
359 | } |
| 300 | |
360 | |
| 301 | sub deletePermissionLevel($$) { |
361 | sub deletePermissionLevel($$) { |
| 302 | my ($self, $userID) = @_; |
362 | my ($self, $userID) = @_; |
|
|
363 | |
|
|
364 | croak "deletePermissionLevel: requires 1 argument" |
|
|
365 | unless @_ == 2; |
|
|
366 | croak "deletePermissionLevel: argument 1 must contain a user_id" |
|
|
367 | unless defined $userID; |
|
|
368 | |
| 303 | return $self->{permission}->delete($userID); |
369 | return $self->{permission}->delete($userID); |
| 304 | } |
370 | } |
| 305 | |
371 | |
| 306 | ################################################################################ |
372 | ################################################################################ |
| 307 | # key functions |
373 | # key functions |
| 308 | ################################################################################ |
374 | ################################################################################ |
| 309 | |
375 | |
| 310 | sub listKeys($) { |
376 | sub listKeys($) { |
| 311 | my ($self) = @_; |
377 | my ($self) = @_; |
|
|
378 | |
|
|
379 | croak "listKeys: requires 0 arguments" |
|
|
380 | unless @_ == 1; |
|
|
381 | |
| 312 | return map { $_->[0] } |
382 | return map { $_->[0] } |
| 313 | $self->{key}->list(undef); |
383 | $self->{key}->list(undef); |
| 314 | } |
384 | } |
| 315 | |
385 | |
| 316 | sub addKey($$) { |
386 | sub addKey($$) { |
| 317 | my ($self, $Key) = @_; |
387 | my ($self, $Key) = @_; |
| 318 | die "addKey failed: user ", $Key->user_id, " does not exist.\n" |
388 | |
|
|
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" |
| 319 | unless $self->{user}->exists($Key->user_id); |
396 | unless $self->{user}->exists($Key->user_id); |
|
|
397 | |
| 320 | return $self->{key}->add($Key); |
398 | return $self->{key}->add($Key); |
| 321 | } |
399 | } |
| 322 | |
400 | |
| 323 | sub getKey($$) { |
401 | sub getKey($$) { |
| 324 | my ($self, $userID) = @_; |
402 | my ($self, $userID) = @_; |
|
|
403 | |
|
|
404 | croak "getKey: requires 1 argument" |
|
|
405 | unless @_ == 2; |
|
|
406 | croak "getKey: argument 1 must contain a user_id" |
|
|
407 | unless defined $userID; |
|
|
408 | |
| 325 | return $self->{key}->get($userID); |
409 | return $self->{key}->get($userID); |
| 326 | } |
410 | } |
| 327 | |
411 | |
| 328 | sub putKey($$) { |
412 | sub putKey($$) { |
| 329 | my ($self, $Key) = @_; |
413 | my ($self, $Key) = @_; |
|
|
414 | |
|
|
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 | |
| 330 | return $self->{key}->put($Key); |
422 | return $self->{key}->put($Key); |
| 331 | } |
423 | } |
| 332 | |
424 | |
| 333 | sub deleteKey($$) { |
425 | sub deleteKey($$) { |
| 334 | my ($self, $userID) = @_; |
426 | my ($self, $userID) = @_; |
|
|
427 | |
|
|
428 | croak "deleteKey: requires 1 argument" |
|
|
429 | unless @_ == 2; |
|
|
430 | croak "deleteKey: argument 1 must contain a user_id" |
|
|
431 | unless defined $userID; |
|
|
432 | |
| 335 | return $self->{key}->delete($userID); |
433 | return $self->{key}->delete($userID); |
| 336 | } |
434 | } |
| 337 | |
435 | |
| 338 | ################################################################################ |
436 | ################################################################################ |
| 339 | # user functions |
437 | # user functions |
| 340 | ################################################################################ |
438 | ################################################################################ |
| 341 | |
439 | |
| 342 | sub listUsers($) { |
440 | sub listUsers($) { |
| 343 | my ($self) = @_; |
441 | my ($self) = @_; |
|
|
442 | |
|
|
443 | croak "listUsers: requires 0 arguments" |
|
|
444 | unless @_ == 1; |
|
|
445 | |
| 344 | return map { $_->[0] } |
446 | return map { $_->[0] } |
| 345 | $self->{user}->list(undef); |
447 | $self->{user}->list(undef); |
| 346 | } |
448 | } |
| 347 | |
449 | |
| 348 | sub addUser($$) { |
450 | sub addUser($$) { |
| 349 | my ($self, $User) = @_; |
451 | my ($self, $User) = @_; |
|
|
452 | |
|
|
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 | |
| 350 | return $self->{user}->add($User); |
460 | return $self->{user}->add($User); |
| 351 | } |
461 | } |
| 352 | |
462 | |
| 353 | sub getUser($$) { |
463 | sub getUser($$) { |
| 354 | my ($self, $userID) = @_; |
464 | my ($self, $userID) = @_; |
|
|
465 | |
|
|
466 | croak "getUser: requires 1 argument" |
|
|
467 | unless @_ == 2; |
|
|
468 | croak "getUser: argument 1 must contain a user_id" |
|
|
469 | unless defined $userID; |
|
|
470 | |
| 355 | return $self->{user}->get($userID); |
471 | return $self->{user}->get($userID); |
| 356 | } |
472 | } |
| 357 | |
473 | |
| 358 | sub putUser($$) { |
474 | sub putUser($$) { |
| 359 | my ($self, $User) = @_; |
475 | my ($self, $User) = @_; |
|
|
476 | |
|
|
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 | |
| 360 | return $self->{user}->put($User); |
484 | return $self->{user}->put($User); |
| 361 | } |
485 | } |
| 362 | |
486 | |
| 363 | sub deleteUser($$) { |
487 | sub deleteUser($$) { |
| 364 | my ($self, $userID) = @_; |
488 | my ($self, $userID) = @_; |
|
|
489 | |
|
|
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); |
| 365 | $self->deletePassword($userID); |
497 | $self->deletePassword($userID); |
| 366 | $self->deletePermissionLevel($userID); |
498 | $self->deletePermissionLevel($userID); |
| 367 | $self->deleteKey($userID); |
499 | $self->deleteKey($userID); |
| 368 | $self->deleteUserSet($userID, $_) |
|
|
| 369 | foreach $self->listUsers(); |
|
|
| 370 | return $self->{user}->delete($userID); |
500 | return $self->{user}->delete($userID); |
| 371 | } |
501 | } |
| 372 | |
502 | |
| 373 | ################################################################################ |
503 | ################################################################################ |
| 374 | # set functions |
504 | # set functions |
| 375 | ################################################################################ |
505 | ################################################################################ |
| 376 | |
506 | |
| 377 | sub listGlobalSets($) { |
507 | sub listGlobalSets($) { |
| 378 | my ($self) = @_; |
508 | my ($self) = @_; |
|
|
509 | |
|
|
510 | croak "listGlobalSets: requires 0 arguments" |
|
|
511 | unless @_ == 1; |
|
|
512 | |
| 379 | return map { $_->[0] } |
513 | return map { $_->[0] } |
| 380 | $self->{set}->list(undef); |
514 | $self->{set}->list(undef); |
| 381 | } |
515 | } |
| 382 | |
516 | |
| 383 | sub addGlobalSet($$) { |
517 | sub addGlobalSet($$) { |
| 384 | my ($self, $GlobalSet) = @_; |
518 | my ($self, $GlobalSet) = @_; |
|
|
519 | |
|
|
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 | |
| 385 | return $self->{set}->add($GlobalSet); |
527 | return $self->{set}->add($GlobalSet); |
| 386 | } |
528 | } |
| 387 | |
529 | |
| 388 | sub getGlobalSet($$) { |
530 | sub getGlobalSet($$) { |
| 389 | my ($self, $setID) = @_; |
531 | my ($self, $setID) = @_; |
|
|
532 | |
|
|
533 | croak "getGlobalSet: requires 1 argument" |
|
|
534 | unless @_ == 2; |
|
|
535 | croak "getGlobalSet: argument 1 must contain a set_id" |
|
|
536 | unless defined $setID; |
|
|
537 | |
| 390 | return $self->{set}->get($setID); |
538 | return $self->{set}->get($setID); |
| 391 | } |
539 | } |
| 392 | |
540 | |
| 393 | sub putGlobalSet($$) { |
541 | sub putGlobalSet($$) { |
| 394 | my ($self, $GlobalSet) = @_; |
542 | my ($self, $GlobalSet) = @_; |
|
|
543 | |
|
|
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 | |
| 395 | return $self->{set}->put($GlobalSet); |
551 | return $self->{set}->put($GlobalSet); |
| 396 | } |
552 | } |
| 397 | |
553 | |
| 398 | sub deleteGlobalSet($$) { |
554 | sub deleteGlobalSet($$) { |
| 399 | my ($self, $setID) = @_; |
555 | my ($self, $setID) = @_; |
|
|
556 | |
|
|
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); |
| 400 | $self->deleteGlobalProblem($setID, $_) |
564 | $self->deleteGlobalProblem($setID, $_) |
| 401 | foreach $self->listGlobalProblems($setID); |
565 | foreach $self->listGlobalProblems($setID); |
| 402 | $self->deleteUserSet($_, $setID) |
|
|
| 403 | foreach $self->listUsers(); |
|
|
| 404 | return $self->{set}->delete($setID); |
566 | return $self->{set}->delete($setID); |
| 405 | } |
567 | } |
| 406 | |
568 | |
| 407 | ################################################################################ |
569 | ################################################################################ |
| 408 | # set_user functions |
570 | # set_user functions |
| 409 | ################################################################################ |
571 | ################################################################################ |
| 410 | |
572 | |
| 411 | sub listSetUsers($$) { |
573 | sub listSetUsers($$) { |
| 412 | my ($self, $setID) = @_; |
574 | my ($self, $setID) = @_; |
|
|
575 | |
|
|
576 | croak "listSetUsers: requires 1 argument" |
|
|
577 | unless @_ == 2; |
|
|
578 | croak "listSetUsers: argument 1 must contain a set_id" |
|
|
579 | unless defined $setID; |
|
|
580 | |
| 413 | return map { $_->[0] } # extract user_id |
581 | return map { $_->[0] } # extract user_id |
| 414 | $self->{set_user}->list(undef, $setID); |
582 | $self->{set_user}->list(undef, $setID); |
| 415 | } |
583 | } |
| 416 | |
584 | |
| 417 | sub listUserSets($$) { |
585 | sub listUserSets($$) { |
| 418 | my ($self, $userID) = @_; |
586 | my ($self, $userID) = @_; |
|
|
587 | |
|
|
588 | croak "listUserSets: requires 1 argument" |
|
|
589 | unless @_ == 2; |
|
|
590 | croak "listUserSets: argument 1 must contain a user_id" |
|
|
591 | unless defined $userID; |
|
|
592 | |
| 419 | return map { $_->[1] } # extract set_id |
593 | return map { $_->[1] } # extract set_id |
| 420 | $self->{set_user}->list($userID, undef); |
594 | $self->{set_user}->list($userID, undef); |
| 421 | } |
595 | } |
| 422 | |
596 | |
| 423 | sub addUserSet($$) { |
597 | sub addUserSet($$) { |
| 424 | my ($self, $UserSet) = @_; |
598 | my ($self, $UserSet) = @_; |
|
|
599 | |
|
|
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); |
| 425 | die "addUserSet failed: user ", $UserSet->user_id, " does not exist.\n" |
606 | croak "addUserSet: user ", $UserSet->user_id, " not found" |
| 426 | unless $self->{user}->exists($UserSet->user_id); |
607 | unless $self->{user}->exists($UserSet->user_id); |
| 427 | die "addUserSet failed: set ", $UserSet->set_id, " does not exist.\n" |
608 | croak "addUserSet: set ", $UserSet->set_id, " not found" |
| 428 | unless $self->{set}->exists($UserSet->set_id); |
609 | unless $self->{set}->exists($UserSet->set_id); |
|
|
610 | |
| 429 | return $self->{set_user}->add($UserSet); |
611 | return $self->{set_user}->add($UserSet); |
| 430 | } |
612 | } |
| 431 | |
613 | |
| 432 | sub getUserSet($$$) { |
614 | sub getUserSet($$$) { |
| 433 | my ($self, $userID, $setID) = @_; |
615 | my ($self, $userID, $setID) = @_; |
|
|
616 | |
|
|
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 | |
| 434 | return $self->{set_user}->get($userID, $setID); |
624 | return $self->{set_user}->get($userID, $setID); |
| 435 | } |
625 | } |
| 436 | |
626 | |
| 437 | sub putUserSet($$) { |
627 | sub putUserSet($$) { |
| 438 | my ($self, $UserSet) = @_; |
628 | my ($self, $UserSet) = @_; |
|
|
629 | |
|
|
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 | |
| 439 | return $self->{set_user}->put($UserSet); |
641 | return $self->{set_user}->put($UserSet); |
| 440 | } |
642 | } |
| 441 | |
643 | |
| 442 | sub deleteUserSet($$$) { |
644 | sub deleteUserSet($$$) { |
| 443 | my ($self, $userID, $setID) = @_; |
645 | my ($self, $userID, $setID) = @_; |
|
|
646 | |
|
|
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 | |
| 444 | $self->deleteUserProblem($userID, $setID, $_) |
654 | $self->deleteUserProblem($userID, $setID, $_) |
| 445 | foreach $self->listUserProblems($userID, $setID); |
655 | foreach $self->listUserProblems($userID, $setID); |
| 446 | return $self->{set_user}->delete($userID, $setID); |
656 | return $self->{set_user}->delete($userID, $setID); |
| 447 | } |
657 | } |
| 448 | |
658 | |
| … | |
… | |
| 450 | # problem functions |
660 | # problem functions |
| 451 | ################################################################################ |
661 | ################################################################################ |
| 452 | |
662 | |
| 453 | sub listGlobalProblems($$) { |
663 | sub listGlobalProblems($$) { |
| 454 | my ($self, $setID) = @_; |
664 | my ($self, $setID) = @_; |
|
|
665 | |
|
|
666 | croak "listGlobalProblems: requires 1 arguments" |
|
|
667 | unless @_ == 2; |
|
|
668 | croak "listGlobalProblems: argument 1 must contain a set_id" |
|
|
669 | unless defined $setID; |
|
|
670 | |
| 455 | return map { $_->[1] } |
671 | return map { $_->[1] } |
| 456 | #grep { $_->[0] eq $setID } |
|
|
| 457 | $self->{problem}->list($setID, undef); |
672 | $self->{problem}->list($setID, undef); |
| 458 | } |
673 | } |
| 459 | |
674 | |
| 460 | sub addGlobalProblem($$) { |
675 | sub addGlobalProblem($$) { |
| 461 | my ($self, $GlobalProblem) = @_; |
676 | my ($self, $GlobalProblem) = @_; |
|
|
677 | |
|
|
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); |
| 462 | die "addGlobalProblem failed: set ", $GlobalProblem->set_id, " does not exist.\n" |
684 | croak "addGlobalProblem: set ", $GlobalProblem->set_id, " not found" |
| 463 | unless $self->{set}->exists($GlobalProblem->set_id); |
685 | unless $self->{set}->exists($GlobalProblem->set_id); |
|
|
686 | |
| 464 | return $self->{problem}->add($GlobalProblem); |
687 | return $self->{problem}->add($GlobalProblem); |
| 465 | } |
688 | } |
| 466 | |
689 | |
| 467 | sub getGlobalProblem($$$) { |
690 | sub getGlobalProblem($$$) { |
| 468 | my ($self, $setID, $problemID) = @_; |
691 | my ($self, $setID, $problemID) = @_; |
|
|
692 | |
|
|
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 | |
| 469 | return $self->{problem}->get($setID, $problemID); |
700 | return $self->{problem}->get($setID, $problemID); |
| 470 | } |
701 | } |
| 471 | |
702 | |
| 472 | sub putGlobalProblem($$) { |
703 | sub putGlobalProblem($$) { |
| 473 | my ($self, $GlobalProblem) = @_; |
704 | my ($self, $GlobalProblem) = @_; |
|
|
705 | |
|
|
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 | |
| 474 | return $self->{problem}->put($GlobalProblem); |
715 | return $self->{problem}->put($GlobalProblem); |
| 475 | } |
716 | } |
| 476 | |
717 | |
| 477 | sub deleteGlobalProblem($$$) { |
718 | sub deleteGlobalProblem($$$) { |
| 478 | my ($self, $setID, $problemID) = @_; |
719 | my ($self, $setID, $problemID) = @_; |
|
|
720 | |
|
|
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 | |
| 479 | $self->deleteUserProblem($_, $setID, $problemID) |
728 | $self->deleteUserProblem($_, $setID, $problemID) |
| 480 | foreach $self->listUsers(); |
729 | foreach $self->listProblemUsers($setID, $problemID); |
| 481 | return $self->{problem}->delete($setID, $problemID); |
730 | return $self->{problem}->delete($setID, $problemID); |
| 482 | } |
731 | } |
| 483 | |
732 | |
| 484 | ################################################################################ |
733 | ################################################################################ |
| 485 | # problem_user functions |
734 | # problem_user functions |
| 486 | ################################################################################ |
735 | ################################################################################ |
| 487 | |
736 | |
| 488 | sub listProblemUsers($$$) { |
737 | sub listProblemUsers($$$) { |
| 489 | my ($self, $setID, $problemID) = @_; |
738 | my ($self, $setID, $problemID) = @_; |
|
|
739 | |
|
|
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 | |
| 490 | return map { $_->[0] } # extract user_id |
747 | return map { $_->[0] } # extract user_id |
| 491 | $self->{problem_user}->list(undef, $setID, $problemID); |
748 | $self->{problem_user}->list(undef, $setID, $problemID); |
| 492 | } |
749 | } |
| 493 | |
750 | |
| 494 | sub listUserProblems($$$) { |
751 | sub listUserProblems($$$) { |
| 495 | my ($self, $userID, $setID) = @_; |
752 | my ($self, $userID, $setID) = @_; |
|
|
753 | |
|
|
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 | |
| 496 | return map { $_->[2] } # extract problem_id |
761 | return map { $_->[2] } # extract problem_id |
| 497 | $self->{problem_user}->list($userID, $setID, undef); |
762 | $self->{problem_user}->list($userID, $setID, undef); |
| 498 | } |
763 | } |
| 499 | |
764 | |
| 500 | sub addUserProblem($$) { |
765 | sub addUserProblem($$) { |
| 501 | my ($self, $UserProblem) = @_; |
766 | my ($self, $UserProblem) = @_; |
| 502 | die "addUserProblem failed: user set ", $UserProblem->set_id, " does not exist.\n" |
767 | |
|
|
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" |
| 503 | unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id); |
775 | unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id); |
| 504 | die "addUserProblem failed: problem ", $UserProblem->problem_id, " does not exist.\n" |
776 | croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found" |
| 505 | unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id); |
777 | unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id); |
|
|
778 | |
| 506 | return $self->{problem_user}->add($UserProblem); |
779 | return $self->{problem_user}->add($UserProblem); |
| 507 | } |
780 | } |
| 508 | |
781 | |
| 509 | sub getUserProblem($$$$) { |
782 | sub getUserProblem($$$$) { |
| 510 | my ($self, $userID, $setID, $problemID) = @_; |
783 | my ($self, $userID, $setID, $problemID) = @_; |
|
|
784 | |
|
|
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 | |
| 511 | return $self->{problem_user}->get($userID, $setID, $problemID); |
794 | return $self->{problem_user}->get($userID, $setID, $problemID); |
| 512 | } |
795 | } |
| 513 | |
796 | |
| 514 | sub putUserProblem($$) { |
797 | sub putUserProblem($$) { |
| 515 | my ($self, $UserProblem) = @_; |
798 | my ($self, $UserProblem) = @_; |
|
|
799 | |
|
|
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 problem not found (perhaps you meant to use addUserProblem?)" |
|
|
805 | unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id); |
|
|
806 | croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found" |
|
|
807 | unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id); |
|
|
808 | 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 | |
| 516 | return $self->{problem_user}->put($UserProblem); |
811 | return $self->{problem_user}->put($UserProblem); |
| 517 | } |
812 | } |
| 518 | |
813 | |
| 519 | sub deleteUserProblem($$$$) { |
814 | sub deleteUserProblem($$$$) { |
| 520 | my ($self, $userID, $setID, $problemID) = @_; |
815 | my ($self, $userID, $setID, $problemID) = @_; |
|
|
816 | |
|
|
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 | |
| 521 | return $self->{problem_user}->delete($userID, $setID, $problemID); |
826 | return $self->{problem_user}->delete($userID, $setID, $problemID); |
| 522 | } |
827 | } |
| 523 | |
828 | |
| 524 | ################################################################################ |
829 | ################################################################################ |
| 525 | # set+set_user functions |
830 | # set+set_user functions |
| 526 | ################################################################################ |
831 | ################################################################################ |
| 527 | |
832 | |
| 528 | sub getGlobalUserSet($$$) { |
833 | sub getGlobalUserSet { |
|
|
834 | carp "getGlobalUserSet: this method is deprecated -- use getMergedSet instead"; |
|
|
835 | return shift->getMergedSet(@_); |
|
|
836 | } |
|
|
837 | |
|
|
838 | sub getMergedSet { |
| 529 | my ($self, $userID, $setID) = @_; |
839 | my ($self, $userID, $setID) = @_; |
|
|
840 | |
|
|
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 | |
| 530 | my $UserSet = $self->getUserSet($userID, $setID); |
848 | my $UserSet = $self->getUserSet($userID, $setID); |
| 531 | return unless $UserSet; |
849 | return unless $UserSet; |
| 532 | my $GlobalSet = $self->getGlobalSet($setID); |
850 | my $GlobalSet = $self->getGlobalSet($setID); |
| 533 | if ($GlobalSet) { |
851 | if ($GlobalSet) { |
| 534 | foreach ($UserSet->FIELDS()) { |
852 | foreach ($UserSet->FIELDS()) { |
| … | |
… | |
| 542 | |
860 | |
| 543 | ################################################################################ |
861 | ################################################################################ |
| 544 | # problem+problem_user functions |
862 | # problem+problem_user functions |
| 545 | ################################################################################ |
863 | ################################################################################ |
| 546 | |
864 | |
| 547 | sub getGlobalUserProblem($$$$) { |
865 | sub getGlobalUserProblem { |
|
|
866 | carp "getGlobalUserProblem: this method is deprecated -- use getMergedProblem instead"; |
|
|
867 | return shift->getMergedProblem(@_); |
|
|
868 | } |
|
|
869 | |
|
|
870 | sub getMergedProblem { |
| 548 | my ($self, $userID, $setID, $problemID) = @_; |
871 | my ($self, $userID, $setID, $problemID) = @_; |
|
|
872 | |
|
|
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 | |
| 549 | my $UserProblem = $self->getUserProblem($userID, $setID, $problemID); |
882 | my $UserProblem = $self->getUserProblem($userID, $setID, $problemID); |
| 550 | return unless $UserProblem; |
883 | return unless $UserProblem; |
| 551 | my $GlobalProblem = $self->getGlobalProblem($setID, $problemID); |
884 | my $GlobalProblem = $self->getGlobalProblem($setID, $problemID); |
| 552 | if ($GlobalProblem) { |
885 | if ($GlobalProblem) { |
| 553 | foreach ($UserProblem->FIELDS()) { |
886 | foreach ($UserProblem->FIELDS()) { |
| … | |
… | |
| 558 | } |
891 | } |
| 559 | return $UserProblem; |
892 | return $UserProblem; |
| 560 | } |
893 | } |
| 561 | |
894 | |
| 562 | ################################################################################ |
895 | ################################################################################ |
| 563 | # enforcement |
|
|
| 564 | ################################################################################ |
|
|
| 565 | |
|
|
| 566 | ################################################################################ |
|
|
| 567 | # debugging |
896 | # debugging |
| 568 | ################################################################################ |
897 | ################################################################################ |
| 569 | |
898 | |
| 570 | sub dumpDB($$) { |
899 | sub dumpDB($$) { |
| 571 | my ($self, $table) = @_; |
900 | my ($self, $table) = @_; |