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

Revision 1185		Revision 1696
1	################################################################################	1	################################################################################
2	# WeBWorK mod_perl (c) 2000-2002 WeBWorK Project	2	# WeBWorK Online Homework Delivery System
3	# $Id$	3	# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
		4	# $CVSHeader: webwork-modperl/lib/WeBWorK/DB.pm,v 1.44 2003/12/18 23:15:33 sh002i Exp $
		5	#
		6	# This program is free software; you can redistribute it and/or modify it under
		7	# the terms of either: (a) the GNU General Public License as published by the
		8	# Free Software Foundation; either version 2, or (at your option) any later
		9	# version, or (b) the "Artistic License" which comes with this package.
		10	#
		11	# This program is distributed in the hope that it will be useful, but WITHOUT
		12	# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
		13	# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
		14	# Artistic License for more details.
4	################################################################################	15	################################################################################
5		16
6	package WeBWorK::DB;	17	package WeBWorK::DB;
7		18
8	=head1 NAME	19	=head1 NAME
9		20
10	WeBWorK::DB - interface with the WeBWorK databases.	21	WeBWorK::DB - interface with the WeBWorK databases.
11		22
12	=head1 SYNOPSIS	23	=head1 SYNOPSIS
13		24
14	my $db = WeBWorK::DB->new($courseEnvironment);	25	my $db = WeBWorK::DB->new($dbLayout);
15		26
16	my @userIDs = $db->listUsers();	27	my @userIDs = $db->listUsers();
17	my $Sam = $db->{user}->{record}->new();	28	my $Sam = $db->{user}->{record}->new();
18		29
19	$Sam->user_id("sammy");	30	$Sam->user_id("sammy");
…		…
31	=head1 DESCRIPTION	42	=head1 DESCRIPTION
32		43
33	WeBWorK::DB provides a consistent interface to a number of database backends.	44	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	45	Access and modification functions are provided for each logical table used by
35	the webwork system. The particular backend ("schema" and "driver"), record	46	the webwork system. The particular backend ("schema" and "driver"), record
36	class, data source, and additional parameters are specified by the C<%dbLayout>	47	class, data source, and additional parameters are specified by the hash
37	hash in the course environment.	48	referenced by C<$dbLayout>, usually taken from the course environment.
38		49
39	=head1 ARCHITECTURE	50	=head1 ARCHITECTURE
40		51
41	The new database system uses a three-tier architecture to insulate each layer	52	The new database system uses a three-tier architecture to insulate each layer
42	from the adjacent layers.	53	from the adjacent layers.
…		…
44	=head2 Top Layer: DB	55	=head2 Top Layer: DB
45		56
46	The top layer of the architecture is the DB module. It provides the methods	57	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.	58	listed below, and uses schema modules (via tables) to implement those methods.
48		59
49	/ list* exists* add* get* put* delete* \ <- api	60	/ new* list* exists* add* get* gets put delete* \ <- api
50	+------------------------------------------------------------------+	61	+------------------------------------------------------------------+
51	\| DB \|	62	\| DB \|
52	+------------------------------------------------------------------+	63	+------------------------------------------------------------------+
53	\ password permission key user set set_user problem problem_user / <- tables	64	\ password permission key user set set_user problem problem_user / <- tables
54		65
…		…
127		138
128	use strict;	139	use strict;
129	use warnings;	140	use warnings;
130	use Carp;	141	use Carp;
131	use Data::Dumper;	142	use Data::Dumper;
		143	use WeBWorK::Timing;
132	use WeBWorK::Utils qw(runtime_use);	144	use WeBWorK::Utils qw(runtime_use);
133
134	use constant TABLES => qw(password permission key user set set_user problem problem_user);
135		145
136	################################################################################	146	################################################################################
137	# constructor	147	# constructor
138	################################################################################	148	################################################################################
139		149
…		…
147	schema/driver structure according to the C<%dbLayout> hash in C<$ce>, a	157	schema/driver structure according to the C<%dbLayout> hash in C<$ce>, a
148	WeBWorK::CourseEnvironment object.	158	WeBWorK::CourseEnvironment object.
149		159
150	=back	160	=back
151		161
152	=head2 C<%dbLayout> Format	162	=head2 C<$dbLayout> Format
153		163
154	The C<%dbLayout> hash consists of items keyed by table names. The value of each	164	C<$dbLayout> is a hash reference consisting of items keyed by table names. The
155	item is a reference to a hash containing the following items:	165	value of each item is a reference to a hash containing the following items:
156		166
157	=over	167	=over
158		168
159	=item record	169	=item record
160		170
…		…
179	schemas require parameters, some do not. Consult the documentation for the	189	schemas require parameters, some do not. Consult the documentation for the
180	schema in question.	190	schema in question.
181		191
182	=back	192	=back
183		193
184	For each table defined in C<%dbLayout>, C<new> loads the record, schema, and	194	For each table defined in C<$dbLayout>, C<new> loads the record, schema, and
185	driver modules. It the schema module's C<tables> method lists the current table	195	driver modules. It the schema module's C<tables> method lists the current table
186	(or contains the string "*") and the output of the schema and driver modules'	196	(or contains the string "*") and the output of the schema and driver modules'
187	C<style> methods match, the table is installed. Otherwise, an exception is	197	C<style> methods match, the table is installed. Otherwise, an exception is
188	thrown.	198	thrown.
189		199
190	=cut	200	=cut
191		201
192	sub new($$) {	202	sub new($$) {
193	my ($invocant, $ce) = @_;	203	my ($invocant, $dbLayout) = @_;
194	my $class = ref($invocant) \|\| $invocant;	204	my $class = ref($invocant) \|\| $invocant;
195	my $self = {};	205	my $self = {};
196	bless $self, $class; # bless this here so we can pass it to the schema	206	bless $self, $class; # bless this here so we can pass it to the schema
197		207
198	# load the modules required to handle each table, and create driver	208	# load the modules required to handle each table, and create driver
199	my %dbLayout = %{$ce->{dbLayout}};	209	my %dbLayout = %$dbLayout;
200	foreach my $table (keys %dbLayout) {	210	foreach my $table (keys %dbLayout) {
201	my $layout = $dbLayout{$table};	211	my $layout = $dbLayout{$table};
202	my $record = $layout->{record};	212	my $record = $layout->{record};
203	my $schema = $layout->{schema};	213	my $schema = $layout->{schema};
204	my $driver = $layout->{driver};	214	my $driver = $layout->{driver};
…		…
212	croak "error instantiating DB driver $driver for table $table: $@"	222	croak "error instantiating DB driver $driver for table $table: $@"
213	if $@;	223	if $@;
214		224
215	runtime_use($schema);	225	runtime_use($schema);
216	my $schemaObject = eval { $schema->new(	226	my $schemaObject = eval { $schema->new(
217	$self, $driver->new($source, $params),	227	$self, $driverObject, $table, $record, $params) };
218	$table, $record, $params) };
219	croak "error instantiating DB schema $schema for table $table: $@"	228	croak "error instantiating DB schema $schema for table $table: $@"
220	if $@;	229	if $@;
221		230
222	$self->{$table} = $schemaObject;	231	$self->{$table} = $schemaObject;
223	}	232	}
…		…
235		244
236	=head2 Password Methods	245	=head2 Password Methods
237		246
238	=over	247	=over
239		248
		249	=item newPassword()
		250
		251	Returns a new, empty password object.
		252
		253	=cut
		254
		255	sub newPassword {
		256	my ($self, @prototype) = @_;
		257	return $self->{password}->{record}->new(@prototype);
		258	}
		259
240	=item listPasswords()	260	=item listPasswords()
241		261
242	Returns a list of user IDs representing the records in the password table.	262	Returns a list of user IDs representing the records in the password table.
243		263
244	=cut	264	=cut
…		…
260	an exception is thrown. To add a password, a user with a matching user ID must	280	an exception is thrown. To add a password, a user with a matching user ID must
261	exist in the user table.	281	exist in the user table.
262		282
263	=cut	283	=cut
264		284
265	sub addPassword($$) {	285	sub addPassword {
266	my ($self, $Password) = @_;	286	my ($self, $Password) = @_;
267		287
268	croak "addPassword: requires 1 argument"	288	croak "addPassword: requires 1 argument"
269	unless @_ == 2;	289	unless @_ == 2;
270	croak "addPassword: argument 1 must be of type ", $self->{password}->{record}	290	croak "addPassword: argument 1 must be of type ", $self->{password}->{record}
271	unless ref $Password eq $self->{password}->{record};	291	unless ref $Password eq $self->{password}->{record};
		292
		293	checkKeyfields($Password);
		294
272	croak "addPassword: password exists (perhaps you meant to use putPassword?)"	295	croak "addPassword: password exists (perhaps you meant to use putPassword?)"
273	if $self->{password}->exists($Password->user_id);	296	if $self->{password}->exists($Password->user_id);
274	croak "addPassword: user ", $Password->user_id, " not found"	297	croak "addPassword: user ", $Password->user_id, " not found"
275	unless $self->{user}->exists($Password->user_id);	298	unless $self->{user}->exists($Password->user_id);
276		299
…		…
278	}	301	}
279		302
280	=item getPassword($userID)	303	=item getPassword($userID)
281		304
282	If a record with a matching user ID exists, a record object containting that	305	If a record with a matching user ID exists, a record object containting that
283	record's data will be returned. If no such record exists, an undefined value	306	record's data will be returned. If no such record exists, one will be created.
284	will be returned.
285		307
286	=cut	308	=cut
287		309
288	sub getPassword($$) {	310	sub getPassword {
289	my ($self, $userID) = @_;	311	my ($self, $userID) = @_;
290		312
291	croak "getPassword: requires 1 argument"	313	croak "getPassword: requires 1 argument"
292	unless @_ == 2;	314	unless @_ == 2;
293	croak "getPassword: argument 1 must contain a user_id"	315	croak "getPassword: argument 1 must contain a user_id"
294	unless defined $userID;	316	unless defined $userID;
295		317
296	return $self->{password}->get($userID);	318	#return $self->{password}->get($userID);
		319	return ( $self->getPasswords($userID) )[0];
		320	}
		321
		322	=item getPasswords(@uesrIDs)
		323
		324	Return a list of password records associated with the user IDs given. If there
		325	is no record associated with a given user ID, one will be created.
		326
		327	=cut
		328
		329	sub getPasswords {
		330	my ($self, @userIDs) = @_;
		331
		332	#croak "getPasswords: requires 1 or more argument"
		333	# unless @_ >= 2;
		334	foreach my $i (0 .. $#userIDs) {
		335	croak "getPasswords: element $i of argument list must contain a user_id"
		336	unless defined $userIDs[$i];
		337	}
		338
		339	my @Passwords = $self->{password}->gets(map { [$_] } @userIDs);
		340
		341	for (my $i = 0; $i < @Passwords; $i++) {
		342	my $Password = $Passwords[$i];
		343	my $userID = $userIDs[$i];
		344	if (not defined $Password) {
		345	#warn "not defined\n";
		346	if ($self->{user}->exists($userID)) {
		347	#warn "user exists\n";
		348	$Password = $self->newPassword(user_id => $userID);
		349	eval { $self->addPassword($Password) };
		350	if ($@ and $@ !~ m/password exists/) {
		351	die "error while auto-creating password record for user $userID: \"$@\"";
		352	}
		353	}
		354	}
		355	}
		356
		357	return @Passwords;
297	}	358	}
298		359
299	=item putPassword($Password)	360	=item putPassword($Password)
300		361
301	$Password is a record object. If a password record with the same user ID exists	362	$Password is a record object. If a password record with the same user ID exists
…		…
310		371
311	croak "putPassword: requires 1 argument"	372	croak "putPassword: requires 1 argument"
312	unless @_ == 2;	373	unless @_ == 2;
313	croak "putPassword: argument 1 must be of type ", $self->{password}->{record}	374	croak "putPassword: argument 1 must be of type ", $self->{password}->{record}
314	unless ref $Password eq $self->{password}->{record};	375	unless ref $Password eq $self->{password}->{record};
		376
		377	checkKeyfields($Password);
		378
315	croak "putPassword: password not found (perhaps you meant to use addPassword?)"	379	croak "putPassword: password not found (perhaps you meant to use addPassword?)"
316	unless $self->{password}->exists($Password->user_id);	380	unless $self->{password}->exists($Password->user_id);
317		381
318	return $self->{password}->put($Password);	382	return $self->{password}->put($Password);
319	}	383	}
…		…
346	################################################################################	410	################################################################################
347		411
348	=head2 Permission Level Methods	412	=head2 Permission Level Methods
349		413
350	=over	414	=over
		415
		416	=item newPermissionLevel()
		417
		418	Returns a new, empty permission level object.
		419
		420	=cut
		421
		422	sub newPermissionLevel {
		423	my ($self, @prototype) = @_;
		424	return $self->{permission}->{record}->new(@prototype);
		425	}
