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

View of /trunk/webwork-modperl/lib/WeBWorK/DB/Schema/GlobalTableEmulator.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1167 - (download) (as text) (annotate)
Fri Jun 13 23:35:54 2003 UTC (9 years, 11 months ago) by sh002i
File size: 6679 byte(s)
Several changes to the DB system:

Made all schemas subclasses of WeBWorK::DB::Schema, factored common
constructor code out into Schema.pm. Made all drivers subclasses of
WeBWorK::DB::Schema, factored common constructor code out into
Driver.pm.

Removed superfluous style() and tables() functions from schemas and
drivers. (You can treat the constants in which these are defined as
functions, and call them like $object->STYLE or $object->STYLE().)

WeBWorK::DB now tries to build all tables defined in %dbLayout, instead
of using its own internal list. (TODO: add warnings if known tables are
not built or unknown tables are built.)

Made the error messages given during DB instantiation a little more
intelligent.

Changed the behavior of the exists() and delete() schema methods in all
schemas (and updated the docs) s.t. not all elements of @keyparts have
to be defined.

Changed WeBWorK::DB to allow undefined values to be passed instead of
IDs in delete* method calls, but only if the call was made from
WeBWorK::DB itself (to protect you from accidentally passing an
undefined value and clobbering your whole database).

Changed delete functions to be more efficient. For example,
deleteGlobalSet no longer has to say:

	$self->deleteUserSet($_, $setID)
		foreach $self->listSetUsers($setID);
	$self->deleteGlobalProblem($setID, $_)
		foreach $self->listGlobalProblems($setID);

Instead it says:

	$self->deleteUserSet(undef, $setID);
	$self->deleteGlobalProblem($setID, undef);

This is somewhat more efficient with hash-style schemas, and MUCH more
efficient with the SQL schema.

