Diff of /branches/rel-2-3-dev/webwork-modperl/lib/WeBWorK/DB.pm

Revision 923		Revision 2348
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.51 2004/06/16 18:26:59 toenail 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 (WWDBv2).	21	WeBWorK::DB - interface with the WeBWorK databases.
		22
		23	=head1 SYNOPSIS
		24
		25	my $db = WeBWorK::DB->new($dbLayout);
		26
		27	my @userIDs = $db->listUsers();
		28	my $Sam = $db->{user}->{record}->new();
		29
		30	$Sam->user_id("sammy");
		31	$Sam->first_name("Sam");
		32	$Sam->last_name("Hathaway");
		33	# etc.
		34
		35	$db->addUser($User);
		36	my $Dennis = $db->getUser("dennis");
		37	$Dennis->status("C");
		38	$db->putUser->($Dennis);
		39
		40	$db->deleteUser("sammy");
		41
		42	=head1 DESCRIPTION
		43
		44	WeBWorK::DB provides a consistent interface to a number of database backends.
		45	Access and modification functions are provided for each logical table used by
		46	the webwork system. The particular backend ("schema" and "driver"), record
		47	class, data source, and additional parameters are specified by the hash
		48	referenced by C<$dbLayout>, usually taken from the course environment.
		49
		50	=head1 ARCHITECTURE
		51
		52	The new database system uses a three-tier architecture to insulate each layer
		53	from the adjacent layers.
		54
		55	=head2 Top Layer: DB
		56
		57	The top layer of the architecture is the DB module. It provides the methods
		58	listed below, and uses schema modules (via tables) to implement those methods.
		59
		60	/ new* list* exists* add* get* gets put delete* \ <- api
		61	+------------------------------------------------------------------+
		62	\| DB \|
		63	+------------------------------------------------------------------+
		64	\ password permission key user set set_user problem problem_user / <- tables
		65
		66	=head2 Middle Layer: Schemas
		67
		68	The middle layer of the architecture is provided by one or more schema modules.
		69	They are called "schema" modules because they control the structure of the data
		70	for a table. This includes odd things like the way multiple tables are encoded
		71	in a single hash in the WW1Hash schema, and the encoding scheme used.
		72
		73	The schema modules provide an API that matches the requirements of the DB
		74	layer, on a per-table basis. Each schema module has a style that determines
		75	which drivers it can interface with. For example, WW1Hash is a "hash" style
		76	schema. SQL is a "dbi" style schema.
		77
		78	=head3 Examples
		79
		80	Both WeBWorK 1.x and 2.x courses use:
		81
		82	/ password permission key \ / user \ <- tables provided
		83	+-----------------------------+ +----------------+
		84	\| Auth1Hash \| \| Classlist1Hash \|
		85	+-----------------------------+ +----------------+
		86	\ hash / \ hash / <- driver style required
		87
		88	WeBWorK 1.x courses also use:
		89
		90	/ set_user problem_user \ / set problem \
		91	+-------------------------+ +---------------------+
		92	\| WW1Hash \| \| GlobalTableEmulator \|
		93	+-------------------------+ +---------------------+
		94	\ hash / \ null /
		95
		96	The GlobalTableEmulator schema emulates the global set and problem tables using
		97	data from the set_user and problem_user tables.
		98
		99	WeBWorK 2.x courses also use:
		100
		101	/ set set_user problem problem_user \
		102	+-------------------------------------+
		103	\| WW2Hash \|
		104	+-------------------------------------+
		105	\ hash /
		106
		107	=head2 Bottom Layer: Drivers
		108
		109	Driver modules implement a style for a schema. They provide physical access to
		110	a data source containing the data for a table. The style of a driver determines
		111	what methods it provides. All drivers provide C<connect(MODE)> and
		112	C<disconnect()> methods. A hash style driver provides a C<hash()> method which
		113	returns the tied hash. A dbi style driver provides a C<handle()> method which
		114	returns the DBI handle.
		115
		116	=head3 Examples
		117
		118	/ hash \ / hash \ / hash \ <- style
		119	+--------+ +--------+ +--------+
		120	\| DB \| \| GDBM \| \| DB3 \|
		121	+--------+ +--------+ +--------+
		122
		123	/ dbi \ / ldap \
		124	+-------+ +--------+
		125	\| SQL \| \| LDAP \|
		126	+-------+ +--------+
		127
		128	=head2 Record Types
		129
		130	In C<%dblayout>, each table is assigned a record class, used for passing
		131	complete records to and from the database. The default record classes are
		132	subclasses of the WeBWorK::DB::Record class, and are named as follows: User,
		133	Password, PermissionLevel, Key, Set, UserSet, Problem, UserProblem. In the
		134	following documentation, a reference the the record class for a table means the
		135	record class currently defined for that table in C<%dbLayout>.
11		136
12	=cut	137	=cut
13		138
14	use strict;	139	use strict;
15	use warnings;	140	use warnings;
		141	use Carp;
16	use Data::Dumper;	142	use Data::Dumper;
		143	use WeBWorK::Timing;
17	use WeBWorK::Utils qw(runtime_use);	144	use WeBWorK::Utils qw(runtime_use);
18		145
19	use constant TABLES => qw(password permission key user set set_user problem problem_user);
20
21	################################################################################	146	################################################################################
22	# constructor	147	# constructor
23	################################################################################	148	################################################################################
24		149
		150	=head1 CONSTRUCTOR
		151
		152	=over
		153
		154	=item new($ce)
		155
		156	The C<new> method creates a DB object and brings up the underlying
		157	schema/driver structure according to the C<%dbLayout> hash in C<$ce>, a
		158	WeBWorK::CourseEnvironment object.
		159
		160	=back
		161
		162	=head2 C<$dbLayout> Format
		163
		164	C<$dbLayout> is a hash reference consisting of items keyed by table names. The
		165	value of each item is a reference to a hash containing the following items:
		166
		167	=over
		168
		169	=item record
		170
		171	The name of a perl module to use for representing the data in a record.
		172
		173	=item schema
		174
		175	The name of a perl module to use for access to the table.
		176
		177	=item driver
		178
		179	The name of a perl module to use for access to the data source.
		180
		181	=item source
		182
		183	The location of the data source that should be used by the driver module.
		184	Depending on the driver, this may be a path, a url, or a DBI spec.
		185
		186	=item params
		187
		188	A reference to a hash containing extra information needed by the schema. Some
		189	schemas require parameters, some do not. Consult the documentation for the
		190	schema in question.
		191
		192	=back
		193
		194	For each table defined in C<$dbLayout>, C<new> loads the record, schema, and
		195	driver modules. It the schema module's C<tables> method lists the current table
		196	(or contains the string "*") and the output of the schema and driver modules'
		197	C<style> methods match, the table is installed. Otherwise, an exception is
		198	thrown.
		199
		200	=cut
		201