351		426
352	=item listPermissionLevels()	427	=item listPermissionLevels()
353		428
354	Returns a list of user IDs representing the records in the permission table.	429	Returns a list of user IDs representing the records in the permission table.
355		430
…		…
379		454
380	croak "addPermissionLevel: requires 1 argument"	455	croak "addPermissionLevel: requires 1 argument"
381	unless @_ == 2;	456	unless @_ == 2;
382	croak "addPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}	457	croak "addPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}
383	unless ref $PermissionLevel eq $self->{permission}->{record};	458	unless ref $PermissionLevel eq $self->{permission}->{record};
		459
		460	checkKeyfields($PermissionLevel);
		461
384	croak "addPermissionLevel: permission level exists (perhaps you meant to use putPermissionLevel?)"	462	croak "addPermissionLevel: permission level exists (perhaps you meant to use putPermissionLevel?)"
385	if $self->{permission}->exists($PermissionLevel->user_id);	463	if $self->{permission}->exists($PermissionLevel->user_id);
386	croak "addPermissionLevel: user ", $PermissionLevel->user_id, " not found"	464	croak "addPermissionLevel: user ", $PermissionLevel->user_id, " not found"
387	unless $self->{user}->exists($PermissionLevel->user_id);	465	unless $self->{user}->exists($PermissionLevel->user_id);
388		466
…		…
390	}	468	}
391		469
392	=item getPermissionLevel($userID)	470	=item getPermissionLevel($userID)
393		471
394	If a record with a matching user ID exists, a record object containting that	472	If a record with a matching user ID exists, a record object containting that
395	record's data will be returned. If no such record exists, an undefined value	473	record's data will be returned. If no such record exists, one will be created.
396	will be returned.
397		474
398	=cut	475	=cut
399		476
400	sub getPermissionLevel($$) {	477	sub getPermissionLevel($$) {
401	my ($self, $userID) = @_;	478	my ($self, $userID) = @_;
…		…
403	croak "getPermissionLevel: requires 1 argument"	480	croak "getPermissionLevel: requires 1 argument"
404	unless @_ == 2;	481	unless @_ == 2;
405	croak "getPermissionLevel: argument 1 must contain a user_id"	482	croak "getPermissionLevel: argument 1 must contain a user_id"
406	unless defined $userID;	483	unless defined $userID;
407		484
408	return $self->{permission}->get($userID);	485	#return $self->{permission}->get($userID);
		486	return ( $self->getPermissionLevels($userID) )[0];
		487	}
		488
		489	=item getPermissionLevels(@uesrIDs)
		490
		491	Return a list of permission level records associated with the user IDs given. If
		492	there is no record associated with a given user ID, one will be created.
		493
		494	=cut
		495
		496	sub getPermissionLevels {
		497	my ($self, @userIDs) = @_;
		498
		499	#croak "getPermissionLevels: requires 1 or more argument"
		500	# unless @_ >= 2;
		501	foreach my $i (0 .. $#userIDs) {
		502	croak "getPermissionLevels: element $i of argument list must contain a user_id"
		503	unless defined $userIDs[$i];
		504	}
		505
		506	my @PermissionLevels = $self->{permission}->gets(map { [$_] } @userIDs);
		507
		508	for (my $i = 0; $i < @PermissionLevels; $i++) {
		509	my $PermissionLevel = $PermissionLevels[$i];
		510	my $userID = $userIDs[$i];
		511	if (not defined $PermissionLevel) {
		512	#warn "not defined\n";
		513	if ($self->{user}->exists($userID)) {
		514	#warn "user exists\n";
		515	$PermissionLevel = $self->newPermissionLevel(user_id => $userID);
		516	warn $PermissionLevel->toString, "\n";
		517	eval { $self->addPermissionLevel($PermissionLevel) };
		518	if ($@ and $@ !~ m/permission level exists/) {
		519	die "error while auto-creating permission level record for user $userID: \"$@\"";
		520	}
		521	}
		522	}
		523	}
		524
		525	return @PermissionLevels;
409	}	526	}
410		527
411	=item putPermissionLevel($PermissionLevel)	528	=item putPermissionLevel($PermissionLevel)
412		529
413	$PermissionLevel is a record object. If a permission level record with the same	530	$PermissionLevel is a record object. If a permission level record with the same
…		…
422		539
423	croak "putPermissionLevel: requires 1 argument"	540	croak "putPermissionLevel: requires 1 argument"
424	unless @_ == 2;	541	unless @_ == 2;
425	croak "putPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}	542	croak "putPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}
426	unless ref $PermissionLevel eq $self->{permission}->{record};	543	unless ref $PermissionLevel eq $self->{permission}->{record};
		544
		545	checkKeyfields($PermissionLevel);
		546
427	croak "putPermissionLevel: permission level not found (perhaps you meant to use addPermissionLevel?)"	547	croak "putPermissionLevel: permission level not found (perhaps you meant to use addPermissionLevel?)"
428	unless $self->{permission}->exists($PermissionLevel->user_id);	548	unless $self->{permission}->exists($PermissionLevel->user_id);
429		549
430	return $self->{permission}->put($PermissionLevel);	550	return $self->{permission}->put($PermissionLevel);
431	}	551	}
…		…
454	################################################################################	574	################################################################################
455		575
456	=head2 Key Methods	576	=head2 Key Methods
457		577
458	=over	578	=over
		579
		580	=item newKey()
		581
		582	Returns a new, empty key object.
		583
		584	=cut
		585
		586	sub newKey {
		587	my ($self, @prototype) = @_;
		588	return $self->{key}->{record}->new(@prototype);
		589	}