As usual, be wary of lingering bugs. w00t!
-sam

    1 ################################################################################
    2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
    3 # $Id$
    4 ################################################################################
    5 
    6 package WeBWorK::DB::Schema::GlobalTableEmulator;
    7 use base qw(WeBWorK::DB::Schema);
    8 
    9 =head1 NAME
   10 
   11 WeBWorK::DB::Schema::GlobalTableEmulator - emulate the global 'set' and
   12 'problem' tables using access to the 'set_user' and 'problem_user' tables.
   13 
   14 =cut
   15 
   16 use strict;
   17 use warnings;
   18 use Data::Dumper;
   19 use WeBWorK::DB::Utils qw(global2user user2global initializeUserProblem findDefaults);
   20 
   21 use constant TABLES => qw(set problem);
   22 use constant STYLE  => "null";
   23 
   24 ################################################################################
   25 # constructor
   26 ################################################################################
   27 
   28 sub new($$$) {
   29   my ($proto, $db, $driver, $table, $record, $params) = @_;
   30 
   31   die "parameter globalUserID not found"
   32     unless exists $params->{globalUserID};
   33 
   34   my $self = $proto->SUPER::new($db, $driver, $table, $record, $params);
   35 
   36   return $self;
   37 }
   38 
   39 ################################################################################
   40 # table access functions
   41 ################################################################################
   42 
   43 sub list($@) {
   44   my ($self, @keyparts) = @_;
   45 
   46   my $db = $self->{db};
   47   my $table = $self->{table};
   48   my $userSchema = $db->{"${table}_user"};
   49   my $globalUserID = $self->{params}->{globalUserID};
   50 
   51   my @userRecordIDs = $userSchema->list($globalUserID, @keyparts);
   52   my @recordIDs;
   53   foreach my $userRecordID (@userRecordIDs) {
   54     shift @$userRecordID; # take off the userID
   55     push @recordIDs, $userRecordID;
   56   }
   57 
   58   return @recordIDs;
   59 }
   60 
   61 sub exists($@) {
   62   my ($self, @keyparts) = @_;
   63 
   64   my $db = $self->{db};
   65   my $table = $self->{table};
   66   my $userSchema = $db->{"${table}_user"};
   67   my $globalUserID = $self->{params}->{globalUserID};
   68 
   69   return $userSchema->exists($globalUserID, @keyparts);
   70 }
   71 
   72 sub add($$) {
   73   my ($self, $Record) = @_;
   74 
   75   my $db = $self->{db};
   76   my $table = $self->{table};
   77   my $userSchema = $db->{"${table}_user"};
   78   my $globalUserID = $self->{params}->{globalUserID};
   79 
   80   # make sure record doesn't already exist
   81   my $setID = $Record->set_id();
   82   if ($self->{table} eq "set") {
   83     die "($setID): Set exists.\n"
   84       if $self->exists($setID);
   85   } elsif ($self->{table} eq "problem") {
   86     my $problemID = $Record->problem_id();
   87     die "($setID, $problemID): Problem exists.\n"
   88       if $self->exists($setID, $problemID);
   89   }
   90 
   91   # convert global record to a user record for user $globalUserID
   92   my $UserRecord = global2user($userSchema->{record}, $Record);
   93   $UserRecord->user_id($globalUserID);
   94 
   95   # if this is the problem table, set the user-specific fields of the user
   96   # problem to sane defaults (and generate a problem seed). this allows
   97   # the user $globalUserID to use this problem as a user problem.
   98   if ($table eq "problem") {
   99     initializeUserProblem($UserRecord);
  100   }
  101 
  102   # add the record to the database
  103   return $userSchema->add($UserRecord);
  104 }
  105 
  106 sub get($@) {
  107   my ($self, @keyparts) = @_;
  108 
  109   my $db = $self->{db};
  110   my $table = $self->{table};
  111   my $userSchema = $db->{"${table}_user"};
  112   my $globalUserID = $self->{params}->{globalUserID};
  113 
  114   my $UserRecord = $userSchema->get($globalUserID, @keyparts);
  115   return unless $UserRecord; # maybe it didn't exist?
  116   return user2global($self->{record}, $UserRecord);
  117 }
  118 
  119 sub put($$) {
  120   my ($self, $Record) = @_;
  121 
  122   my $db = $self->{db};
  123   my $table = $self->{table};
  124   my $userSchema = $db->{"${table}_user"};
  125   my $classlistSchema = $db->{"user"}; # oh god.
  126   my $globalUserID = $self->{params}->{globalUserID};
  127 
  128   my @keyparts = map { $Record->$_() } $Record->KEYFIELDS();
  129 
  130   # retrieve the current global values for this record
  131   my $CurrentUserRecord = $userSchema->get($globalUserID, @keyparts);
  132   my $CurrentGlobalRecord = user2global($self->{record}, $CurrentUserRecord);
  133 
  134   # convert new global record to a user record for user $globalUserID
  135   my $NewUserRecord = global2user($userSchema->{record}, $Record);
  136   $NewUserRecord->user_id($globalUserID);
  137 
  138   # if this is the problem table, copy the user-specific fields of the
  139   # user problem from the old global record. this allows the user
  140   # $globalUserID to use this problem as a user problem.
  141   if ($table eq "problem") {
  142     foreach my $field (qw(status attempted num_correct num_incorrect problem_seed)) {
  143       my $currentValue = $CurrentUserRecord->$field;
  144       $NewUserRecord->$field($currentValue);
  145     }
  146   }
  147   # *** WARNING: here is a place where field names are referenced directly
  148 
  149   # store user record containing new global values
  150   my $result = $userSchema->put($NewUserRecord);
  151 
  152   # distribute new global values to each user
  153   # don't overwrite the user record that's storing global values
  154   my @userIDs = grep { $_ ne $globalUserID } $classlistSchema->list(undef);
  155   $self->distGlobalValues($CurrentGlobalRecord, $Record, @userIDs);
  156 
  157   return $result;
  158 }
  159 
  160 sub delete($@) {
  161   my ($self, @keyparts) = @_;
  162 
  163   my $db = $self->{db};
  164   my $table = $self->{table};
  165   my $userSchema = $db->{"${table}_user"};
  166   my $globalUserID = $self->{params}->{globalUserID};
  167 
  168   # we can assume that DB has already deleted all the user-specific
  169   # records it could find. we can just go ahead and delete the one
  170   # that's being used as a global record (if it exists).
  171 
  172   return $userSchema->delete($globalUserID, @keyparts);
  173 }
  174 
  175 ################################################################################
  176 # function to distribute new global values to each user-specific record
  177 ################################################################################
  178 
  179 sub distGlobalValues($$$@) {
  180   my ($self, $OldGlobalRecord, $NewGlobalRecord, @userIDs) = @_;
  181 
  182   my $db = $self->{db};
  183   my $table = $self->{table};
  184   my $userSchema = $db->{"${table}_user"};
  185 
  186   my @keyparts = map { $NewGlobalRecord->$_() } $NewGlobalRecord->KEYFIELDS();
  187 
  188   # figure out which fields (if any) were changed
  189   my @changedFields;
  190   foreach my $field ($OldGlobalRecord->FIELDS()) {
  191     if ($OldGlobalRecord->$field() ne $NewGlobalRecord->$field()) {
  192       push @changedFields, $field;
  193     }
  194   }
  195 
  196   # if no fields were changed, we're done
  197   return 0 unless @changedFields;
  198 
  199   # impose the new values for each user
  200   my $anyChanged = 0;
  201   foreach my $userID (@userIDs) {
  202     my $UserRecord = $userSchema->get($userID, @keyparts);
  203     next unless defined $UserRecord;
  204     my $changed = 0;
  205     foreach my $field (@changedFields) {
  206       if ($UserRecord->$field() eq $OldGlobalRecord->$field()) {
  207         $changed = 1;
  208         $UserRecord->$field($NewGlobalRecord->$field());
  209       }
  210     }
  211     if ($changed) {
  212       $anyChanged = 1;
  213       $userSchema->put($UserRecord);
  214     }
  215   }
  216 
  217   return $anyChanged;
  218 }
  219 
  220 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9