25	sub new($$) {	202	sub new($$) {
26	my ($invocant, $ce) = @_;	203	my ($invocant, $dbLayout) = @_;
27	my $class = ref($invocant) \|\| $invocant;	204	my $class = ref($invocant) \|\| $invocant;
28	my $self = {};	205	my $self = {};
		206	bless $self, $class; # bless this here so we can pass it to the schema
29		207
30	# load the modules required to handle each table, and create driver	208	# load the modules required to handle each table, and create driver
31	foreach my $table (TABLES) {	209	my %dbLayout = %$dbLayout;
32	unless (defined $ce->{dbLayout}->{$table}) {	210	foreach my $table (keys %dbLayout) {
33	#warn "ignoring table $table: layout not specified in dbLayout"; # ***
34	next;
35	}
36
37	my $layout = $ce->{dbLayout}->{$table};	211	my $layout = $dbLayout{$table};
38	my $record = $layout->{record};	212	my $record = $layout->{record};
39	my $schema = $layout->{schema};	213	my $schema = $layout->{schema};
40	my $driver = $layout->{driver};	214	my $driver = $layout->{driver};
41	my $source = $layout->{source};	215	my $source = $layout->{source};
42	my $params = $layout->{params};	216	my $params = $layout->{params};
43		217
44	runtime_use($record);	218	runtime_use($record);
		219
		220	runtime_use($driver);
		221	my $driverObject = eval { $driver->new($source, $params) };
		222	croak "error instantiating DB driver $driver for table $table: $@"
		223	if $@;
		224
45	runtime_use($schema);	225	runtime_use($schema);
46	runtime_use($driver);	226	my $schemaObject = eval { $schema->new(
47	$self->{$table} = $schema->new($driver->new($source, $params), $table, $record, $params);	227	$self, $driverObject, $table, $record, $params) };
		228	croak "error instantiating DB schema $schema for table $table: $@"
		229	if $@;
		230
		231	$self->{$table} = $schemaObject;
48	}	232	}
49		233
50	bless $self, $class;
51	return $self;	234	return $self;
52	}	235	}
53		236
		237	=head1 METHODS
		238
		239	=cut
		240
		241	################################################################################
		242	# general functions
		243	################################################################################
		244
		245	=head2 General Methods
		246
		247	=over
		248
		249	=cut
		250
		251	=item hashDatabaseOK($fix)
		252
		253	If the schema module in use for the C<set> and C<problem> tables is
		254	WeBWorK::DB::Schema::GlobalTableEmulator, the database is checked to make sure
		255	that the "global user" exists and all sets and problems are assigned to it. If
		256	$fix is true, problems found will be fixed: A global user will be created and
		257	all sets/problems assigned to it.
		258
		259	A list of values is returned. The first value is a boolean value indicating
		260	whether problems remain in the database after hashDatabaseOK() is called. The
		261	remaining values are a list of strings indicating the particular ways in which
		262	the database is (or was) broken.
		263
		264	=cut
		265
		266	sub hashDatabaseOK {
		267	my ($self, $fix) = @_;
		268
		269	my $errorsExist;
		270	my @results;
		271
		272	##### do we need to run? #####
		273
		274	unless (ref $self->{set} eq "WeBWorK::DB::Schema::GlobalTableEmulator") {
		275	#warn "hashDatabaseOK($fix): no checks necessary, set table does not use GlobalTableEmulator.\n";
		276	return 1;
		277	}
		278
		279	##### is globalUserID defined? #####
		280
		281	my $globalUserID = $self->{set}->{params}->{globalUserID};
		282	if ($globalUserID eq "") {
		283	return 0, "globalUserID not specified (fix this in %dbLayout.)";
		284	} else {
		285	#warn "hashDatabaseOK($fix): globalUserID not empty ($globalUserID) -- good.\n";
		286	}
		287
		288	##### does a user with ID globalUserID exist? #####
		289
		290	my $GlobalUser = $self->getUser($globalUserID);
		291	if (defined $GlobalUser) {
		292	#warn "hashDatabaseOK($fix): user with ID '$globalUserID' exists -- good.\n";
		293	} else {
		294	#warn "hashDatabaseOK($fix): user with ID '$globalUserID' not found -- bad!\n";
		295	if ($fix) {
		296	$self->addUser($self->newUser(
		297	user_id => $globalUserID,
		298	first_name => "Global",
		299	last_name => "User",
		300	email_address => "",
		301	student_id => $globalUserID,
		302	status => "D",
		303	section => "",
		304	recitation => "",
		305	comment => "This user is used to store data about global set and problem records when using a hash-style database.",
		306	));
		307	push @results, "User $globalUserID does not exist -- FIXED.";
		308	#warn "hashDatabaseOK($fix): created user with ID '$globalUserID' -- good.\n";
		309	} else {
		310	# at this point, we don't go on. no global user means everything below is going to fail.
		311	return 0, "User $globalUserID does not exist.";
		312	}
		313	}
		314
		315	##### are all sets assigned to the user with ID globalUserID? #####
		316
		317	# FIXME: this is way too slow!
		318	#my @userSetIDs = $self->{set_user}->list(undef, undef);
		319
		320	# Timing Data
		321	#
		322	# old method:
		323	# TIMING 36119 1 1087502726.923311 (0.139117) mth143: WeBWorK::DB::hashDatabaseOK: about to get orphaned UserSets
		324	# TIMING 36119 1 1087502768.074221 (41.290027) mth143: WeBWorK::DB::hashDatabaseOK: done getting orphaned UserSets
		325	#
		326	# new method:
		327	# TIMING 36134 0 1087502854.579133 (0.141437) mth143: WeBWorK::DB::hashDatabaseOK: about to get orphaned UserSets
		328	# TIMING 36134 0 1087502856.852504 (2.414808) mth143: WeBWorK::DB::hashDatabaseOK: done getting orphaned UserSets
		329	#
		330	# yay!
		331
		332	$WeBWorK::timer->continue(__PACKAGE__ . "::hashDatabaseOK: about to get orphaned UserSets") if defined $WeBWorK::timer;
		333
		334	# ... so instead, we're going to do things manually
		335
		336	# key: setID, value: hash of userIDs of users to whom this set is assigned
		337	my %orphanUserSets;
		338
		339	if (ref $self->{set_user} eq "WeBWorK::DB::Schema::WW1Hash") {
		340	# we can only do this with WW1Hash
		341	#warn "the fast way!\n";
		342
		343	# connect
		344	$self->{set_user}->{driver}->connect("ro")
		345	or return 0, @results, "Failed to connect to set_user database.";
		346
		347	# get PSVNs for global user (²N)
		348	my @globalUserPSVNs = $self->{set_user}->getPSVNsForUser($globalUserID);
		349	#warn "found ", scalar @globalUserPSVNs, " PSVNs for the global user.\n";
		350
		351	# get setIDs for PSVNs (M)
		352	my @globalUserSetIDs;
		353	foreach my $PSVN (@globalUserPSVNs) {
		354	#warn "getting setID for PSVN '$PSVN'...\n";
		355	my $string = $self->{set_user}->fetchString($PSVN);
		356	my (undef, $setID) = $self->{set_user}->string2IDs($string); # discard userID, problemIDs
		357	push @globalUserSetIDs, $setID;
		358	#warn "got setID '$setID'\n";
		359	}
		360
		361	# get PSVNs for each setID (²N*M)
		362	my @okPSVNs = map { $self->{set_user}->getPSVNsForSet($_) } @globalUserSetIDs;
		363	#warn "found ", scalar @okPSVNs, " PSVNs for sets assigned to the global user.\n";
		364
		365	# get all PSVNs (N*M)
		366	my @allPSVNs = $self->{set_user}->getAllPSVNs;
		367	#warn "found ", scalar @allPSVNs, " PSVNs total.\n";
		368
		369	# eliminate PSVNs of sets that are assigned to the global user
		370	my %allPSVNs;
		371	@allPSVNs{@allPSVNs} = ();
		372
		373	foreach my $PSVN (@okPSVNs) {
		374	delete $allPSVNs{$PSVN};
		375	}
		376
		377	# get setIDs for orphan PSVNs
		378	foreach my $PSVN (keys %allPSVNs) {
		379	#warn "getting userID and setID for PSVN '$PSVN'...\n";
		380	my $string = $self->{set_user}->fetchString($PSVN);
		381	my ($userID, $setID) = $self->{set_user}->string2IDs($string);
		382	$orphanUserSets{$setID}->{$userID} = 1;
		383	#warn "got setID '$setID' for userID '$userID'\n";
		384	}
		385
		386	# disconnect
		387	$self->{set_user}->{driver}->disconnect;
		388	} else {
		389	# otherwise, do it the slow way (maybe it's not slow with some other schema?)
		390	#warn "oddly enough, set_user isn't using WW1Hash, so we have to use the slow list() method";
		391	my @userSetIDs = $self->{set_user}->list(undef, undef);
		392
		393	foreach my $userSetID (@userSetIDs) {
		394	my ($userID, $setID) = @$userSetID;
		395	$orphanUserSets{$setID}->{$userID} = 1;
		396	}
		397
		398	foreach my $setID (keys %orphanUserSets) {
		399	delete $orphanUserSets{$setID}
		400	if exists $orphanUserSets{$setID}->{$globalUserID};
		401	}
		402	}
		403
		404	$WeBWorK::timer->continue(__PACKAGE__ . "::hashDatabaseOK: done getting orphaned UserSets") if defined $WeBWorK::timer;
		405
		406	if (keys %orphanUserSets) {
		407	if ($fix) {
		408	foreach my $setID (keys %orphanUserSets) {
		409	my $userID = ( keys %{$orphanUserSets{$setID}} )[0];
		410
		411	# grab the first UserSet of this set (connect and disconnect required for get1*)
		412	$self->{set_user}->{driver}->connect("ro")
		413	or return 0, @results, "Failed to connect to set_user database.";
		414	my $RawUserSet = $self->{set_user}->get1NoFilter($userID, $setID);
		415	$self->{set_user}->{driver}->disconnect();
		416	unless ($RawUserSet) {
		417	#warn "failed to fetch UserSet '$setID' for user '$userID'!\n";
		418	next;
		419	}
		420
		421	# change user ID to globalUserID and add to database
		422	$RawUserSet->user_id($globalUserID);
		423	$self->{set_user}->add($RawUserSet);
		424
		425	push @results, "Set '$setID' not assigned to global user '$globalUserID' -- FIXED.";
		426
		427	#warn "hashDatabaseOK($fix): assigned set '$setID' to global user '$globalUserID' -- good.\n";
		428	}
		429	} else {
		430	foreach my $setID (keys %orphanUserSets) {
		431	#warn "hashDatabaseOK($fix): set '$setID' not assigned to global user '$globalUserID' -- bad!\n";
		432	push @results, "Set '$setID' not assigned to global user '$globalUserID'.";
		433	}
		434	$errorsExist = 1;
		435	}
		436	} else {
		437	#warn "hashDatabaseOK($fix): all sets assigned to global user '$globalUserID' -- good.\n";
		438	}
		439
		440	##### done! #####
		441
		442	my $status = not $errorsExist;
		443	return $status, @results;
		444	}
		445
		446	=back
		447
		448	=cut
		449
54	################################################################################	450	################################################################################
55	# password functions	451	# password functions
56	################################################################################	452	################################################################################
57		453
		454	=head2 Password Methods
		455
		456	=over
		457
		458	=item newPassword()
		459
		460	Returns a new, empty password object.
		461
		462	=cut
		463
		464	sub newPassword {
		465	my ($self, @prototype) = @_;
		466	return $self->{password}->{record}->new(@prototype);
		467	}
		468
		469	=item listPasswords()
		470
		471	Returns a list of user IDs representing the records in the password table.
		472
		473	=cut
		474
58	sub listPasswords($) {	475	sub listPasswords {
59	my ($self) = @_;	476	my ($self) = @_;
		477
		478	croak "listPasswords: requires 0 arguments"
		479	unless @_ == 1;
		480
60	return map { $_->[0] }	481	return map { $_->[0] }
61	$self->{password}->list(undef);	482	$self->{password}->list(undef);
62	}	483	}
63		484
		485	=item addPassword($Password)
		486
		487	$Password is a record object. The password will be added to the password table
		488	if a password with the same user ID does not already exist. If one does exist,
		489	an exception is thrown. To add a password, a user with a matching user ID must
		490	exist in the user table.
		491
		492	=cut
		493
64	sub addPassword($$) {	494	sub addPassword {
65	my ($self, $Password) = @_;	495	my ($self, $Password) = @_;
		496
		497	croak "addPassword: requires 1 argument"
		498	unless @_ == 2;
		499	croak "addPassword: argument 1 must be of type ", $self->{password}->{record}
		500	unless ref $Password eq $self->{password}->{record};
		501
		502	checkKeyfields($Password);
		503
		504	croak "addPassword: password exists (perhaps you meant to use putPassword?)"
		505	if $self->{password}->exists($Password->user_id);
66	die "addPassword failed: user ", $Password->user_id, " does not exist.\n"	506	croak "addPassword: user ", $Password->user_id, " not found"
67	unless $self->{user}->exists($Password->user_id);	507	unless $self->{user}->exists($Password->user_id);
		508
68	return $self->{password}->add($Password);	509	return $self->{password}->add($Password);
69	}	510	}
70		511
		512	=item getPassword($userID)
		513
		514	If a record with a matching user ID exists, a record object containting that
		515	record's data will be returned. If no such record exists, one will be created.
		516
		517	=cut
		518