459		590
460	=item listKeys()	591	=item listKeys()
461		592
462	Returns a list of user IDs representing the records in the key table.	593	Returns a list of user IDs representing the records in the key table.
463		594
…		…
487		618
488	croak "addKey: requires 1 argument"	619	croak "addKey: requires 1 argument"
489	unless @_ == 2;	620	unless @_ == 2;
490	croak "addKey: argument 1 must be of type ", $self->{key}->{record}	621	croak "addKey: argument 1 must be of type ", $self->{key}->{record}
491	unless ref $Key eq $self->{key}->{record};	622	unless ref $Key eq $self->{key}->{record};
		623
		624	checkKeyfields($Key);
		625
492	croak "addKey: key exists (perhaps you meant to use putKey?)"	626	croak "addKey: key exists (perhaps you meant to use putKey?)"
493	if $self->{key}->exists($Key->user_id);	627	if $self->{key}->exists($Key->user_id);
494	croak "addKey: user ", $Key->user_id, " not found"	628	croak "addKey: user ", $Key->user_id, " not found"
495	unless $self->{user}->exists($Key->user_id);	629	unless $self->{user}->exists($Key->user_id);
496		630
…		…
514	unless defined $userID;	648	unless defined $userID;
515		649
516	return $self->{key}->get($userID);	650	return $self->{key}->get($userID);
517	}	651	}
518		652
		653	=item getKeys(@uesrIDs)
		654
		655	Return a list of key records associated with the user IDs given. If there is no
		656	record associated with a given user ID, that element of the list will be
		657	undefined.
		658
		659	=cut
		660
		661	sub getKeys {
		662	my ($self, @userIDs) = @_;
		663
		664	#croak "getKeys: requires 1 or more argument"
		665	# unless @_ >= 2;
		666	foreach my $i (0 .. $#userIDs) {
		667	croak "getKeys: element $i of argument list must contain a user_id"
		668	unless defined $userIDs[$i];
		669	}
		670
		671	return $self->{key}->gets(map { [$_] } @userIDs);
		672	}
		673
519	=item putKey($Key)	674	=item putKey($Key)
520		675
521	$Key is a record object. If a key record with the same user ID exists in the	676	$Key is a record object. If a key record with the same user ID exists in the
522	key table, the data in the record is replaced with the data in $Key. If a	677	key table, the data in the record is replaced with the data in $Key. If a
523	matching key record does not exist, an exception is thrown.	678	matching key record does not exist, an exception is thrown.
…		…
529		684
530	croak "putKey: requires 1 argument"	685	croak "putKey: requires 1 argument"
531	unless @_ == 2;	686	unless @_ == 2;
532	croak "putKey: argument 1 must be of type ", $self->{key}->{record}	687	croak "putKey: argument 1 must be of type ", $self->{key}->{record}
533	unless ref $Key eq $self->{key}->{record};	688	unless ref $Key eq $self->{key}->{record};
		689
		690	checkKeyfields($Key);
		691
534	croak "putKey: key not found (perhaps you meant to use addKey?)"	692	croak "putKey: key not found (perhaps you meant to use addKey?)"
535	unless $self->{key}->exists($Key->user_id);	693	unless $self->{key}->exists($Key->user_id);
536		694
537	return $self->{key}->put($Key);	695	return $self->{key}->put($Key);
538	}	696	}
…		…
562		720
563	=head2 User Methods	721	=head2 User Methods
564		722
565	=over	723	=over
566		724
		725	=item newUser()
		726
		727	Returns a new, empty user object.
		728
		729	=cut
		730
		731	sub newUser {
		732	my ($self, @prototype) = @_;
		733	return $self->{user}->{record}->new(@prototype);
		734	}
		735
