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

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

 Legend:



Removed from v.923
 


changed lines


 
Added in v.3019
 Legend:



Removed from v.923
 


changed lines


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

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9