71	sub getPassword($$) {	519	sub getPassword {
72	my ($self, $userID) = @_;	520	my ($self, $userID) = @_;
		521
		522	croak "getPassword: requires 1 argument"
		523	unless @_ == 2;
		524	croak "getPassword: argument 1 must contain a user_id"
		525	unless defined $userID;
		526
73	return $self->{password}->get($userID);	527	#return $self->{password}->get($userID);
		528	return ( $self->getPasswords($userID) )[0];
74	}	529	}
		530
		531	=item getPasswords(@uesrIDs)
		532
		533	Return a list of password records associated with the user IDs given. If there
		534	is no record associated with a given user ID, one will be created.
		535
		536	=cut
		537
		538	sub getPasswords {
		539	my ($self, @userIDs) = @_;
		540
		541	#croak "getPasswords: requires 1 or more argument"
		542	# unless @_ >= 2;
		543	foreach my $i (0 .. $#userIDs) {
		544	croak "getPasswords: element $i of argument list must contain a user_id"
		545	unless defined $userIDs[$i];
		546	}
		547
		548	my @Passwords = $self->{password}->gets(map { [$_] } @userIDs);
		549
		550	for (my $i = 0; $i < @Passwords; $i++) {
		551	my $Password = $Passwords[$i];
		552	my $userID = $userIDs[$i];
		553	if (not defined $Password) {
		554	#warn "not defined\n";
		555	if ($self->{user}->exists($userID)) {
		556	#warn "user exists\n";
		557	$Password = $self->newPassword(user_id => $userID);
		558	eval { $self->addPassword($Password) };
		559	if ($@ and $@ !~ m/password exists/) {
		560	die "error while auto-creating password record for user $userID: \"$@\"";
		561	}
		562	}
		563	}
		564	}
		565
		566	return @Passwords;
		567	}
		568
		569	=item putPassword($Password)
		570
		571	$Password is a record object. If a password record with the same user ID exists
		572	in the password table, the data in the record is replaced with the data in
		573	$Password. If a matching password record does not exist, an exception is
		574	thrown.
		575
		576	=cut
75		577
76	sub putPassword($$) {	578	sub putPassword($$) {
77	my ($self, $Password) = @_;	579	my ($self, $Password) = @_;
		580
		581	croak "putPassword: requires 1 argument"
		582	unless @_ == 2;
		583	croak "putPassword: argument 1 must be of type ", $self->{password}->{record}
		584	unless ref $Password eq $self->{password}->{record};
		585
		586	checkKeyfields($Password);
		587
		588	croak "putPassword: password not found (perhaps you meant to use addPassword?)"
		589	unless $self->{password}->exists($Password->user_id);
		590
78	return $self->{password}->put($Password);	591	return $self->{password}->put($Password);
79	}	592	}
		593
		594	=item deletePassword($userID)
		595
		596	If a password record with a user ID matching $userID exists in the password
		597	table, it is removed and the method returns a true value. If one does exist,
		598	a false value is returned.
		599
		600	=cut
80		601
81	sub deletePassword($$) {	602	sub deletePassword($$) {
82	my ($self, $userID) = @_;	603	my ($self, $userID) = @_;
		604
		605	croak "putPassword: requires 1 argument"
		606	unless @_ == 2;
		607	croak "deletePassword: argument 1 must contain a user_id"
		608	unless defined $userID;
		609
83	return $self->{password}->delete($userID);	610	return $self->{password}->delete($userID);
84	}	611	}
85		612
		613	=back
		614
		615	=cut
		616
86	################################################################################	617	################################################################################
87	# permission functions	618	# permission functions
88	################################################################################	619	################################################################################
		620
		621	=head2 Permission Level Methods
		622
		623	=over
		624
		625	=item newPermissionLevel()
		626
		627	Returns a new, empty permission level object.
		628
		629	=cut
		630
		631	sub newPermissionLevel {
		632	my ($self, @prototype) = @_;
		633	return $self->{permission}->{record}->new(@prototype);
		634	}
		635
		636	=item listPermissionLevels()
		637
		638	Returns a list of user IDs representing the records in the permission table.
		639
		640	=cut
89		641
90	sub listPermissionLevels($) {	642	sub listPermissionLevels($) {
91	my ($self) = @_;	643	my ($self) = @_;
		644
		645	croak "listPermissionLevels: requires 0 arguments"
		646	unless @_ == 1;
		647
92	return map { $_->[0] }	648	return map { $_->[0] }
93	$self->{permission}->list(undef);	649	$self->{permission}->list(undef);
94	}	650	}
95		651
		652	=item addPermissionLevel($PermissionLevel)
		653
		654	$PermissionLevel is a record object. The permission level will be added to the
		655	permission table if a permission level with the same user ID does not already
		656	exist. If one does exist, an exception is thrown. To add a permission level, a
		657	user with a matching user ID must exist in the user table.
		658
		659	=cut
		660
96	sub addPermissionLevel($$) {	661	sub addPermissionLevel($$) {
97	my ($self, $PermissionLevel) = @_;	662	my ($self, $PermissionLevel) = @_;
		663
		664	croak "addPermissionLevel: requires 1 argument"
		665	unless @_ == 2;
		666	croak "addPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}
		667	unless ref $PermissionLevel eq $self->{permission}->{record};
		668
		669	checkKeyfields($PermissionLevel);
		670
		671	croak "addPermissionLevel: permission level exists (perhaps you meant to use putPermissionLevel?)"
		672	if $self->{permission}->exists($PermissionLevel->user_id);
98	die "addPermissionLevel failed: user ", $PermissionLevel->user_id, " does not exist.\n"	673	croak "addPermissionLevel: user ", $PermissionLevel->user_id, " not found"
99	unless $self->{user}->exists($PermissionLevel->user_id);	674	unless $self->{user}->exists($PermissionLevel->user_id);
		675
100	return $self->{permission}->add($PermissionLevel);	676	return $self->{permission}->add($PermissionLevel);
101	}	677	}
		678
		679	=item getPermissionLevel($userID)
		680
		681	If a record with a matching user ID exists, a record object containting that
		682	record's data will be returned. If no such record exists, one will be created.
		683
		684	=cut
102		685
103	sub getPermissionLevel($$) {	686	sub getPermissionLevel($$) {
104	my ($self, $userID) = @_;	687	my ($self, $userID) = @_;
		688
		689	croak "getPermissionLevel: requires 1 argument"
		690	unless @_ == 2;
		691	croak "getPermissionLevel: argument 1 must contain a user_id"
		692	unless defined $userID;
		693
105	return $self->{permission}->get($userID);	694	#return $self->{permission}->get($userID);
		695	return ( $self->getPermissionLevels($userID) )[0];
106	}	696	}
		697
		698	=item getPermissionLevels(@uesrIDs)
		699
		700	Return a list of permission level records associated with the user IDs given. If
		701	there is no record associated with a given user ID, one will be created.
		702
		703	=cut
		704
		705	sub getPermissionLevels {
		706	my ($self, @userIDs) = @_;
		707
		708	#croak "getPermissionLevels: requires 1 or more argument"
		709	# unless @_ >= 2;
		710	foreach my $i (0 .. $#userIDs) {
		711	croak "getPermissionLevels: element $i of argument list must contain a user_id"
		712	unless defined $userIDs[$i];
		713	}
		714
		715	my @PermissionLevels = $self->{permission}->gets(map { [$_] } @userIDs);
		716
		717	for (my $i = 0; $i < @PermissionLevels; $i++) {
		718	my $PermissionLevel = $PermissionLevels[$i];
		719	my $userID = $userIDs[$i];
		720	if (not defined $PermissionLevel) {
		721	#warn "not defined\n";
		722	if ($self->{user}->exists($userID)) {
		723	#warn "user exists\n";
		724	$PermissionLevel = $self->newPermissionLevel(user_id => $userID);
		725	#warn $PermissionLevel->toString, "\n";
		726	eval { $self->addPermissionLevel($PermissionLevel) };
		727	if ($@ and $@ !~ m/permission level exists/) {
		728	die "error while auto-creating permission level record for user $userID: \"$@\"";
		729	}
		730	$PermissionLevels[$i] = $PermissionLevel;
		731	}
		732	}
		733	}
		734
		735	return @PermissionLevels;
		736	}
		737
		738	=item putPermissionLevel($PermissionLevel)
		739
		740	$PermissionLevel is a record object. If a permission level record with the same
		741	user ID exists in the permission table, the data in the record is replaced with
		742	the data in $PermissionLevel. If a matching permission level record does not
		743	exist, an exception is thrown.
		744
		745	=cut
107		746
108	sub putPermissionLevel($$) {	747	sub putPermissionLevel($$) {
109	my ($self, $PermissionLevel) = @_;	748	my ($self, $PermissionLevel) = @_;
		749
		750	croak "putPermissionLevel: requires 1 argument"
		751	unless @_ == 2;
		752	croak "putPermissionLevel: argument 1 must be of type ", $self->{permission}->{record}
		753	unless ref $PermissionLevel eq $self->{permission}->{record};
		754
		755	checkKeyfields($PermissionLevel);
		756
		757	croak "putPermissionLevel: permission level not found (perhaps you meant to use addPermissionLevel?)"
		758	unless $self->{permission}->exists($PermissionLevel->user_id);
		759
110	return $self->{permission}->put($PermissionLevel);	760	return $self->{permission}->put($PermissionLevel);
111	}	761	}
		762
		763	=item deletePermissionLevel($userID)
		764
		765	If a permission level record with a user ID matching $userID exists in the
		766	permission table, it is removed and the method returns a true value. If one
		767	does exist, a false value is returned.
		768
		769	=cut
112		770
113	sub deletePermissionLevel($$) {	771	sub deletePermissionLevel($$) {
114	my ($self, $userID) = @_;	772	my ($self, $userID) = @_;
		773
		774	croak "deletePermissionLevel: requires 1 argument"
		775	unless @_ == 2;
		776	croak "deletePermissionLevel: argument 1 must contain a user_id"
		777	unless defined $userID;
		778
115	return $self->{permission}->delete($userID);	779	return $self->{permission}->delete($userID);
116	}	780	}
117		781
118	################################################################################	782	################################################################################
119	# key functions	783	# key functions
120	################################################################################	784	################################################################################
		785
		786	=head2 Key Methods
		787
		788	=over
		789
		790	=item newKey()
		791
		792	Returns a new, empty key object.
		793
		794	=cut
		795
		796	sub newKey {
		797	my ($self, @prototype) = @_;
		798	return $self->{key}->{record}->new(@prototype);
		799	}
		800
		801	=item listKeys()
		802
		803	Returns a list of user IDs representing the records in the key table.
		804
		805	=cut