567	=item listUsers()	736	=item listUsers()
568		737
569	Returns a list of user IDs representing the records in the user table.	738	Returns a list of user IDs representing the records in the user table.
570		739
571	=cut	740	=cut
572		741
573	sub listUsers($) {	742	sub listUsers {
574	my ($self) = @_;	743	my ($self) = @_;
575		744
576	croak "listUsers: requires 0 arguments"	745	croak "listUsers: requires 0 arguments"
577	unless @_ == 1;	746	unless @_ == 1;
578		747
…		…
586	with the same user ID does not already exist. If one does exist, an exception	755	with the same user ID does not already exist. If one does exist, an exception
587	is thrown.	756	is thrown.
588		757
589	=cut	758	=cut
590		759
591	sub addUser($$) {	760	sub addUser {
592	my ($self, $User) = @_;	761	my ($self, $User) = @_;
593		762
594	croak "addUser: requires 1 argument"	763	croak "addUser: requires 1 argument"
595	unless @_ == 2;	764	unless @_ == 2;
596	croak "addUser: argument 1 must be of type ", $self->{user}->{record}	765	croak "addUser: argument 1 must be of type ", $self->{user}->{record}
597	unless ref $User eq $self->{user}->{record};	766	unless ref $User eq $self->{user}->{record};
		767
		768	checkKeyfields($User);
		769
598	croak "addUser: user exists (perhaps you meant to use putUser?)"	770	croak "addUser: user exists (perhaps you meant to use putUser?)"
599	if $self->{user}->exists($User->user_id);	771	if $self->{user}->exists($User->user_id);
600		772
601	return $self->{user}->add($User);	773	return $self->{user}->add($User);
602	}	774	}
…		…
607	record's data will be returned. If no such record exists, an undefined value	779	record's data will be returned. If no such record exists, an undefined value
608	will be returned.	780	will be returned.
609		781
610	=cut	782	=cut
611		783
612	sub getUser($$) {	784	sub getUser {
613	my ($self, $userID) = @_;	785	my ($self, $userID) = @_;
614		786
615	croak "getUser: requires 1 argument"	787	croak "getUser: requires 1 argument"
616	unless @_ == 2;	788	unless @_ == 2;
617	croak "getUser: argument 1 must contain a user_id"	789	croak "getUser: argument 1 must contain a user_id"
618	unless defined $userID;	790	unless defined $userID;
619		791
620	return $self->{user}->get($userID);	792	return $self->{user}->get($userID);
		793	}
		794
		795	=item getUsers(@uesrIDs)
		796
		797	Return a list of user records associated with the user IDs given. If there is no
		798	record associated with a given user ID, that element of the list will be
		799	undefined.
		800
		801	=cut
		802
		803	sub getUsers {
		804	my ($self, @userIDs) = @_;
		805
		806	#croak "getUsers: requires 1 or more argument"
		807	# unless @_ >= 2;
		808	foreach my $i (0 .. $#userIDs) {
		809	croak "getUsers: element $i of argument list must contain a user_id"
		810	unless defined $userIDs[$i];
		811	}
		812
		813	return $self->{user}->gets(map { [$_] } @userIDs);
621	}	814	}
622		815
623	=item putUser($User)	816	=item putUser($User)
624		817
625	$User is a record object. If a user record with the same user ID exists in the	818	$User is a record object. If a user record with the same user ID exists in the
626	user table, the data in the record is replaced with the data in $User. If a	819	user table, the data in the record is replaced with the data in $User. If a
627	matching user record does not exist, an exception is thrown.	820	matching user record does not exist, an exception is thrown.
628		821
629	=cut	822	=cut
630		823
631	sub putUser($$) {	824	sub putUser {
632	my ($self, $User) = @_;	825	my ($self, $User) = @_;
633		826
634	croak "putUser: requires 1 argument"	827	croak "putUser: requires 1 argument"
635	unless @_ == 2;	828	unless @_ == 2;
636	croak "putUser: argument 1 must be of type ", $self->{user}->{record}	829	croak "putUser: argument 1 must be of type ", $self->{user}->{record}
637	unless ref $User eq $self->{user}->{record};	830	unless ref $User eq $self->{user}->{record};
		831
		832	checkKeyfields($User);
		833
638	croak "putUser: user not found (perhaps you meant to use addUser?)"	834	croak "putUser: user not found (perhaps you meant to use addUser?)"
639	unless $self->{user}->exists($User->user_id);	835	unless $self->{user}->exists($User->user_id);
640		836
641	return $self->{user}->put($User);	837	return $self->{user}->put($User);
642	}	838	}
…		…
649	that user are also deleted. This includes the password, permission, and key	845	that user are also deleted. This includes the password, permission, and key
650	records, and all user set records for that user.	846	records, and all user set records for that user.
651		847
652	=cut	848	=cut
653		849
654	sub deleteUser($$) {	850	sub deleteUser {
655	my ($self, $userID) = @_;	851	my ($self, $userID) = @_;
656		852
657	croak "deleteUser: requires 1 argument"	853	croak "deleteUser: requires 1 argument"
658	unless @_ == 2;	854	unless @_ == 2;
659	croak "deleteUser: argument 1 must contain a user_id"	855	croak "deleteUser: argument 1 must contain a user_id"
660	unless defined $userID;	856	unless defined $userID;
661		857
662	#$self->deleteUserSet($userID, $_)
663	# foreach $self->listUserSets($userID);
664	$self->deleteUserSet($userID, undef);	858	$self->deleteUserSet($userID, undef);
665	$self->deletePassword($userID);	859	$self->deletePassword($userID);
666	$self->deletePermissionLevel($userID);	860	$self->deletePermissionLevel($userID);
667	$self->deleteKey($userID);	861	$self->deleteKey($userID);
668	return $self->{user}->delete($userID);	862	return $self->{user}->delete($userID);
669	}	863	}
670		864
		865	=back
		866
		867	=cut
		868
671	################################################################################	869	################################################################################
672	# set functions	870	# set functions
673	################################################################################	871	################################################################################
674		872
		873	=head2 Global Set Methods
		874
		875	FIXME: write this
		876
		877	=over
		878
		879	=cut
		880
		881	=item newGlobalSet()
		882
		883	=cut
		884
		885	sub newGlobalSet {
		886	my ($self, @prototype) = @_;
		887	return $self->{set}->{record}->new(@prototype);
		888	}
		889
		890	=item listGlobalSets()
		891
		892	=cut
		893
675	sub listGlobalSets($) {	894	sub listGlobalSets {
676	my ($self) = @_;	895	my ($self) = @_;
677		896
678	croak "listGlobalSets: requires 0 arguments"	897	croak "listGlobalSets: requires 0 arguments"
679	unless @_ == 1;	898	unless @_ == 1;
680		899
681	return map { $_->[0] }	900	return map { $_->[0] }
682	$self->{set}->list(undef);	901	$self->{set}->list(undef);
683	}	902	}
684		903
		904	=item addGlobalSet($GlobalSet)
		905
		906	=cut
		907
685	sub addGlobalSet($$) {	908	sub addGlobalSet {
686	my ($self, $GlobalSet) = @_;	909	my ($self, $GlobalSet) = @_;
687		910
688	croak "addGlobalSet: requires 1 argument"	911	croak "addGlobalSet: requires 1 argument"
689	unless @_ == 2;	912	unless @_ == 2;
690	croak "addGlobalSet: argument 1 must be of type ", $self->{set}->{record}	913	croak "addGlobalSet: argument 1 must be of type ", $self->{set}->{record}
691	unless ref $GlobalSet eq $self->{set}->{record};	914	unless ref $GlobalSet eq $self->{set}->{record};
		915
		916	checkKeyfields($GlobalSet);
		917
692	croak "addGlobalSet: global set exists (perhaps you meant to use putGlobalSet?)"	918	croak "addGlobalSet: global set exists (perhaps you meant to use putGlobalSet?)"
693	if $self->{set}->exists($GlobalSet->set_id);	919	if $self->{set}->exists($GlobalSet->set_id);
694		920
695	return $self->{set}->add($GlobalSet);	921	return $self->{set}->add($GlobalSet);
696	}	922	}
697		923
		924	=item addGlobalSet($setID)
		925
		926	=cut
		927
698	sub getGlobalSet($$) {	928	sub getGlobalSet {
699	my ($self, $setID) = @_;	929	my ($self, $setID) = @_;
700		930
701	croak "getGlobalSet: requires 1 argument"	931	croak "getGlobalSet: requires 1 argument"
702	unless @_ == 2;	932	unless @_ == 2;
703	croak "getGlobalSet: argument 1 must contain a set_id"	933	croak "getGlobalSet: argument 1 must contain a set_id"
704	unless defined $setID;	934	unless defined $setID;
705		935
706	return $self->{set}->get($setID);	936	return $self->{set}->get($setID);
707	}	937	}
708		938
		939	=item getGlobalSets(@setIDs)
		940
		941	Return a list of global set records associated with the record IDs given. If
		942	there is no record associated with a given record ID, that element of the list
		943	will be undefined.
		944
		945	=cut
		946
		947	sub getGlobalSets {
		948	my ($self, @setIDs) = @_;
		949
		950	#croak "getGlobalSets: requires 1 or more argument"
		951	# unless @_ >= 2;
		952	foreach my $i (0 .. $#setIDs) {
		953	croak "getGlobalSets: element $i of argument list must contain a set_id"
		954	unless defined $setIDs[$i];
		955	}
		956
		957	return $self->{set}->gets(map { [$_] } @setIDs);
		958	}
		959
		960	=item addGlobalSet($GlobalSet)
		961
		962	=cut
		963
709	sub putGlobalSet($$) {	964	sub putGlobalSet {
710	my ($self, $GlobalSet) = @_;	965	my ($self, $GlobalSet) = @_;
711		966
712	croak "putGlobalSet: requires 1 argument"	967	croak "putGlobalSet: requires 1 argument"
713	unless @_ == 2;	968	unless @_ == 2;
714	croak "putGlobalSet: argument 1 must be of type ", $self->{set}->{record}	969	croak "putGlobalSet: argument 1 must be of type ", $self->{set}->{record}
715	unless ref $GlobalSet eq $self->{set}->{record};	970	unless ref $GlobalSet eq $self->{set}->{record};
		971
		972	checkKeyfields($GlobalSet);
		973
716	croak "putGlobalSet: global set not found (perhaps you meant to use addGlobalSet?)"	974	croak "putGlobalSet: global set not found (perhaps you meant to use addGlobalSet?)"
717	unless $self->{set}->exists($GlobalSet->set_id);	975	unless $self->{set}->exists($GlobalSet->set_id);
718		976
719	return $self->{set}->put($GlobalSet);	977	return $self->{set}->put($GlobalSet);
720	}	978	}
721		979
		980	=item addGlobalSet($setID)
		981
		982	=cut
		983
722	sub deleteGlobalSet($$) {	984	sub deleteGlobalSet {
723	my ($self, $setID) = @_;	985	my ($self, $setID) = @_;
724		986
725	croak "deleteGlobalSet: requires 1 argument"	987	croak "deleteGlobalSet: requires 1 argument"
726	unless @_ == 2;	988	unless @_ == 2;
727	croak "deleteGlobalSet: argument 1 must contain a set_id"	989	croak "deleteGlobalSet: argument 1 must contain a set_id"
728	unless defined $setID or caller eq __PACKAGE__;	990	unless defined $setID or caller eq __PACKAGE__;
729		991
730	#$self->deleteUserSet($_, $setID)
731	# foreach $self->listSetUsers($setID);
732	#$self->deleteGlobalProblem($setID, $_)
733	# foreach $self->listGlobalProblems($setID);
734	$self->deleteUserSet(undef, $setID);	992	$self->deleteUserSet(undef, $setID);
735	$self->deleteGlobalProblem($setID, undef);	993	$self->deleteGlobalProblem($setID, undef);
736	return $self->{set}->delete($setID);	994	return $self->{set}->delete($setID);
737	}	995	}
738		996
		997	=back
		998
		999	=cut
		1000
739	################################################################################	1001	################################################################################
740	# set_user functions	1002	# set_user functions
741	################################################################################	1003	################################################################################
742		1004
743	sub listSetUsers($$) {	1005	=head2 User-Specific Set Methods
		1006
		1007	FIXME: write this
		1008
		1009	=over
		1010
		1011	=cut
		1012
		1013	sub newUserSet {
		1014	my ($self, @prototype) = @_;
		1015	return $self->{set_user}->{record}->new(@prototype);
		1016	}
		1017
		1018	sub countSetUsers {
744	my ($self, $setID) = @_;	1019	my ($self, $setID) = @_;
745		1020
746	croak "listSetUsers: requires 1 argument"	1021	croak "listSetUsers: requires 1 argument"
747	unless @_ == 2;	1022	unless @_ == 2;
748	croak "listSetUsers: argument 1 must contain a set_id"	1023	croak "listSetUsers: argument 1 must contain a set_id"
749	unless defined $setID;	1024	unless defined $setID;
750		1025
		1026	# inefficient way
		1027	#return scalar $self->{set_user}->list(undef, $setID);
		1028
		1029	# efficient way
		1030	return $self->{set_user}->count(undef, $setID);
		1031	}
		1032
		1033	sub listSetUsers {
		1034	my ($self, $setID) = @_;
		1035
		1036	carp "listSetUsers called in SCALAR context: use countSetUsers instead!\n"
		1037	unless wantarray;
		1038
		1039	croak "listSetUsers: requires 1 argument"
		1040	unless @_ == 2;
		1041	croak "listSetUsers: argument 1 must contain a set_id"
		1042	unless defined $setID;
		1043
751	return map { $_->[0] } # extract user_id	1044	return map { $_->[0] } # extract user_id
752	$self->{set_user}->list(undef, $setID);	1045	$self->{set_user}->list(undef, $setID);
753	}	1046	}
754		1047
755	sub listUserSets($$) {	1048	sub listUserSets {
756	my ($self, $userID) = @_;	1049	my ($self, $userID) = @_;
757		1050
758	croak "listUserSets: requires 1 argument"	1051	croak "listUserSets: requires 1 argument"
759	unless @_ == 2;	1052	unless @_ == 2;
760	croak "listUserSets: argument 1 must contain a user_id"	1053	croak "listUserSets: argument 1 must contain a user_id"
…		…
762		1055
763	return map { $_->[1] } # extract set_id	1056	return map { $_->[1] } # extract set_id
764	$self->{set_user}->list($userID, undef);	1057	$self->{set_user}->list($userID, undef);
765	}	1058	}
766		1059
767	sub addUserSet($$) {	1060	sub addUserSet {
768	my ($self, $UserSet) = @_;	1061	my ($self, $UserSet) = @_;
769		1062
770	croak "addUserSet: requires 1 argument"	1063	croak "addUserSet: requires 1 argument"
771	unless @_ == 2;	1064	unless @_ == 2;
772	croak "addUserSet: argument 1 must be of type ", $self->{set_user}->{record}	1065	croak "addUserSet: argument 1 must be of type ", $self->{set_user}->{record}
773	unless ref $UserSet eq $self->{set_user}->{record};	1066	unless ref $UserSet eq $self->{set_user}->{record};
		1067
		1068	checkKeyfields($UserSet);
		1069
774	croak "addUserSet: user set exists (perhaps you meant to use putUserSet?)"	1070	croak "addUserSet: user set exists (perhaps you meant to use putUserSet?)"
775	if $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);	1071	if $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
776	croak "addUserSet: user ", $UserSet->user_id, " not found"	1072	croak "addUserSet: user ", $UserSet->user_id, " not found"
777	unless $self->{user}->exists($UserSet->user_id);	1073	unless $self->{user}->exists($UserSet->user_id);
778	croak "addUserSet: set ", $UserSet->set_id, " not found"	1074	croak "addUserSet: set ", $UserSet->set_id, " not found"
779	unless $self->{set}->exists($UserSet->set_id);	1075	unless $self->{set}->exists($UserSet->set_id);
780		1076
781	return $self->{set_user}->add($UserSet);	1077	return $self->{set_user}->add($UserSet);
782	}	1078	}
783		1079
784	sub getUserSet($$$) {	1080	sub getUserSet {
785	my ($self, $userID, $setID) = @_;	1081	my ($self, $userID, $setID) = @_;
786		1082
787	croak "getUserSet: requires 2 arguments"	1083	croak "getUserSet: requires 2 arguments"
788	unless @_ == 3;	1084	unless @_ == 3;
789	croak "getUserSet: argument 1 must contain a user_id"	1085	croak "getUserSet: argument 1 must contain a user_id"
790	unless defined $userID;	1086	unless defined $userID;
791	croak "getUserSet: argument 2 must contain a set_id"	1087	croak "getUserSet: argument 2 must contain a set_id"
792	unless defined $setID;	1088	unless defined $setID;
793		1089
794	return $self->{set_user}->get($userID, $setID);	1090	#return $self->{set_user}->get($userID, $setID);
		1091	return ( $self->getUserSets([$userID, $setID]) )[0];
795	}	1092	}
796		1093
		1094	=item getUserSets(@userSetIDs)
		1095
		1096	Return a list of user set records associated with the record IDs given. If there
		1097	is no record associated with a given record ID, that element of the list will be
		1098	undefined. @userProblemIDs consists of references to arrays in which the first
		1099	element is the user_id and the second element is the set_id.
		1100
		1101	=cut
		1102
		1103	sub getUserSets {
		1104	my ($self, @userSetIDs) = @_;
		1105
		1106	#croak "getUserSets: requires 1 or more argument"
		1107	# unless @_ >= 2;
		1108	foreach my $i (0 .. $#userSetIDs) {
		1109	croak "getUserSets: element $i of argument list must contain a <user_id, set_id> pair"
		1110	unless defined $userSetIDs[$i]
		1111	and ref $userSetIDs[$i] eq "ARRAY"
		1112	and @{$userSetIDs[$i]} == 2
		1113	and defined $userSetIDs[$i]->[0]
		1114	and defined $userSetIDs[$i]->[1];
		1115	}
		1116
		1117	return $self->{set_user}->gets(@userSetIDs);
		1118	}
		1119
797	sub putUserSet($$) {	1120	sub putUserSet {
798	my ($self, $UserSet) = @_;	1121	my ($self, $UserSet) = @_;
799		1122
800	croak "putUserSet: requires 1 argument"	1123	croak "putUserSet: requires 1 argument"
801	unless @_ == 2;	1124	unless @_ == 2;
802	croak "putUserSet: argument 1 must be of type ", $self->{set_user}->{record}	1125	croak "putUserSet: argument 1 must be of type ", $self->{set_user}->{record}
803	unless ref $UserSet eq $self->{set_user}->{record};	1126	unless ref $UserSet eq $self->{set_user}->{record};
		1127
		1128	checkKeyfields($UserSet);
		1129
804	croak "putUserSet: user set not found (perhaps you meant to use addUserSet?)"	1130	croak "putUserSet: user set not found (perhaps you meant to use addUserSet?)"
805	unless $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);	1131	unless $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
806	croak "putUserSet: user ", $UserSet->user_id, " not found"	1132	croak "putUserSet: user ", $UserSet->user_id, " not found"
807	unless $self->{user}->exists($UserSet->user_id);	1133	unless $self->{user}->exists($UserSet->user_id);
808	croak "putUserSet: set ", $UserSet->set_id, " not found"	1134	croak "putUserSet: set ", $UserSet->set_id, " not found"
809	unless $self->{set}->exists($UserSet->set_id);	1135	unless $self->{set}->exists($UserSet->set_id);
810		1136
811	return $self->{set_user}->put($UserSet);	1137	return $self->{set_user}->put($UserSet);
812	}	1138	}
813		1139
814	sub deleteUserSet($$$) {	1140	sub deleteUserSet {
815	my ($self, $userID, $setID) = @_;	1141	my ($self, $userID, $setID) = @_;
816		1142
817	croak "getUserSet: requires 2 arguments"	1143	croak "getUserSet: requires 2 arguments"
818	unless @_ == 3;	1144	unless @_ == 3;
819	croak "getUserSet: argument 1 must contain a user_id"	1145	croak "getUserSet: argument 1 must contain a user_id"
820	unless defined $userID or caller eq __PACKAGE__;	1146	unless defined $userID or caller eq __PACKAGE__;
821	croak "getUserSet: argument 2 must contain a set_id"	1147	croak "getUserSet: argument 2 must contain a set_id"
822	unless defined $userID or caller eq __PACKAGE__;	1148	unless defined $userID or caller eq __PACKAGE__;
823		1149
824	#$self->deleteUserProblem($userID, $setID, $_)
825	# foreach $self->listUserProblems($userID, $setID);
826	$self->deleteUserProblem($userID, $setID, undef);	1150	$self->deleteUserProblem($userID, $setID, undef);
827	return $self->{set_user}->delete($userID, $setID);	1151	return $self->{set_user}->delete($userID, $setID);
828	}	1152	}
829		1153
		1154	=back
		1155
		1156	=cut
		1157