121		806
122	sub listKeys($) {	807	sub listKeys($) {
123	my ($self) = @_;	808	my ($self) = @_;
		809
		810	croak "listKeys: requires 0 arguments"
		811	unless @_ == 1;
		812
124	return map { $_->[0] }	813	return map { $_->[0] }
125	$self->{key}->list(undef);	814	$self->{key}->list(undef);
126	}	815	}
127		816
		817	=item addKey($Key)
		818
		819	$Key is a record object. The key will be added to the key table if a key with
		820	the same user ID does not already exist. If one does exist, an exception is
		821	thrown. To add a key, a user with a matching user ID must exist in the user
		822	table.
		823
		824	=cut
		825
128	sub addKey($$) {	826	sub addKey($$) {
129	my ($self, $Key) = @_;	827	my ($self, $Key) = @_;
130	die "addKey failed: user ", $Key->user_id, " does not exist.\n"	828
		829	croak "addKey: requires 1 argument"
		830	unless @_ == 2;
		831	croak "addKey: argument 1 must be of type ", $self->{key}->{record}
		832	unless ref $Key eq $self->{key}->{record};
		833
		834	checkKeyfields($Key);
		835
		836	croak "addKey: key exists (perhaps you meant to use putKey?)"
		837	if $self->{key}->exists($Key->user_id);
		838	croak "addKey: user ", $Key->user_id, " not found"
131	unless $self->{user}->exists($Key->user_id);	839	unless $self->{user}->exists($Key->user_id);
		840
132	return $self->{key}->add($Key);	841	return $self->{key}->add($Key);
133	}	842	}
		843
		844	=item getKey($userID)
		845
		846	If a record with a matching user ID exists, a record object containting that
		847	record's data will be returned. If no such record exists, an undefined value
		848	will be returned.
		849
		850	=cut
134		851
135	sub getKey($$) {	852	sub getKey($$) {
136	my ($self, $userID) = @_;	853	my ($self, $userID) = @_;
		854
		855	croak "getKey: requires 1 argument"
		856	unless @_ == 2;
		857	croak "getKey: argument 1 must contain a user_id"
		858	unless defined $userID;
		859
137	return $self->{key}->get($userID);	860	return $self->{key}->get($userID);
138	}	861	}
		862
		863	=item getKeys(@uesrIDs)
		864
		865	Return a list of key records associated with the user IDs given. If there is no
		866	record associated with a given user ID, that element of the list will be
		867	undefined.
		868
		869	=cut
		870
		871	sub getKeys {
		872	my ($self, @userIDs) = @_;
		873
		874	#croak "getKeys: requires 1 or more argument"
		875	# unless @_ >= 2;
		876	foreach my $i (0 .. $#userIDs) {
		877	croak "getKeys: element $i of argument list must contain a user_id"
		878	unless defined $userIDs[$i];
		879	}
		880
		881	return $self->{key}->gets(map { [$_] } @userIDs);
		882	}
		883
		884	=item putKey($Key)
		885
		886	$Key is a record object. If a key record with the same user ID exists in the
		887	key table, the data in the record is replaced with the data in $Key. If a
		888	matching key record does not exist, an exception is thrown.
		889
		890	=cut
139		891
140	sub putKey($$) {	892	sub putKey($$) {
141	my ($self, $Key) = @_;	893	my ($self, $Key) = @_;
		894
		895	croak "putKey: requires 1 argument"
		896	unless @_ == 2;
		897	croak "putKey: argument 1 must be of type ", $self->{key}->{record}
		898	unless ref $Key eq $self->{key}->{record};
		899
		900	checkKeyfields($Key);
		901
		902	croak "putKey: key not found (perhaps you meant to use addKey?)"
		903	unless $self->{key}->exists($Key->user_id);
		904
142	return $self->{key}->put($Key);	905	return $self->{key}->put($Key);
143	}	906	}
		907
		908	=item deleteKey($userID)
		909
		910	If a key record with a user ID matching $userID exists in the key table, it is
		911	removed and the method returns a true value. If one does exist, a false value
		912	is returned.
		913
		914	=cut
144		915
145	sub deleteKey($$) {	916	sub deleteKey($$) {
146	my ($self, $userID) = @_;	917	my ($self, $userID) = @_;
		918
		919	croak "deleteKey: requires 1 argument"
		920	unless @_ == 2;
		921	croak "deleteKey: argument 1 must contain a user_id"
		922	unless defined $userID;
		923
147	return $self->{key}->delete($userID);	924	return $self->{key}->delete($userID);
148	}	925	}
149		926
150	################################################################################	927	################################################################################
151	# user functions	928	# user functions
152	################################################################################	929	################################################################################
153		930
		931	=head2 User Methods
		932
		933	=over
		934
		935	=item newUser()
		936
		937	Returns a new, empty user object.
		938
		939	=cut
		940
		941	sub newUser {
		942	my ($self, @prototype) = @_;
		943	return $self->{user}->{record}->new(@prototype);
		944	}
		945
		946	=item listUsers()
		947
		948	Returns a list of user IDs representing the records in the user table.
		949
		950	=cut
		951
154	sub listUsers($) {	952	sub listUsers {
155	my ($self) = @_;	953	my ($self) = @_;
		954
		955	croak "listUsers: requires 0 arguments"
		956	unless @_ == 1;
		957
156	return map { $_->[0] }	958	return map { $_->[0] }
157	$self->{user}->list(undef);	959	$self->{user}->list(undef);
158	}	960	}
159		961
		962	=item addUser($User)
		963
		964	$User is a record object. The user will be added to the user table if a user
		965	with the same user ID does not already exist. If one does exist, an exception
		966	is thrown.
		967
		968	=cut
		969
160	sub addUser($$) {	970	sub addUser {
161	my ($self, $User) = @_;	971	my ($self, $User) = @_;
		972
		973	croak "addUser: requires 1 argument"
		974	unless @_ == 2;
		975	croak "addUser: argument 1 must be of type ", $self->{user}->{record}
		976	unless ref $User eq $self->{user}->{record};
		977
		978	checkKeyfields($User);
		979
		980	croak "addUser: user exists (perhaps you meant to use putUser?)"
		981	if $self->{user}->exists($User->user_id);
		982
162	return $self->{user}->add($User);	983	return $self->{user}->add($User);
163	}	984	}
164		985
		986	=item getUser($userID)
		987
		988	If a record with a matching user ID exists, a record object containting that
		989	record's data will be returned. If no such record exists, an undefined value
		990	will be returned.
		991
		992	=cut
		993
165	sub getUser($$) {	994	sub getUser {
166	my ($self, $userID) = @_;	995	my ($self, $userID) = @_;
		996
		997	croak "getUser: requires 1 argument"
		998	unless @_ == 2;
		999	croak "getUser: argument 1 must contain a user_id"
		1000	unless defined $userID;
		1001
167	return $self->{user}->get($userID);	1002	return $self->{user}->get($userID);
168	}	1003	}
169		1004
		1005	=item getUsers(@uesrIDs)
		1006
		1007	Return a list of user records associated with the user IDs given. If there is no
		1008	record associated with a given user ID, that element of the list will be
		1009	undefined.
		1010
		1011	=cut
		1012
		1013	sub getUsers {
		1014	my ($self, @userIDs) = @_;
		1015
		1016	#croak "getUsers: requires 1 or more argument"
		1017	# unless @_ >= 2;
		1018	foreach my $i (0 .. $#userIDs) {
		1019	croak "getUsers: element $i of argument list must contain a user_id"
		1020	unless defined $userIDs[$i];
		1021	}
		1022
		1023	return $self->{user}->gets(map { [$_] } @userIDs);
		1024	}
		1025
		1026	=item putUser($User)
		1027
		1028	$User is a record object. If a user record with the same user ID exists in the
		1029	user table, the data in the record is replaced with the data in $User. If a
		1030	matching user record does not exist, an exception is thrown.
		1031
		1032	=cut
		1033
170	sub putUser($$) {	1034	sub putUser {
171	my ($self, $User) = @_;	1035	my ($self, $User) = @_;
		1036
		1037	croak "putUser: requires 1 argument"
		1038	unless @_ == 2;
		1039	croak "putUser: argument 1 must be of type ", $self->{user}->{record}
		1040	unless ref $User eq $self->{user}->{record};
		1041
		1042	checkKeyfields($User);
		1043
		1044	croak "putUser: user not found (perhaps you meant to use addUser?)"
		1045	unless $self->{user}->exists($User->user_id);
		1046
172	return $self->{user}->put($User);	1047	return $self->{user}->put($User);
173	}	1048	}
174		1049
		1050	=item deleteUser($userID)
		1051
		1052	If a user record with a user ID matching $userID exists in the user table, it
		1053	is removed and the method returns a true value. If one does exist, a false
		1054	value is returned. When a user record is deleted, all records associated with
		1055	that user are also deleted. This includes the password, permission, and key
		1056	records, and all user set records for that user.
		1057
		1058	=cut
		1059
175	sub deleteUser($$) {	1060	sub deleteUser {
176	my ($self, $userID) = @_;	1061	my ($self, $userID) = @_;
		1062
		1063	croak "deleteUser: requires 1 argument"
		1064	unless @_ == 2;
		1065	croak "deleteUser: argument 1 must contain a user_id"
		1066	unless defined $userID;
		1067
		1068	$self->deleteUserSet($userID, undef);
177	$self->deletePassword($userID);	1069	$self->deletePassword($userID);
178	$self->deletePermissionLevel($userID);	1070	$self->deletePermissionLevel($userID);
179	$self->deleteKey($userID);	1071	$self->deleteKey($userID);
180	$self->deleteUserSet($userID, $_)
181	foreach $self->listUsers();
182	return $self->{user}->delete($userID);	1072	return $self->{user}->delete($userID);
183	}	1073	}
184		1074
		1075	=back
		1076
		1077	=cut
		1078
185	################################################################################	1079	################################################################################
186	# set functions	1080	# set functions
187	################################################################################	1081	################################################################################
188		1082
		1083	=head2 Global Set Methods
		1084
		1085	FIXME: write this
		1086
		1087	=over
		1088
		1089	=cut
		1090
		1091	=item newGlobalSet()
		1092
		1093	=cut
		1094
		1095	sub newGlobalSet {
		1096	my ($self, @prototype) = @_;
		1097	return $self->{set}->{record}->new(@prototype);
		1098	}
		1099
		1100	=item listGlobalSets()
		1101
		1102	=cut
		1103
189	sub listGlobalSets($) {	1104	sub listGlobalSets {
190	my ($self) = @_;	1105	my ($self) = @_;
		1106
		1107	croak "listGlobalSets: requires 0 arguments"
		1108	unless @_ == 1;
		1109
191	return map { $_->[0] }	1110	return map { $_->[0] }
192	$self->{set}->list(undef);	1111	$self->{set}->list(undef);
193	}	1112	}
194		1113
		1114	=item addGlobalSet($GlobalSet)
		1115
		1116	=cut
		1117
195	sub addGlobalSet($$) {	1118	sub addGlobalSet {
196	my ($self, $GlobalSet) = @_;	1119	my ($self, $GlobalSet) = @_;
		1120
		1121	croak "addGlobalSet: requires 1 argument"
		1122	unless @_ == 2;
		1123	croak "addGlobalSet: argument 1 must be of type ", $self->{set}->{record}
		1124	unless ref $GlobalSet eq $self->{set}->{record};
		1125
		1126	checkKeyfields($GlobalSet);
		1127
		1128	croak "addGlobalSet: global set exists (perhaps you meant to use putGlobalSet?)"
		1129	if $self->{set}->exists($GlobalSet->set_id);
		1130
197	return $self->{set}->add($GlobalSet);	1131	return $self->{set}->add($GlobalSet);
198	}	1132	}
199		1133
		1134	=item addGlobalSet($setID)
		1135
		1136	=cut
		1137
200	sub getGlobalSet($$) {	1138	sub getGlobalSet {
201	my ($self, $setID) = @_;	1139	my ($self, $setID) = @_;
		1140
		1141	croak "getGlobalSet: requires 1 argument"
		1142	unless @_ == 2;
		1143	croak "getGlobalSet: argument 1 must contain a set_id"
		1144	unless defined $setID;
		1145
202	return $self->{set}->get($setID);	1146	return $self->{set}->get($setID);
203	}	1147	}
204		1148
		1149	=item getGlobalSets(@setIDs)
		1150
		1151	Return a list of global set records associated with the record IDs given. If
		1152	there is no record associated with a given record ID, that element of the list
		1153	will be undefined.
		1154
		1155	=cut
		1156
		1157	sub getGlobalSets {
		1158	my ($self, @setIDs) = @_;
		1159
		1160	#croak "getGlobalSets: requires 1 or more argument"
		1161	# unless @_ >= 2;
		1162	foreach my $i (0 .. $#setIDs) {
		1163	croak "getGlobalSets: element $i of argument list must contain a set_id"
		1164	unless defined $setIDs[$i];
		1165	}
		1166
		1167	return $self->{set}->gets(map { [$_] } @setIDs);
		1168	}
		1169
		1170	=item addGlobalSet($GlobalSet)
		1171
		1172	=cut
		1173
205	sub putGlobalSet($$) {	1174	sub putGlobalSet {
206	my ($self, $GlobalSet) = @_;	1175	my ($self, $GlobalSet) = @_;
		1176
		1177	croak "putGlobalSet: requires 1 argument"
		1178	unless @_ == 2;
		1179	croak "putGlobalSet: argument 1 must be of type ", $self->{set}->{record}
		1180	unless ref $GlobalSet eq $self->{set}->{record};
		1181
		1182	checkKeyfields($GlobalSet);
		1183
		1184	croak "putGlobalSet: global set not found (perhaps you meant to use addGlobalSet?)"
		1185	unless $self->{set}->exists($GlobalSet->set_id);
		1186
207	return $self->{set}->put($GlobalSet);	1187	return $self->{set}->put($GlobalSet);
208	}	1188	}
209		1189
		1190	=item addGlobalSet($setID)
		1191
		1192	=cut
		1193
210	sub deleteGlobalSet($$) {	1194	sub deleteGlobalSet {
211	my ($self, $setID) = @_;	1195	my ($self, $setID) = @_;
		1196
		1197	croak "deleteGlobalSet: requires 1 argument"
		1198	unless @_ == 2;
		1199	croak "deleteGlobalSet: argument 1 must contain a set_id"
		1200	unless defined $setID or caller eq __PACKAGE__;
		1201
		1202	$self->deleteUserSet(undef, $setID);
212	$self->deleteGlobalProblem($setID, $_)	1203	$self->deleteGlobalProblem($setID, undef);
213	foreach $self->listGlobalProblems($setID);
214	$self->deleteUserSet($_, $setID)
215	foreach $self->listUsers();
216	return $self->{set}->delete($setID);	1204	return $self->{set}->delete($setID);
217	}	1205	}
218		1206
		1207	=back
		1208
		1209	=cut
		1210
219	################################################################################	1211	################################################################################
220	# set_user functions	1212	# set_user functions
221	################################################################################	1213	################################################################################
222		1214
223	sub listSetUsers($$) {	1215	=head2 User-Specific Set Methods
		1216
		1217	FIXME: write this
		1218
		1219	=over
		1220
		1221	=cut
		1222
		1223	sub newUserSet {
		1224	my ($self, @prototype) = @_;
		1225	return $self->{set_user}->{record}->new(@prototype);
		1226	}
		1227
		1228	sub countSetUsers {
224	my ($self, $setID) = @_;	1229	my ($self, $setID) = @_;
		1230
		1231	croak "countSetUsers: requires 1 argument"
		1232	unless @_ == 2;
		1233	croak "countSetUsers: argument 1 must contain a set_id"
		1234	unless defined $setID;
		1235
		1236	# inefficient way
		1237	#return scalar $self->{set_user}->list(undef, $setID);
		1238
		1239	# efficient way
		1240	return $self->{set_user}->count(undef, $setID);
		1241	}
		1242
		1243	sub listSetUsers {
		1244	my ($self, $setID) = @_;
		1245
		1246	carp "listSetUsers called in SCALAR context: use countSetUsers instead!\n"
		1247	unless wantarray;
		1248
		1249	croak "listSetUsers: requires 1 argument"
		1250	unless @_ == 2;
		1251	croak "listSetUsers: argument 1 must contain a set_id"
		1252	unless defined $setID;
		1253
225	return map { $_->[0] } # extract user_id	1254	return map { $_->[0] } # extract user_id
226	$self->{set_user}->list(undef, $setID);	1255	$self->{set_user}->list(undef, $setID);
227	}	1256	}
228		1257
229	sub listUserSets($$) {	1258	sub countUserSets {
230	my ($self, $userID) = @_;	1259	my ($self, $userID) = @_;
		1260
		1261	croak "countUserSets: requires 1 argument"
		1262	unless @_ == 2;
		1263	croak "countUserSets: argument 1 must contain a user_id"
		1264	unless defined $userID;
		1265
		1266	return $self->{set_user}->count($userID, undef);
		1267	}
		1268
		1269	sub listUserSets {
		1270	my ($self, $userID) = @_;
		1271
		1272	croak "listUserSets: requires 1 argument"
		1273	unless @_ == 2;
		1274	croak "listUserSets: argument 1 must contain a user_id"
		1275	unless defined $userID;
		1276
231	return map { $_->[1] } # extract set_id	1277	return map { $_->[1] } # extract set_id
232	$self->{set_user}->list($userID, undef);	1278	$self->{set_user}->list($userID, undef);
233	}	1279	}
234		1280
235	sub addUserSet($$) {	1281	sub addUserSet {
236	my ($self, $UserSet) = @_;	1282	my ($self, $UserSet) = @_;
		1283
		1284	croak "addUserSet: requires 1 argument"
		1285	unless @_ == 2;
		1286	croak "addUserSet: argument 1 must be of type ", $self->{set_user}->{record}
		1287	unless ref $UserSet eq $self->{set_user}->{record};
		1288
		1289	checkKeyfields($UserSet);
		1290
		1291	croak "addUserSet: user set exists (perhaps you meant to use putUserSet?)"
		1292	if $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
237	die "addUserSet failed: user ", $UserSet->user_id, " does not exist.\n"	1293	croak "addUserSet: user ", $UserSet->user_id, " not found"
238	unless $self->{user}->exists($UserSet->user_id);	1294	unless $self->{user}->exists($UserSet->user_id);
239	die "addUserSet failed: set ", $UserSet->set_id, " does not exist.\n"	1295	croak "addUserSet: set ", $UserSet->set_id, " not found"
240	unless $self->{set}->exists($UserSet->set_id);	1296	unless $self->{set}->exists($UserSet->set_id);
		1297
241	return $self->{set_user}->add($UserSet);	1298	return $self->{set_user}->add($UserSet);
242	}	1299	}
243		1300
244	sub getUserSet($$$) {	1301	sub getUserSet {
245	my ($self, $userID, $setID) = @_;	1302	my ($self, $userID, $setID) = @_;
		1303
		1304	croak "getUserSet: requires 2 arguments"
		1305	unless @_ == 3;
		1306	croak "getUserSet: argument 1 must contain a user_id"
		1307	unless defined $userID;
		1308	croak "getUserSet: argument 2 must contain a set_id"
		1309	unless defined $setID;
		1310
246	return $self->{set_user}->get($userID, $setID);	1311	#return $self->{set_user}->get($userID, $setID);
		1312	return ( $self->getUserSets([$userID, $setID]) )[0];
247	}	1313	}
248		1314
		1315	=item getUserSets(@userSetIDs)
		1316
		1317	Return a list of user set records associated with the record IDs given. If there
		1318	is no record associated with a given record ID, that element of the list will be
		1319	undefined. @userProblemIDs consists of references to arrays in which the first
		1320	element is the user_id and the second element is the set_id.
		1321
		1322	=cut
		1323
		1324	sub getUserSets {
		1325	my ($self, @userSetIDs) = @_;
		1326
		1327	#croak "getUserSets: requires 1 or more argument"
		1328	# unless @_ >= 2;
		1329	foreach my $i (0 .. $#userSetIDs) {
		1330	croak "getUserSets: element $i of argument list must contain a <user_id, set_id> pair"
		1331	unless defined $userSetIDs[$i]
		1332	and ref $userSetIDs[$i] eq "ARRAY"
		1333	and @{$userSetIDs[$i]} == 2
		1334	and defined $userSetIDs[$i]->[0]
		1335	and defined $userSetIDs[$i]->[1];
		1336	}
		1337
		1338	return $self->{set_user}->gets(@userSetIDs);
		1339	}
		1340