830	################################################################################	1158	################################################################################
831	# problem functions	1159	# problem functions
832	################################################################################	1160	################################################################################
833		1161
		1162	=head2 Global Problem Methods
		1163
		1164	FIXME: write this
		1165
		1166	=over
		1167
		1168	=cut
		1169
		1170	sub newGlobalProblem {
		1171	my ($self, @prototype) = @_;
		1172	return $self->{problem}->{record}->new(@prototype);
		1173	}
		1174
834	sub listGlobalProblems($$) {	1175	sub listGlobalProblems {
835	my ($self, $setID) = @_;	1176	my ($self, $setID) = @_;
836		1177
837	croak "listGlobalProblems: requires 1 arguments"	1178	croak "listGlobalProblems: requires 1 arguments"
838	unless @_ == 2;	1179	unless @_ == 2;
839	croak "listGlobalProblems: argument 1 must contain a set_id"	1180	croak "listGlobalProblems: argument 1 must contain a set_id"
…		…
841		1182
842	return map { $_->[1] }	1183	return map { $_->[1] }
843	$self->{problem}->list($setID, undef);	1184	$self->{problem}->list($setID, undef);
844	}	1185	}
845		1186
846	sub addGlobalProblem($$) {	1187	sub addGlobalProblem {
847	my ($self, $GlobalProblem) = @_;	1188	my ($self, $GlobalProblem) = @_;
848		1189
849	croak "addGlobalProblem: requires 1 argument"	1190	croak "addGlobalProblem: requires 1 argument"
850	unless @_ == 2;	1191	unless @_ == 2;
851	croak "addGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}	1192	croak "addGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
852	unless ref $GlobalProblem eq $self->{problem}->{record};	1193	unless ref $GlobalProblem eq $self->{problem}->{record};
		1194
		1195	checkKeyfields($GlobalProblem);
		1196
853	croak "addGlobalProblem: global problem exists (perhaps you meant to use putGlobalProblem?)"	1197	croak "addGlobalProblem: global problem exists (perhaps you meant to use putGlobalProblem?)"
854	if $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);	1198	if $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
855	croak "addGlobalProblem: set ", $GlobalProblem->set_id, " not found"	1199	croak "addGlobalProblem: set ", $GlobalProblem->set_id, " not found"
856	unless $self->{set}->exists($GlobalProblem->set_id);	1200	unless $self->{set}->exists($GlobalProblem->set_id);
857		1201
858	return $self->{problem}->add($GlobalProblem);	1202	return $self->{problem}->add($GlobalProblem);
859	}	1203	}
860		1204
861	sub getGlobalProblem($$$) {	1205	sub getGlobalProblem {
862	my ($self, $setID, $problemID) = @_;	1206	my ($self, $setID, $problemID) = @_;
863		1207
864	croak "getGlobalProblem: requires 2 arguments"	1208	croak "getGlobalProblem: requires 2 arguments"
865	unless @_ == 3;	1209	unless @_ == 3;
866	croak "getGlobalProblem: argument 1 must contain a set_id"	1210	croak "getGlobalProblem: argument 1 must contain a set_id"
…		…
869	unless defined $problemID;	1213	unless defined $problemID;
870		1214
871	return $self->{problem}->get($setID, $problemID);	1215	return $self->{problem}->get($setID, $problemID);
872	}	1216	}
873		1217
		1218	=item getGlobalProblems(@problemIDs)
		1219
		1220	Return a list of global set records associated with the record IDs given. If
		1221	there is no record associated with a given record ID, that element of the list
		1222	will be undefined. @problemIDs consists of references to arrays in which the
		1223	first element is the set_id, and the second element is the problem_id.
		1224
		1225	=cut
		1226
		1227	sub getGlobalProblems {
		1228	my ($self, @problemIDs) = @_;
		1229
		1230	#croak "getGlobalProblems: requires 1 or more argument"
		1231	# unless @_ >= 2;
		1232	foreach my $i (0 .. $#problemIDs) {
		1233	croak "getUserSets: element $i of argument list must contain a <set_id, problem_id> pair"
		1234	unless defined $problemIDs[$i]
		1235	and ref $problemIDs[$i] eq "ARRAY"
		1236	and @{$problemIDs[$i]} == 2
		1237	and defined $problemIDs[$i]->[0]
		1238	and defined $problemIDs[$i]->[1];
		1239	}
		1240
		1241	return $self->{problem}->gets(@problemIDs);
		1242	}
		1243
		1244	=item getAllGlobalProblems($setID)
		1245
		1246	Returns a list of Problem objects representing all the problems in the given
		1247	global set. When using the WW1Hash/GlobalTableEmulator schemas, this is far
		1248	more efficient than using listGlobalProblems and getGlobalProblems.
		1249
		1250	=cut
		1251
		1252	sub getAllGlobalProblems {
		1253	my ($self, $setID) = @_;
		1254
		1255	croak "getAllGlobalProblems: requires 1 arguments"
		1256	unless @_ == 2;
		1257	croak "getAllGlobalProblems: argument 1 must contain a set_id"
		1258	unless defined $setID;
		1259
		1260	if ($self->{problem}->can("getAll")) {
		1261	return $self->{problem}->getAll($setID);
		1262	} else {
		1263	my @problemIDPairs = $self->{problem}->list($setID, undef);
		1264	return $self->{problem}->gets(@problemIDPairs);
		1265	}
		1266	}
		1267
874	sub putGlobalProblem($$) {	1268	sub putGlobalProblem {
875	my ($self, $GlobalProblem) = @_;	1269	my ($self, $GlobalProblem) = @_;
876		1270
877	croak "putGlobalProblem: requires 1 argument"	1271	croak "putGlobalProblem: requires 1 argument"
878	unless @_ == 2;	1272	unless @_ == 2;
879	croak "putGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}	1273	croak "putGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
880	unless ref $GlobalProblem eq $self->{problem}->{record};	1274	unless ref $GlobalProblem eq $self->{problem}->{record};
		1275
		1276	checkKeyfields($GlobalProblem);
		1277
881	croak "putGlobalProblem: global problem not found (perhaps you meant to use addGlobalProblem?)"	1278	croak "putGlobalProblem: global problem not found (perhaps you meant to use addGlobalProblem?)"
882	unless $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);	1279	unless $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
883	croak "putGlobalProblem: set ", $GlobalProblem->set_id, " not found"	1280	croak "putGlobalProblem: set ", $GlobalProblem->set_id, " not found"
884	unless $self->{set}->exists($GlobalProblem->set_id);	1281	unless $self->{set}->exists($GlobalProblem->set_id);
885		1282
886	return $self->{problem}->put($GlobalProblem);	1283	return $self->{problem}->put($GlobalProblem);
887	}	1284	}
888		1285
889	sub deleteGlobalProblem($$$) {	1286	sub deleteGlobalProblem {
890	my ($self, $setID, $problemID) = @_;	1287	my ($self, $setID, $problemID) = @_;
891		1288
892	croak "deleteGlobalProblem: requires 2 arguments"	1289	croak "deleteGlobalProblem: requires 2 arguments"
893	unless @_ == 3;	1290	unless @_ == 3;
894	croak "deleteGlobalProblem: argument 1 must contain a set_id"	1291	croak "deleteGlobalProblem: argument 1 must contain a set_id"
895	unless defined $setID or caller eq __PACKAGE__;	1292	unless defined $setID or caller eq __PACKAGE__;
896	croak "deleteGlobalProblem: argument 2 must contain a problem_id"	1293	croak "deleteGlobalProblem: argument 2 must contain a problem_id"
897	unless defined $problemID or caller eq __PACKAGE__;	1294	unless defined $problemID or caller eq __PACKAGE__;
898		1295
899	#$self->deleteUserProblem($_, $setID, $problemID)
900	# foreach $self->listProblemUsers($setID, $problemID);
901	$self->deleteUserProblem(undef, $setID, $problemID);	1296	$self->deleteUserProblem(undef, $setID, $problemID);
902	return $self->{problem}->delete($setID, $problemID);	1297	return $self->{problem}->delete($setID, $problemID);
903	}	1298	}
904		1299
		1300	=back
		1301
		1302	=cut
		1303
905	################################################################################	1304	################################################################################
906	# problem_user functions	1305	# problem_user functions
907	################################################################################	1306	################################################################################
908		1307
		1308	=head2 User-Specific Problem Methods
		1309
		1310	FIXME: write this
		1311
		1312	=over
		1313
		1314	=cut
		1315
		1316	sub newUserProblem {
		1317	my ($self, @prototype) = @_;
		1318	return $self->{problem_user}->{record}->new(@prototype);
		1319	}
		1320