249	sub putUserSet($$) {	1341	sub putUserSet {
250	my ($self, $UserSet) = @_;	1342	my ($self, $UserSet) = @_;
		1343
		1344	croak "putUserSet: requires 1 argument"
		1345	unless @_ == 2;
		1346	croak "putUserSet: argument 1 must be of type ", $self->{set_user}->{record}
		1347	unless ref $UserSet eq $self->{set_user}->{record};
		1348
		1349	checkKeyfields($UserSet);
		1350
		1351	croak "putUserSet: user set not found (perhaps you meant to use addUserSet?)"
		1352	unless $self->{set_user}->exists($UserSet->user_id, $UserSet->set_id);
		1353	croak "putUserSet: user ", $UserSet->user_id, " not found"
		1354	unless $self->{user}->exists($UserSet->user_id);
		1355	croak "putUserSet: set ", $UserSet->set_id, " not found"
		1356	unless $self->{set}->exists($UserSet->set_id);
		1357
251	return $self->{set_user}->put($UserSet);	1358	return $self->{set_user}->put($UserSet);
252	}	1359	}
253		1360
254	sub deleteUserSet($$$) {	1361	sub deleteUserSet {
255	my ($self, $userID, $setID) = @_;	1362	my ($self, $userID, $setID) = @_;
		1363
		1364	croak "getUserSet: requires 2 arguments"
		1365	unless @_ == 3;
		1366	croak "getUserSet: argument 1 must contain a user_id"
		1367	unless defined $userID or caller eq __PACKAGE__;
		1368	croak "getUserSet: argument 2 must contain a set_id"
		1369	unless defined $userID or caller eq __PACKAGE__;
		1370
256	$self->deleteUserProblem($userID, $setID, $_)	1371	$self->deleteUserProblem($userID, $setID, undef);
257	foreach $self->listUserProblems($userID, $setID);
258	return $self->{set_user}->delete($userID, $setID);	1372	return $self->{set_user}->delete($userID, $setID);
259	}	1373	}
260		1374
		1375	=back
		1376
		1377	=cut
		1378
261	################################################################################	1379	################################################################################
262	# problem functions	1380	# problem functions
263	################################################################################	1381	################################################################################
264		1382
		1383	=head2 Global Problem Methods
		1384
		1385	FIXME: write this
		1386
		1387	=over
		1388
		1389	=cut
		1390
		1391	sub newGlobalProblem {
		1392	my ($self, @prototype) = @_;
		1393	return $self->{problem}->{record}->new(@prototype);
		1394	}
		1395
265	sub listGlobalProblems($$) {	1396	sub listGlobalProblems {
266	my ($self, $setID) = @_;	1397	my ($self, $setID) = @_;
		1398
		1399	croak "listGlobalProblems: requires 1 arguments"
		1400	unless @_ == 2;
		1401	croak "listGlobalProblems: argument 1 must contain a set_id"
		1402	unless defined $setID;
		1403
267	return map { $_->[1] }	1404	return map { $_->[1] }
268	grep { $_->[0] eq $setID }
269	$self->{problem}->list(undef, undef);	1405	$self->{problem}->list($setID, undef);
270	}	1406	}
271		1407
272	sub addGlobalProblem($$) {	1408	sub addGlobalProblem {
273	my ($self, $GlobalProblem) = @_;	1409	my ($self, $GlobalProblem) = @_;
		1410
		1411	croak "addGlobalProblem: requires 1 argument"
		1412	unless @_ == 2;
		1413	croak "addGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
		1414	unless ref $GlobalProblem eq $self->{problem}->{record};
		1415
		1416	checkKeyfields($GlobalProblem);
		1417
		1418	croak "addGlobalProblem: global problem exists (perhaps you meant to use putGlobalProblem?)"
		1419	if $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
274	die "addGlobalProblem failed: set ", $GlobalProblem->set_id, " does not exist.\n"	1420	croak "addGlobalProblem: set ", $GlobalProblem->set_id, " not found"
275	unless $self->{set}->exists($GlobalProblem->set_id);	1421	unless $self->{set}->exists($GlobalProblem->set_id);
		1422
276	return $self->{problem}->add($GlobalProblem);	1423	return $self->{problem}->add($GlobalProblem);
277	}	1424	}
278		1425
279	sub getGlobalProblem($$$) {	1426	sub getGlobalProblem {
280	my ($self, $setID, $problemID) = @_;	1427	my ($self, $setID, $problemID) = @_;
		1428
		1429	croak "getGlobalProblem: requires 2 arguments"
		1430	unless @_ == 3;
		1431	croak "getGlobalProblem: argument 1 must contain a set_id"
		1432	unless defined $setID;
		1433	croak "getGlobalProblem: argument 2 must contain a problem_id"
		1434	unless defined $problemID;
		1435
281	return $self->{problem}->get($setID, $problemID);	1436	return $self->{problem}->get($setID, $problemID);
282	}	1437	}
283		1438
		1439	=item getGlobalProblems(@problemIDs)
		1440
		1441	Return a list of global set records associated with the record IDs given. If
		1442	there is no record associated with a given record ID, that element of the list
		1443	will be undefined. @problemIDs consists of references to arrays in which the
		1444	first element is the set_id, and the second element is the problem_id.
		1445
		1446	=cut
		1447
		1448	sub getGlobalProblems {
		1449	my ($self, @problemIDs) = @_;
		1450
		1451	#croak "getGlobalProblems: requires 1 or more argument"
		1452	# unless @_ >= 2;
		1453	foreach my $i (0 .. $#problemIDs) {
		1454	croak "getUserSets: element $i of argument list must contain a <set_id, problem_id> pair"
		1455	unless defined $problemIDs[$i]
		1456	and ref $problemIDs[$i] eq "ARRAY"
		1457	and @{$problemIDs[$i]} == 2
		1458	and defined $problemIDs[$i]->[0]
		1459	and defined $problemIDs[$i]->[1];
		1460	}
		1461
		1462	return $self->{problem}->gets(@problemIDs);
		1463	}
		1464
		1465	=item getAllGlobalProblems($setID)
		1466
		1467	Returns a list of Problem objects representing all the problems in the given
		1468	global set. When using the WW1Hash/GlobalTableEmulator schemas, this is far
		1469	more efficient than using listGlobalProblems and getGlobalProblems.
		1470
		1471	=cut
		1472
		1473	sub getAllGlobalProblems {
		1474	my ($self, $setID) = @_;
		1475
		1476	croak "getAllGlobalProblems: requires 1 arguments"
		1477	unless @_ == 2;
		1478	croak "getAllGlobalProblems: argument 1 must contain a set_id"
		1479	unless defined $setID;
		1480
		1481	if ($self->{problem}->can("getAll")) {
		1482	return $self->{problem}->getAll($setID);
		1483	} else {
		1484	my @problemIDPairs = $self->{problem}->list($setID, undef);
		1485	return $self->{problem}->gets(@problemIDPairs);
		1486	}
		1487	}
		1488
284	sub putGlobalProblem($$) {	1489	sub putGlobalProblem {
285	my ($self, $GlobalProblem) = @_;	1490	my ($self, $GlobalProblem) = @_;
		1491
		1492	croak "putGlobalProblem: requires 1 argument"
		1493	unless @_ == 2;
		1494	croak "putGlobalProblem: argument 1 must be of type ", $self->{problem}->{record}
		1495	unless ref $GlobalProblem eq $self->{problem}->{record};
		1496
		1497	checkKeyfields($GlobalProblem);
		1498
		1499	croak "putGlobalProblem: global problem not found (perhaps you meant to use addGlobalProblem?)"
		1500	unless $self->{problem}->exists($GlobalProblem->set_id, $GlobalProblem->problem_id);
		1501	croak "putGlobalProblem: set ", $GlobalProblem->set_id, " not found"
		1502	unless $self->{set}->exists($GlobalProblem->set_id);
		1503
286	return $self->{problem}->put($GlobalProblem);	1504	return $self->{problem}->put($GlobalProblem);
287	}	1505	}
288		1506
289	sub deleteGlobalProblem($$$) {	1507	sub deleteGlobalProblem {
290	my ($self, $setID, $problemID) = @_;	1508	my ($self, $setID, $problemID) = @_;
		1509
		1510	croak "deleteGlobalProblem: requires 2 arguments"
		1511	unless @_ == 3;
		1512	croak "deleteGlobalProblem: argument 1 must contain a set_id"
		1513	unless defined $setID or caller eq __PACKAGE__;
		1514	croak "deleteGlobalProblem: argument 2 must contain a problem_id"
		1515	unless defined $problemID or caller eq __PACKAGE__;
		1516
291	$self->deleteUserProblem($_, $setID, $problemID)	1517	$self->deleteUserProblem(undef, $setID, $problemID);
292	foreach $self->listUsers();
293	return $self->{problem}->delete($setID, $problemID);	1518	return $self->{problem}->delete($setID, $problemID);
294	}	1519	}
295		1520
		1521	=back
		1522
		1523	=cut
		1524
296	################################################################################	1525	################################################################################
297	# problem_user functions	1526	# problem_user functions
298	################################################################################	1527	################################################################################
299		1528
		1529	=head2 User-Specific Problem Methods
		1530
		1531	FIXME: write this
		1532
		1533	=over
		1534
		1535	=cut
		1536
		1537	sub newUserProblem {
		1538	my ($self, @prototype) = @_;
		1539	return $self->{problem_user}->{record}->new(@prototype);
		1540	}
		1541