909	sub listProblemUsers($$$) {	1321	sub countProblemUsers {
910	my ($self, $setID, $problemID) = @_;	1322	my ($self, $setID, $problemID) = @_;
		1323
		1324	croak "countProblemUsers: requires 2 arguments"
		1325	unless @_ == 3;
		1326	croak "countProblemUsers: argument 1 must contain a set_id"
		1327	unless defined $setID;
		1328	croak "countProblemUsers: argument 2 must contain a problem_id"
		1329	unless defined $problemID;
		1330
		1331	# the slow way
		1332	#return scalar $self->{problem_user}->list(undef, $setID, $problemID);
		1333
		1334	# the fast way
		1335	return $self->{problem_user}->count(undef, $setID, $problemID);
		1336	}
		1337
		1338	sub listProblemUsers {
		1339	my ($self, $setID, $problemID) = @_;
		1340
		1341	carp "listProblemUsers called in SCALAR context: use countProblemUsers instead!\n"
		1342	unless wantarray;
911		1343
912	croak "listProblemUsers: requires 2 arguments"	1344	croak "listProblemUsers: requires 2 arguments"
913	unless @_ == 3;	1345	unless @_ == 3;
914	croak "listProblemUsers: argument 1 must contain a set_id"	1346	croak "listProblemUsers: argument 1 must contain a set_id"
915	unless defined $setID;	1347	unless defined $setID;
…		…
918		1350
919	return map { $_->[0] } # extract user_id	1351	return map { $_->[0] } # extract user_id
920	$self->{problem_user}->list(undef, $setID, $problemID);	1352	$self->{problem_user}->list(undef, $setID, $problemID);
921	}	1353	}
922		1354
923	sub listUserProblems($$$) {	1355	sub listUserProblems {
924	my ($self, $userID, $setID) = @_;	1356	my ($self, $userID, $setID) = @_;
925		1357
926	croak "listUserProblems: requires 2 arguments"	1358	croak "listUserProblems: requires 2 arguments"
927	unless @_ == 3;	1359	unless @_ == 3;
928	croak "listUserProblems: argument 1 must contain a user_id"	1360	croak "listUserProblems: argument 1 must contain a user_id"
…		…
932		1364
933	return map { $_->[2] } # extract problem_id	1365	return map { $_->[2] } # extract problem_id
934	$self->{problem_user}->list($userID, $setID, undef);	1366	$self->{problem_user}->list($userID, $setID, undef);
935	}	1367	}
936		1368
937	sub addUserProblem($$) {	1369	sub addUserProblem {
938	my ($self, $UserProblem) = @_;	1370	my ($self, $UserProblem) = @_;
939		1371
940	croak "addUserProblem: requires 1 argument"	1372	croak "addUserProblem: requires 1 argument"
941	unless @_ == 2;	1373	unless @_ == 2;
942	croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}	1374	croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
943	unless ref $UserProblem eq $self->{problem_user}->{record};	1375	unless ref $UserProblem eq $self->{problem_user}->{record};
		1376
		1377	checkKeyfields($UserProblem);
		1378
944	croak "addUserProblem: user problem exists (perhaps you meant to use putUserProblem?)"	1379	croak "addUserProblem: user problem exists (perhaps you meant to use putUserProblem?)"
945	if $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);	1380	if $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
946	croak "addUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"	1381	croak "addUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
947	unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);	1382	unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
948	croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"	1383	croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
949	unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);	1384	unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
950		1385
951	return $self->{problem_user}->add($UserProblem);	1386	return $self->{problem_user}->add($UserProblem);
952	}	1387	}
953		1388
954	sub getUserProblem($$$$) {	1389	sub getUserProblem {
955	my ($self, $userID, $setID, $problemID) = @_;	1390	my ($self, $userID, $setID, $problemID) = @_;
956		1391
957	croak "getUserProblem: requires 3 arguments"	1392	croak "getUserProblem: requires 3 arguments"
958	unless @_ == 4;	1393	unless @_ == 4;
959	croak "getUserProblem: argument 1 must contain a user_id"	1394	croak "getUserProblem: argument 1 must contain a user_id"
…		…
961	croak "getUserProblem: argument 2 must contain a set_id"	1396	croak "getUserProblem: argument 2 must contain a set_id"
962	unless defined $setID;	1397	unless defined $setID;
963	croak "getUserProblem: argument 3 must contain a problem_id"	1398	croak "getUserProblem: argument 3 must contain a problem_id"
964	unless defined $problemID;	1399	unless defined $problemID;
965		1400
		1401	return ( $self->getUserProblems([$userID, $setID, $problemID]) )[0];
		1402	}
		1403
		1404	=item getUserProblems(@userProblemIDs)
		1405
		1406	Return a list of user set records associated with the user IDs given. If there
		1407	is no record associated with a given user ID, that element of the list will be
		1408	undefined. @userProblemIDs consists of references to arrays in which the first
		1409	element is the user_id, the second element is the set_id, and the third element
		1410	is the problem_id.
		1411
		1412	=cut
		1413
		1414	sub getUserProblems {
		1415	my ($self, @userProblemIDs) = @_;
		1416
		1417	#croak "getUserProblems: requires 1 or more argument"
		1418	# unless @_ >= 2;
		1419	foreach my $i (0 .. $#userProblemIDs) {
		1420	croak "getUserProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple"
		1421	unless defined $userProblemIDs[$i]
		1422	and ref $userProblemIDs[$i] eq "ARRAY"
		1423	and @{$userProblemIDs[$i]} == 3
		1424	and defined $userProblemIDs[$i]->[0]
		1425	and defined $userProblemIDs[$i]->[1]
		1426	and defined $userProblemIDs[$i]->[2];
		1427	}
		1428
		1429	return $self->{problem_user}->gets(@userProblemIDs);
		1430	}
		1431
		1432	=item getAllUserProblems($userID, $setID)
		1433
		1434	Returns a list of UserProblem objects representing all the problems in the
		1435	given set. When using the WW1Hash/GlobalTableEmulator schemas, this is far
		1436	more efficient than using listUserProblems and getUserProblems.
		1437
		1438	=cut
		1439
		1440	sub getAllUserProblems {
		1441	my ($self, $userID, $setID) = @_;
		1442
		1443	croak "getAllUserProblems: requires 2 arguments"
		1444	unless @_ == 3;
		1445	croak "getAllUserProblems: argument 1 must contain a user_id"
		1446	unless defined $userID;
		1447	croak "getAllUserProblems: argument 2 must contain a set_id"
		1448	unless defined $setID;
		1449
		1450	if ($self->{problem_user}->can("getAll")) {
966	return $self->{problem_user}->get($userID, $setID, $problemID);	1451	return $self->{problem_user}->getAll($userID, $setID);
		1452	} else {
		1453	my @problemIDTriples = $self->{problem_user}->list($userID, $setID, undef);
		1454	return $self->{problem_user}->gets(@problemIDTriples);
		1455	}
967	}	1456	}
968		1457
969	sub putUserProblem($$) {	1458	sub putUserProblem {
970	my ($self, $UserProblem) = @_;	1459	my ($self, $UserProblem) = @_;
971		1460
972	croak "putUserProblem: requires 1 argument"	1461	croak "putUserProblem: requires 1 argument"
973	unless @_ == 2;	1462	unless @_ == 2;
974	croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}	1463	croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
975	unless ref $UserProblem eq $self->{problem_user}->{record};	1464	unless ref $UserProblem eq $self->{problem_user}->{record};
		1465
		1466	checkKeyfields($UserProblem);
		1467
976	croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"	1468	croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
977	unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);	1469	unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
978	croak "putUserProblem: user problem not found (perhaps you meant to use addUserProblem?)"	1470	croak "putUserProblem: user problem not found (perhaps you meant to use addUserProblem?)"
979	unless $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);	1471	unless $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
980	croak "putUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"	1472	croak "putUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
981	unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);	1473	unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
982		1474
983	return $self->{problem_user}->put($UserProblem);	1475	return $self->{problem_user}->put($UserProblem);
984	}	1476	}
985		1477
986	sub deleteUserProblem($$$$) {	1478	sub deleteUserProblem {
987	my ($self, $userID, $setID, $problemID) = @_;	1479	my ($self, $userID, $setID, $problemID) = @_;
988		1480
989	croak "getUserProblem: requires 3 arguments"	1481	croak "getUserProblem: requires 3 arguments"
990	unless @_ == 4;	1482	unless @_ == 4;
991	croak "getUserProblem: argument 1 must contain a user_id"	1483	croak "getUserProblem: argument 1 must contain a user_id"
…		…
996	unless defined $problemID or caller eq __PACKAGE__;	1488	unless defined $problemID or caller eq __PACKAGE__;
997		1489
998	return $self->{problem_user}->delete($userID, $setID, $problemID);	1490	return $self->{problem_user}->delete($userID, $setID, $problemID);
999	}	1491	}
1000		1492
		1493	=back
		1494
		1495	=cut
		1496
1001	################################################################################	1497	################################################################################
1002	# set+set_user functions	1498	# set+set_user functions
1003	################################################################################	1499	################################################################################
		1500
		1501	=head2 Set Merging Methods
		1502
		1503	These functions combine a global set and a user set to create a merged set,
		1504	which is returned. Any field that is not defined in the user set is taken from
		1505	the global set. Merged sets have the same type as user sets.
		1506
		1507	=over
		1508
		1509	=cut
1004		1510
1005	sub getGlobalUserSet {	1511	sub getGlobalUserSet {
1006	carp "getGlobalUserSet: this method is deprecated -- use getMergedSet instead";	1512	carp "getGlobalUserSet: this method is deprecated -- use getMergedSet instead";
1007	return shift->getMergedSet(@_);	1513	return shift->getMergedSet(@_);
1008	}	1514	}
1009		1515
		1516	=item getMergedSet($userID, $setID)
		1517
		1518	Returns a merged set record associated with the record IDs given. If there is no
		1519	record associated with a given record ID, the undefined value is returned.
		1520
		1521	=cut
		1522
1010	sub getMergedSet {	1523	sub getMergedSet {
1011	my ($self, $userID, $setID) = @_;	1524	my ($self, $userID, $setID) = @_;
1012		1525
1013	croak "getGlobalUserSet: requires 2 arguments"	1526	croak "getMergedSet: requires 2 arguments"
1014	unless @_ == 3;	1527	unless @_ == 3;
1015	croak "getGlobalUserSet: argument 1 must contain a user_id"	1528	croak "getMergedSet: argument 1 must contain a user_id"
1016	unless defined $userID;	1529	unless defined $userID;
1017	croak "getGlobalUserSet: argument 2 must contain a set_id"	1530	croak "getMergedSet: argument 2 must contain a set_id"
1018	unless defined $setID;	1531	unless defined $setID;
1019		1532
		1533	return ( $self->getMergedSets([$userID, $setID]) )[0];
		1534	}
		1535
		1536	=item getMegedSets(@userSetIDs)
		1537
		1538	Return a list of merged set records associated with the record IDs given. If
		1539	there is no record associated with a given record ID, that element of the list
		1540	will be undefined. @userSetIDs consists of references to arrays in which the
		1541	first element is the user_id and the second element is the set_id.
		1542
		1543	=cut
		1544
		1545	sub getMergedSets {
		1546	my ($self, @userSetIDs) = @_;
		1547
		1548	#croak "getMergedSets: requires 1 or more argument"
		1549	# unless @_ >= 2;
		1550	foreach my $i (0 .. $#userSetIDs) {
		1551	croak "getMergedSets: element $i of argument list must contain a <user_id, set_id> pair"
		1552	unless defined $userSetIDs[$i]
		1553	and ref $userSetIDs[$i] eq "ARRAY"
		1554	and @{$userSetIDs[$i]} == 2
		1555	and defined $userSetIDs[$i]->[0]
		1556	and defined $userSetIDs[$i]->[1];
		1557	}
		1558
		1559	# a horrible, terrible hack ;)
		1560	if (ref $self->{set_user} eq "WeBWorK::DB::Schema::WW1Hash"
		1561	and ref $self->{set} eq "WeBWorK::DB::Schema::GlobalTableEmulator") {
		1562	#warn __PACKAGE__.": using a terrible hack.\n";
		1563	$WeBWorK::timer->continue("DB: getsNoFilter start") if defined($WeBWorK::timer);
		1564	my @MergedSets = $self->{set_user}->getsNoFilter(@userSetIDs);
		1565	$WeBWorK::timer->continue("DB: getsNoFilter end") if defined($WeBWorK::timer);
		1566	return @MergedSets;
		1567	}
		1568
		1569	$WeBWorK::timer->continue("DB: getUserSets start") if defined($WeBWorK::timer);
1020	my $UserSet = $self->getUserSet($userID, $setID);	1570	my @UserSets = $self->getUserSets(@userSetIDs); # checked
1021	return unless $UserSet;	1571
		1572	$WeBWorK::timer->continue("DB: pull out set IDs start") if defined($WeBWorK::timer);
		1573	my @globalSetIDs = map { $_->[1] } @userSetIDs;
		1574	$WeBWorK::timer->continue("DB: getGlobalSets start") if defined($WeBWorK::timer);
1022	my $GlobalSet = $self->getGlobalSet($setID);	1575	my @GlobalSets = $self->getGlobalSets(@globalSetIDs); # checked
1023	if ($GlobalSet) {	1576
1024	foreach ($UserSet->FIELDS()) {	1577	$WeBWorK::timer->continue("DB: calc common fields start") if defined($WeBWorK::timer);
1025	next unless $GlobalSet->can($_);	1578	my %globalSetFields = map { $_ => 1 } $self->newGlobalSet->FIELDS;
1026	next if $UserSet->$_();	1579	my @commonFields = grep { exists $globalSetFields{$_} } $self->newUserSet->FIELDS;
		1580
		1581	$WeBWorK::timer->continue("DB: merge start") if defined($WeBWorK::timer);
		1582	for (my $i = 0; $i < @UserSets; $i++) {
		1583	my $UserSet = $UserSets[$i];
		1584	my $GlobalSet = $GlobalSets[$i];
		1585	next unless defined $UserSet and defined $GlobalSet;
		1586	foreach my $field (@commonFields) {
		1587	next if defined $UserSet->$field;
1027	$UserSet->$_($GlobalSet->$_());	1588	$UserSet->$field($GlobalSet->$field);
1028	}	1589	}
1029	}	1590	}
		1591	$WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
		1592
1030	return $UserSet;	1593	return @UserSets;
1031	}	1594	}
		1595
		1596	=back
		1597
		1598	=cut
1032		1599
1033	################################################################################	1600	################################################################################
1034	# problem+problem_user functions	1601	# problem+problem_user functions
1035	################################################################################	1602	################################################################################
		1603
		1604	=head2 Problem Merging Methods
		1605
		1606	These functions combine a global problem and a user problem to create a merged
		1607	problem, which is returned. Any field that is not defined in the user problem is
		1608	taken from the global problem. Merged problems have the same type as user
		1609	problems.
		1610
		1611	=over
		1612
		1613	=cut
1036		1614
1037	sub getGlobalUserProblem {	1615	sub getGlobalUserProblem {
1038	carp "getGlobalUserProblem: this method is deprecated -- use getMergedProblem instead";	1616	carp "getGlobalUserProblem: this method is deprecated -- use getMergedProblem instead";
1039	return shift->getMergedProblem(@_);	1617	return shift->getMergedProblem(@_);
1040	}	1618	}
		1619
		1620	=item getMergedProblem($userID, $setID, $problemID)
		1621
		1622	Returns a merged problem record associated with the record IDs given. If there
		1623	is no record associated with a given record ID, the undefined value is returned.
		1624
		1625	=cut
1041		1626
1042	sub getMergedProblem {	1627	sub getMergedProblem {
1043	my ($self, $userID, $setID, $problemID) = @_;	1628	my ($self, $userID, $setID, $problemID) = @_;
1044		1629
1045	croak "getGlobalUserSet: requires 3 arguments"	1630	croak "getGlobalUserSet: requires 3 arguments"
…		…
1049	croak "getGlobalUserSet: argument 2 must contain a set_id"	1634	croak "getGlobalUserSet: argument 2 must contain a set_id"
1050	unless defined $setID;	1635	unless defined $setID;
1051	croak "getGlobalUserSet: argument 3 must contain a problem_id"	1636	croak "getGlobalUserSet: argument 3 must contain a problem_id"
1052	unless defined $problemID;	1637	unless defined $problemID;
1053		1638
		1639	return ( $self->getMergedProblems([$userID, $setID, $problemID]) )[0];
		1640	}
		1641
		1642	=item getMergedProblems(@userProblemIDs)
		1643
		1644	Return a list of merged problem records associated with the record IDs given. If
		1645	there is no record associated with a given record ID, that element of the list
		1646	will be undefined. @userProblemIDs consists of references to arrays in which the
		1647	first element is the user_id, the second element is the set_id, and the third
		1648	element is the problem_id.
		1649
		1650	=cut
		1651
		1652	sub getMergedProblems {
		1653	my ($self, @userProblemIDs) = @_;
		1654
		1655	#croak "getMergedProblems: requires 1 or more argument"
		1656	# unless @_ >= 2;
		1657	foreach my $i (0 .. $#userProblemIDs) {
		1658	croak "getMergedProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple"
		1659	unless defined $userProblemIDs[$i]
		1660	and ref $userProblemIDs[$i] eq "ARRAY"
		1661	and @{$userProblemIDs[$i]} == 3
		1662	and defined $userProblemIDs[$i]->[0]
		1663	and defined $userProblemIDs[$i]->[1]
		1664	and defined $userProblemIDs[$i]->[2];
		1665	}
		1666
		1667	$WeBWorK::timer->continue("DB: getUserProblems start") if defined($WeBWorK::timer);
1054	my $UserProblem = $self->getUserProblem($userID, $setID, $problemID);	1668	my @UserProblems = $self->getUserProblems(@userProblemIDs); # checked
1055	return unless $UserProblem;	1669
		1670	$WeBWorK::timer->continue("DB: pull out set/problem IDs start") if defined($WeBWorK::timer);
		1671	my @globalProblemIDs = map { [ $_->[1], $_->[2] ] } @userProblemIDs;
		1672	$WeBWorK::timer->continue("DB: getGlobalProblems start") if defined($WeBWorK::timer);
1056	my $GlobalProblem = $self->getGlobalProblem($setID, $problemID);	1673	my @GlobalProblems = $self->getGlobalProblems(@globalProblemIDs); # checked
1057	if ($GlobalProblem) {	1674
1058	foreach ($UserProblem->FIELDS()) {	1675	$WeBWorK::timer->continue("DB: calc common fields start") if defined($WeBWorK::timer);
1059	next unless $GlobalProblem->can($_);	1676	my %globalProblemFields = map { $_ => 1 } $self->newGlobalProblem->FIELDS;
		1677	my @commonFields = grep { exists $globalProblemFields{$_} } $self->newUserProblem->FIELDS;
		1678
		1679	$WeBWorK::timer->continue("DB: merge start") if defined($WeBWorK::timer);
		1680	for (my $i = 0; $i < @UserProblems; $i++) {
		1681	my $UserProblem = $UserProblems[$i];
		1682	my $GlobalProblem = $GlobalProblems[$i];
		1683	next unless defined $UserProblem and defined $GlobalProblem;
		1684	foreach my $field (@commonFields) {
1060	next if $UserProblem->$_();	1685	next if defined $UserProblem->$field;
1061	$UserProblem->$_($GlobalProblem->$_());	1686	$UserProblem->$field($GlobalProblem->$field);
1062	}	1687	}
1063	}	1688	}
		1689	$WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
		1690
1064	return $UserProblem;	1691	return @UserProblems;
1065	}	1692	}
		1693
		1694	=back
		1695
		1696	=cut
1066		1697
1067	################################################################################	1698	################################################################################
1068	# debugging	1699	# debugging
1069	################################################################################	1700	################################################################################
1070		1701
1071	sub dumpDB($$) {	1702	#sub dumpDB($$) {
1072	my ($self, $table) = @_;	1703	# my ($self, $table) = @_;
1073	return $self->{$table}->dumpDB();	1704	# return $self->{$table}->dumpDB();
		1705	#}
		1706
		1707	################################################################################
		1708	# utilities
		1709	################################################################################
		1710
		1711	sub checkKeyfields($) {
		1712	my ($Record) = @_;
		1713	foreach my $keyfield ($Record->KEYFIELDS) {
		1714	my $value = $Record->$keyfield;
		1715	croak "checkKeyfields: $keyfield is empty"
		1716	unless defined $value and $value ne "";
		1717
		1718	if ($keyfield eq "problem_id") {
		1719	croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [0-9])"
		1720	unless $value =~ m/^\d*$/;
		1721	} else {
		1722	croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [A-Za-z0-9_])"
		1723	unless $value =~ m/^[\w-]*$/;
		1724	}
		1725	}
1074	}	1726	}
1075		1727
1076	=head1 AUTHOR	1728	=head1 AUTHOR
1077		1729
1078	Written by Sam Hathaway, sh002i (at) math.rochester.edu.	1730	Written by Sam Hathaway, sh002i (at) math.rochester.edu.

 Legend:



Removed from v.1185
 


changed lines


 
Added in v.1696
 Legend:



Removed from v.1185
 


changed lines


 
Added in v.1696
-Removed from v.1185
+Added in v.1696

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9