300	sub listProblemUsers($$$) {	1542	sub countProblemUsers {
301	my ($self, $setID, $problemID) = @_;	1543	my ($self, $setID, $problemID) = @_;
		1544
		1545	croak "countProblemUsers: requires 2 arguments"
		1546	unless @_ == 3;
		1547	croak "countProblemUsers: argument 1 must contain a set_id"
		1548	unless defined $setID;
		1549	croak "countProblemUsers: argument 2 must contain a problem_id"
		1550	unless defined $problemID;
		1551
		1552	# the slow way
		1553	#return scalar $self->{problem_user}->list(undef, $setID, $problemID);
		1554
		1555	# the fast way
		1556	return $self->{problem_user}->count(undef, $setID, $problemID);
		1557	}
		1558
		1559	sub listProblemUsers {
		1560	my ($self, $setID, $problemID) = @_;
		1561
		1562	carp "listProblemUsers called in SCALAR context: use countProblemUsers instead!\n"
		1563	unless wantarray;
		1564
		1565	croak "listProblemUsers: requires 2 arguments"
		1566	unless @_ == 3;
		1567	croak "listProblemUsers: argument 1 must contain a set_id"
		1568	unless defined $setID;
		1569	croak "listProblemUsers: argument 2 must contain a problem_id"
		1570	unless defined $problemID;
		1571
302	return map { $_->[0] } # extract user_id	1572	return map { $_->[0] } # extract user_id
303	$self->{problem_user}->list(undef, $setID, $problemID);	1573	$self->{problem_user}->list(undef, $setID, $problemID);
304	}	1574	}
305		1575
306	sub listUserProblems($$$) {	1576	sub listUserProblems {
307	my ($self, $userID, $setID) = @_;	1577	my ($self, $userID, $setID) = @_;
		1578
		1579	croak "listUserProblems: requires 2 arguments"
		1580	unless @_ == 3;
		1581	croak "listUserProblems: argument 1 must contain a user_id"
		1582	unless defined $userID;
		1583	croak "listUserProblems: argument 2 must contain a set_id"
		1584	unless defined $setID;
		1585
308	return map { $_->[2] } # extract problem_id	1586	return map { $_->[2] } # extract problem_id
309	$self->{problem_user}->list($userID, $setID, undef);	1587	$self->{problem_user}->list($userID, $setID, undef);
310	}	1588	}
311		1589
312	sub addUserProblem($$) {	1590	sub addUserProblem {
313	my ($self, $UserProblem) = @_;	1591	my ($self, $UserProblem) = @_;
314	die "addUserProblem failed: user set ", $UserProblem->set_id, " does not exist.\n"	1592
		1593	croak "addUserProblem: requires 1 argument"
		1594	unless @_ == 2;
		1595	croak "addUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
		1596	unless ref $UserProblem eq $self->{problem_user}->{record};
		1597
		1598	checkKeyfields($UserProblem);
		1599
		1600	croak "addUserProblem: user problem exists (perhaps you meant to use putUserProblem?)"
		1601	if $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
		1602	croak "addUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
315	unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);	1603	unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
316	die "addUserProblem failed: problem ", $UserProblem->problem_id, " does not exist.\n"	1604	croak "addUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
317	unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);	1605	unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
		1606
318	return $self->{problem_user}->add($UserProblem);	1607	return $self->{problem_user}->add($UserProblem);
319	}	1608	}
320		1609
321	sub getUserProblem($$$$) {	1610	sub getUserProblem {
322	my ($self, $userID, $setID, $problemID) = @_;	1611	my ($self, $userID, $setID, $problemID) = @_;
		1612
		1613	croak "getUserProblem: requires 3 arguments"
		1614	unless @_ == 4;
		1615	croak "getUserProblem: argument 1 must contain a user_id"
		1616	unless defined $userID;
		1617	croak "getUserProblem: argument 2 must contain a set_id"
		1618	unless defined $setID;
		1619	croak "getUserProblem: argument 3 must contain a problem_id"
		1620	unless defined $problemID;
		1621
		1622	return ( $self->getUserProblems([$userID, $setID, $problemID]) )[0];
		1623	}
		1624
		1625	=item getUserProblems(@userProblemIDs)
		1626
		1627	Return a list of user set records associated with the user IDs given. If there
		1628	is no record associated with a given user ID, that element of the list will be
		1629	undefined. @userProblemIDs consists of references to arrays in which the first
		1630	element is the user_id, the second element is the set_id, and the third element
		1631	is the problem_id.
		1632
		1633	=cut
		1634
		1635	sub getUserProblems {
		1636	my ($self, @userProblemIDs) = @_;
		1637
		1638	#croak "getUserProblems: requires 1 or more argument"
		1639	# unless @_ >= 2;
		1640	foreach my $i (0 .. $#userProblemIDs) {
		1641	croak "getUserProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple"
		1642	unless defined $userProblemIDs[$i]
		1643	and ref $userProblemIDs[$i] eq "ARRAY"
		1644	and @{$userProblemIDs[$i]} == 3
		1645	and defined $userProblemIDs[$i]->[0]
		1646	and defined $userProblemIDs[$i]->[1]
		1647	and defined $userProblemIDs[$i]->[2];
		1648	}
		1649
		1650	return $self->{problem_user}->gets(@userProblemIDs);
		1651	}
		1652
		1653	=item getAllUserProblems($userID, $setID)
		1654
		1655	Returns a list of UserProblem objects representing all the problems in the
		1656	given set. When using the WW1Hash/GlobalTableEmulator schemas, this is far
		1657	more efficient than using listUserProblems and getUserProblems.
		1658
		1659	=cut
		1660
		1661	sub getAllUserProblems {
		1662	my ($self, $userID, $setID) = @_;
		1663
		1664	croak "getAllUserProblems: requires 2 arguments"
		1665	unless @_ == 3;
		1666	croak "getAllUserProblems: argument 1 must contain a user_id"
		1667	unless defined $userID;
		1668	croak "getAllUserProblems: argument 2 must contain a set_id"
		1669	unless defined $setID;
		1670
		1671	if ($self->{problem_user}->can("getAll")) {
323	return $self->{problem_user}->get($userID, $setID, $problemID);	1672	return $self->{problem_user}->getAll($userID, $setID);
		1673	} else {
		1674	my @problemIDTriples = $self->{problem_user}->list($userID, $setID, undef);
		1675	return $self->{problem_user}->gets(@problemIDTriples);
		1676	}
324	}	1677	}
325		1678
326	sub putUserProblem($$) {	1679	sub putUserProblem {
327	my ($self, $UserProblem) = @_;	1680	my ($self, $UserProblem) = @_;
		1681
		1682	croak "putUserProblem: requires 1 argument"
		1683	unless @_ == 2;
		1684	croak "putUserProblem: argument 1 must be of type ", $self->{problem_user}->{record}
		1685	unless ref $UserProblem eq $self->{problem_user}->{record};
		1686
		1687	checkKeyfields($UserProblem);
		1688
		1689	croak "putUserProblem: user set ", $UserProblem->set_id, " for user ", $UserProblem->user_id, " not found"
		1690	unless $self->{set_user}->exists($UserProblem->user_id, $UserProblem->set_id);
		1691	croak "putUserProblem: user problem not found (perhaps you meant to use addUserProblem?)"
		1692	unless $self->{problem_user}->exists($UserProblem->user_id, $UserProblem->set_id, $UserProblem->problem_id);
		1693	croak "putUserProblem: problem ", $UserProblem->problem_id, " in set ", $UserProblem->set_id, " not found"
		1694	unless $self->{problem}->exists($UserProblem->set_id, $UserProblem->problem_id);
		1695
328	return $self->{problem_user}->put($UserProblem);	1696	return $self->{problem_user}->put($UserProblem);
329	}	1697	}
330		1698
331	sub deleteUserProblem($$$$) {	1699	sub deleteUserProblem {
332	my ($self, $userID, $setID, $problemID) = @_;	1700	my ($self, $userID, $setID, $problemID) = @_;
		1701
		1702	croak "getUserProblem: requires 3 arguments"
		1703	unless @_ == 4;
		1704	croak "getUserProblem: argument 1 must contain a user_id"
		1705	unless defined $userID or caller eq __PACKAGE__;
		1706	croak "getUserProblem: argument 2 must contain a set_id"
		1707	unless defined $setID or caller eq __PACKAGE__;
		1708	croak "getUserProblem: argument 3 must contain a problem_id"
		1709	unless defined $problemID or caller eq __PACKAGE__;
		1710
333	return $self->{problem_user}->delete($userID, $setID, $problemID);	1711	return $self->{problem_user}->delete($userID, $setID, $problemID);
334	}	1712	}
335		1713
		1714	=back
		1715
		1716	=cut
		1717
336	################################################################################	1718	################################################################################
337	# set+set_user functions	1719	# set+set_user functions
338	################################################################################	1720	################################################################################
339		1721
		1722	=head2 Set Merging Methods
		1723
		1724	These functions combine a global set and a user set to create a merged set,
		1725	which is returned. Any field that is not defined in the user set is taken from
		1726	the global set. Merged sets have the same type as user sets.
		1727
		1728	=over
		1729
		1730	=cut
		1731
340	sub getGlobalUserSet($$$) {	1732	sub getGlobalUserSet {
		1733	carp "getGlobalUserSet: this method is deprecated -- use getMergedSet instead";
		1734	return shift->getMergedSet(@_);
		1735	}
		1736
		1737	=item getMergedSet($userID, $setID)
		1738
		1739	Returns a merged set record associated with the record IDs given. If there is no
		1740	record associated with a given record ID, the undefined value is returned.
		1741
		1742	=cut
		1743
		1744	sub getMergedSet {
341	my ($self, $userID, $setID) = @_;	1745	my ($self, $userID, $setID) = @_;
		1746
		1747	croak "getMergedSet: requires 2 arguments"
		1748	unless @_ == 3;
		1749	croak "getMergedSet: argument 1 must contain a user_id"
		1750	unless defined $userID;
		1751	croak "getMergedSet: argument 2 must contain a set_id"
		1752	unless defined $setID;
		1753
		1754	return ( $self->getMergedSets([$userID, $setID]) )[0];
		1755	}
		1756
		1757	=item getMegedSets(@userSetIDs)
		1758
		1759	Return a list of merged set records associated with the record IDs given. If
		1760	there is no record associated with a given record ID, that element of the list
		1761	will be undefined. @userSetIDs consists of references to arrays in which the
		1762	first element is the user_id and the second element is the set_id.
		1763
		1764	=cut
		1765
		1766	sub getMergedSets {
		1767	my ($self, @userSetIDs) = @_;
		1768
		1769	#croak "getMergedSets: requires 1 or more argument"
		1770	# unless @_ >= 2;
		1771	foreach my $i (0 .. $#userSetIDs) {
		1772	croak "getMergedSets: element $i of argument list must contain a <user_id, set_id> pair"
		1773	unless defined $userSetIDs[$i]
		1774	and ref $userSetIDs[$i] eq "ARRAY"
		1775	and @{$userSetIDs[$i]} == 2
		1776	and defined $userSetIDs[$i]->[0]
		1777	and defined $userSetIDs[$i]->[1];
		1778	}
		1779
		1780	# a horrible, terrible hack ;)
		1781	if (ref $self->{set_user} eq "WeBWorK::DB::Schema::WW1Hash"
		1782	and ref $self->{set} eq "WeBWorK::DB::Schema::GlobalTableEmulator") {
		1783	#warn __PACKAGE__.": using a terrible hack.\n";
		1784	$WeBWorK::timer->continue("DB: getsNoFilter start") if defined($WeBWorK::timer);
		1785	my @MergedSets = $self->{set_user}->getsNoFilter(@userSetIDs);
		1786	$WeBWorK::timer->continue("DB: getsNoFilter end") if defined($WeBWorK::timer);
		1787	return @MergedSets;
		1788	}
		1789
		1790	$WeBWorK::timer->continue("DB: getUserSets start") if defined($WeBWorK::timer);
342	my $UserSet = $self->getUserSet($userID, $setID);	1791	my @UserSets = $self->getUserSets(@userSetIDs); # checked
343	return unless $UserSet;	1792
		1793	$WeBWorK::timer->continue("DB: pull out set IDs start") if defined($WeBWorK::timer);
		1794	my @globalSetIDs = map { $_->[1] } @userSetIDs;
		1795	$WeBWorK::timer->continue("DB: getGlobalSets start") if defined($WeBWorK::timer);
344	my $GlobalSet = $self->getGlobalSet($setID);	1796	my @GlobalSets = $self->getGlobalSets(@globalSetIDs); # checked
345	if ($GlobalSet) {	1797
346	foreach ($UserSet->FIELDS()) {	1798	$WeBWorK::timer->continue("DB: calc common fields start") if defined($WeBWorK::timer);
347	next unless $GlobalSet->can($_);	1799	my %globalSetFields = map { $_ => 1 } $self->newGlobalSet->FIELDS;
348	next if $UserSet->$_();	1800	my @commonFields = grep { exists $globalSetFields{$_} } $self->newUserSet->FIELDS;
		1801
		1802	$WeBWorK::timer->continue("DB: merge start") if defined($WeBWorK::timer);
		1803	for (my $i = 0; $i < @UserSets; $i++) {
		1804	my $UserSet = $UserSets[$i];
		1805	my $GlobalSet = $GlobalSets[$i];
		1806	next unless defined $UserSet and defined $GlobalSet;
		1807	foreach my $field (@commonFields) {
		1808	#next if defined $UserSet->$field;
		1809	# ok, now we're testing for emptiness as well as definedness.
		1810	next if defined $UserSet->$field and $UserSet->$field ne "";
349	$UserSet->$_($GlobalSet->$_());	1811	$UserSet->$field($GlobalSet->$field);
350	}	1812	}
351	}	1813	}
		1814	$WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
		1815
352	return $UserSet;	1816	return @UserSets;
353	}	1817	}
		1818
		1819	=back
		1820
		1821	=cut
354		1822
355	################################################################################	1823	################################################################################
356	# problem+problem_user functions	1824	# problem+problem_user functions
357	################################################################################	1825	################################################################################
358		1826
		1827	=head2 Problem Merging Methods
		1828
		1829	These functions combine a global problem and a user problem to create a merged
		1830	problem, which is returned. Any field that is not defined in the user problem is
		1831	taken from the global problem. Merged problems have the same type as user
		1832	problems.
		1833
		1834	=over
		1835
		1836	=cut
		1837
359	sub getGlobalUserProblem($$$$) {	1838	sub getGlobalUserProblem {
		1839	carp "getGlobalUserProblem: this method is deprecated -- use getMergedProblem instead";
		1840	return shift->getMergedProblem(@_);
		1841	}
		1842
		1843	=item getMergedProblem($userID, $setID, $problemID)
		1844
		1845	Returns a merged problem record associated with the record IDs given. If there
		1846	is no record associated with a given record ID, the undefined value is returned.
		1847
		1848	=cut
		1849
		1850	sub getMergedProblem {
360	my ($self, $userID, $setID, $problemID) = @_;	1851	my ($self, $userID, $setID, $problemID) = @_;
		1852
		1853	croak "getGlobalUserSet: requires 3 arguments"
		1854	unless @_ == 4;
		1855	croak "getGlobalUserSet: argument 1 must contain a user_id"
		1856	unless defined $userID;
		1857	croak "getGlobalUserSet: argument 2 must contain a set_id"
		1858	unless defined $setID;
		1859	croak "getGlobalUserSet: argument 3 must contain a problem_id"
		1860	unless defined $problemID;
		1861
		1862	return ( $self->getMergedProblems([$userID, $setID, $problemID]) )[0];
		1863	}
		1864
		1865	=item getMergedProblems(@userProblemIDs)
		1866
		1867	Return a list of merged problem records associated with the record IDs given. If
		1868	there is no record associated with a given record ID, that element of the list
		1869	will be undefined. @userProblemIDs consists of references to arrays in which the
		1870	first element is the user_id, the second element is the set_id, and the third
		1871	element is the problem_id.
		1872
		1873	=cut
		1874
		1875	sub getMergedProblems {
		1876	my ($self, @userProblemIDs) = @_;
		1877
		1878	#croak "getMergedProblems: requires 1 or more argument"
		1879	# unless @_ >= 2;
		1880	foreach my $i (0 .. $#userProblemIDs) {
		1881	croak "getMergedProblems: element $i of argument list must contain a <user_id, set_id, problem_id> triple"
		1882	unless defined $userProblemIDs[$i]
		1883	and ref $userProblemIDs[$i] eq "ARRAY"
		1884	and @{$userProblemIDs[$i]} == 3
		1885	and defined $userProblemIDs[$i]->[0]
		1886	and defined $userProblemIDs[$i]->[1]
		1887	and defined $userProblemIDs[$i]->[2];
		1888	}
		1889
		1890	$WeBWorK::timer->continue("DB: getUserProblems start") if defined($WeBWorK::timer);
361	my $UserProblem = $self->getUserProblem($userID, $setID, $problemID);	1891	my @UserProblems = $self->getUserProblems(@userProblemIDs); # checked
362	return unless $UserProblem;	1892
		1893	$WeBWorK::timer->continue("DB: pull out set/problem IDs start") if defined($WeBWorK::timer);
		1894	my @globalProblemIDs = map { [ $_->[1], $_->[2] ] } @userProblemIDs;
		1895	$WeBWorK::timer->continue("DB: getGlobalProblems start") if defined($WeBWorK::timer);
363	my $GlobalProblem = $self->getGlobalProblem($setID, $problemID);	1896	my @GlobalProblems = $self->getGlobalProblems(@globalProblemIDs); # checked
364	if ($GlobalProblem) {	1897
365	foreach ($UserProblem->FIELDS()) {	1898	$WeBWorK::timer->continue("DB: calc common fields start") if defined($WeBWorK::timer);
366	next unless $GlobalProblem->can($_);	1899	my %globalProblemFields = map { $_ => 1 } $self->newGlobalProblem->FIELDS;
		1900	my @commonFields = grep { exists $globalProblemFields{$_} } $self->newUserProblem->FIELDS;
		1901
		1902	$WeBWorK::timer->continue("DB: merge start") if defined($WeBWorK::timer);
		1903	for (my $i = 0; $i < @UserProblems; $i++) {
		1904	my $UserProblem = $UserProblems[$i];
		1905	my $GlobalProblem = $GlobalProblems[$i];
		1906	next unless defined $UserProblem and defined $GlobalProblem;
		1907	foreach my $field (@commonFields) {
		1908	# FIXME: WW1Hash upgrades undefined fileds to "" when creating record objects
		1909	# Shouldn't we be testing for emptiness rather than definedness?
		1910	# I think the spec says that if a field is EMPTY the global value is used.
367	next if $UserProblem->$_();	1911	#next if defined $UserProblem->$field;
		1912	# ok, now we're testing for emptiness as well as definedness.
		1913	next if defined $UserProblem->$field and $UserProblem->$field ne "";
368	$UserProblem->$_($GlobalProblem->$_());	1914	$UserProblem->$field($GlobalProblem->$field);
369	}	1915	}
370	}	1916	}
		1917	$WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer);
		1918
371	return $UserProblem;	1919	return @UserProblems;
372	}	1920	}
		1921
		1922	=back
		1923
		1924	=cut
373		1925
374	################################################################################	1926	################################################################################
375	# debugging	1927	# debugging
376	################################################################################	1928	################################################################################
377		1929
378	sub dumpDB($$) {	1930	#sub dumpDB($$) {
379	my ($self, $table) = @_;	1931	# my ($self, $table) = @_;
380	return $self->{$table}->dumpDB();	1932	# return $self->{$table}->dumpDB();
		1933	#}
		1934
		1935	################################################################################
		1936	# utilities
		1937	################################################################################
		1938
		1939	sub checkKeyfields($) {
		1940	my ($Record) = @_;
		1941	foreach my $keyfield ($Record->KEYFIELDS) {
		1942	my $value = $Record->$keyfield;
		1943	croak "checkKeyfields: $keyfield is empty"
		1944	unless defined $value and $value ne "";
		1945
		1946	if ($keyfield eq "problem_id") {
		1947	croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [0-9])"
		1948	unless $value =~ m/^\d*$/;
		1949	} else {
		1950	croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [A-Za-z0-9_])"
		1951	unless $value =~ m/^[\w-]*$/;
		1952	}
		1953	}
381	}	1954	}
		1955
		1956	=head1 AUTHOR
		1957
		1958	Written by Sam Hathaway, sh002i (at) math.rochester.edu.
		1959
		1960	=cut
382		1961
383	1;	1962	1;

 Legend:



Removed from v.923
 


changed lines


 
Added in v.2348
 Legend:



Removed from v.923
 


changed lines


 
Added in v.2348
-Removed from v.923
+Added in v.2348

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9