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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 476 - (download) (as text) (annotate)
Tue Aug 20 01:07:18 2002 UTC (10 years, 9 months ago) by sh002i
File size: 17683 byte(s)
fixed problem with deciding when to generate images in math2img mode
finished adding template escapes to ProblemSets, ProblemSet, and Problem

fixed a problem where modules were removed from the courseEnv while
being loaded (whups.)
-sam

    1 ################################################################################
    2 # WeBWorK mod_perl (c) 1995-2002 WeBWorK Team, Univeristy of Rochester
    3 # $Id$
    4 ################################################################################
    5 
    6 package WeBWorK::DB::WW;
    7 
    8 =head1 NAME
    9 
   10 WeBWorK::DB::WW - interface with the WeBWorK problem set database.
   11 
   12 =cut
   13 
   14 use strict;
   15 use warnings;
   16 use Carp;
   17 use WeBWorK::Problem;
   18 use WeBWorK::Set;
   19 use WeBWorK::Utils qw(dbDecode dbEncode);
   20 
   21 use constant LOGIN_PREFIX => "login<>";
   22 use constant SET_PREFIX => "set<>";
   23 use constant MAX_PSVN_GENERATION_ATTEMPTS => 200;
   24 
   25 # there should be a `use' line for each database type
   26 use WeBWorK::DB::GDBM;
   27 
   28 # new($invocant, $courseEnv)
   29 # $invocant - implicitly set by caller
   30 # $courseEnv - an instance of CourseEnvironment
   31 sub new($$) {
   32   my $invocant = shift;
   33   my $class = ref($invocant) || $invocant;
   34   my $courseEnv = shift;
   35   my $dbModule = fullyQualifiedPackageName($courseEnv->{dbInfo}->{wwdb_type});
   36   my $self = {
   37     webwork_file => $courseEnv->{dbInfo}->{wwdb_file},
   38     psvn_digits => $courseEnv->{dbInfo}->{psvn_digits},
   39   };
   40   $self->{webwork_db} = $dbModule->new($self->{webwork_file});
   41   bless $self, $class;
   42   return $self;
   43 }
   44 
   45 sub fullyQualifiedPackageName($) {
   46   my $n = shift;
   47   my $package = __PACKAGE__;
   48   $package =~ s/([^:]*)$/$n/;
   49   return $package;
   50 }
   51 
   52 # -----
   53 
   54 #sub fixMyMistakes($) { # ***
   55 # my $self = shift;
   56 # my $userID = "practice1";
   57 # my $setID = "dummy";
   58 # my $PSVN = 95540;
   59 # $self->{webwork_db}->connect("rw");
   60 # delete $self->{webwork_db}->hashRef->{$PSVN};
   61 # my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID};
   62 # my $usersForSet = $self->{webwork_db}->hashRef->{SET_PREFIX.$setID};
   63 # my %sets = dbDecode($setsForUser);  # sets built for user $userID
   64 # my %users = dbDecode($usersForSet); # users for which set $setID has been built
   65 # delete $sets{$setID};
   66 # delete $users{$userID};
   67 # $setsForUser = dbEncode(%sets);
   68 # $usersForSet = dbEncode(%users);
   69 # $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID} = $setsForUser;
   70 # $self->{webwork_db}->hashRef->{SET_PREFIX.$setID} = $usersForSet;
   71 # $self->{webwork_db}->disconnect;
   72 #}
   73 
   74 # -----
   75 
   76 # getSets($userID) - returns a list of SetIDs in the current database for the
   77 #                    specified user
   78 # $userID - the user ID (a.k.a. login name) of the user to get sets for
   79 sub getSets($$) {
   80   my $self = shift;
   81   my $userID = shift;
   82   return unless $self->{webwork_db}->connect("ro");
   83   my $result = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID};
   84   $self->{webwork_db}->disconnect;
   85   return unless defined $result;
   86   my %record = dbDecode($result);
   87   return keys %record;
   88 }
   89 
   90 # -----
   91 
   92 # getSet($userID, $setID) - returns a WeBWorK::Set object containing data
   93 #                           from the specified set.
   94 # $userID - the user ID (a.k.a. login name) of the set to retrieve
   95 # $setID - the ID (a.k.a. name) of the set to retrieve
   96 sub getSet($$$) {
   97   my $self = shift;
   98   my $userID = shift;
   99   my $setID = shift;
  100   my $PSVN = $self->getPSVN($userID, $setID);
  101   return unless $PSVN;
  102   return hash2set($self->fetchRecord($PSVN));
  103 }
  104 
  105 # setSet($set) - if a set with the same ID for the specified user
  106 #                exists, it is replaced. If not, a new set is added.
  107 #                returns true on success, undef on failure.
  108 # $set - a WeBWorK::Set object containing the set data
  109 sub setSet($$) {
  110   my $self = shift;
  111   my $set = shift;
  112   my $PSVN = $self->getPSVN($set->login_id, $set->id);
  113   my %record = (
  114     $PSVN ? $self->fetchRecord($PSVN) : (),
  115     set2hash($set),
  116   );
  117   $PSVN = $self->setPSVN($set->login_id, $set->id) unless ($PSVN);
  118   return $self->storeRecord($PSVN, %record);
  119 }
  120 
  121 # deleteSet($userID, $setID) - removes the set with the specified userID and
  122 #                              setID. Also removes all problems in set.
  123 #                              Returns true on success, undef on failure.
  124 # $userID - the user ID (a.k.a. login name) of the set to delete
  125 # $setID - the ID (a.k.a. name) of the set to delete
  126 sub deleteSet($$$) {
  127   my $self = shift;
  128   my $userID = shift;
  129   my $setID = shift;
  130   my $PSVN = $self->getPSVN($userID, $setID);
  131   $self->{webwork_db}->connect("rw");
  132   delete $self->{webwork_db}->hashRef->{$PSVN};
  133   $self->{webwork_db}->disconnect;
  134   $self->deletePSVN($userID, $setID);
  135   return 1;
  136 }
  137 
  138 # -----
  139 
  140 # getSetDefaults($setID) - returns a WeBWorK::Set object containing the default
  141 #                          values for a particular set. (See NOTE)
  142 # setID - id of set to fetch
  143 
  144 # setSetDefaults($set) - Replace set defaults with the given set. (See NOTE)
  145 # $set - a WeBWorK::Set object containing set defaults
  146 
  147 # deleteSetDefaults($setID) - Remove set defaults with the given ID. (See NOTE)
  148 # $setID - the ID of the set defaults to delete
  149 
  150 # -----
  151 
  152 # getProblems($userID, $setID) - returns a list of problem IDs in the
  153 #                                specified set for the specified user.
  154 # $userID - the user ID of the user to get problems for
  155 # $setID - the set ID to get problems from
  156 sub getProblems($$$) {
  157   my $self = shift;
  158   my $userID = shift;
  159   my $setID = shift;
  160   my $PSVN = $self->getPSVN($userID, $setID);
  161   my %record = $self->fetchRecord($PSVN);
  162   return unless %record;
  163   my @result;
  164   my $i = 1;
  165   while (exists $record{"pse".$i}) {
  166     push @result, $i++;
  167   }
  168   return @result;
  169 }
  170 
  171 # -----
  172 
  173 # getProblem($userID, $setID, $problemNumber) - returns a WeBWorK::Problem
  174 #                                               object containing the problem
  175 #                                               requested
  176 # $userID - the user for which to retrieve the problem
  177 # $setID - the set from which to retrieve the problem
  178 # $problemNumber - the number of the problem to retrieve
  179 sub getProblem($$$$) {
  180   my $self = shift;
  181   my $userID = shift;
  182   my $setID = shift;
  183   my $problemNumber = shift;
  184   my $PSVN = $self->getPSVN($userID, $setID);
  185   return unless $PSVN;
  186   my $problem = hash2problem($problemNumber, $self->fetchRecord($PSVN));
  187   return $problem->source_file ? $problem : undef;
  188 }
  189 
  190 # setProblem($problem) - if a problem with the same ID for the specified user
  191 #                        exists, it is replaced. If not, a new problem is added.
  192 #                        returns true on success, undef on failure.
  193 # $problem - a WeBWorK::Problem object containing the object data
  194 sub setProblem($$) {
  195   my $self = shift;
  196   my $problem = shift;
  197   my $PSVN = $self->getPSVN($problem->login_id, $problem->set_id);
  198   die "failed to add problem: set ", $problem->set_id, " does not exist."
  199     unless $PSVN;
  200   my %record = (
  201     $self->fetchRecord($PSVN),
  202     problem2hash($problem),
  203   );
  204   return $self->storeRecord($PSVN, %record);
  205 }
  206 
  207 # deleteProblem($userID, $setID, $problemNumber) - removes a problem with the
  208 #                                                  specified parameters.
  209 # $userID - the user ID of the problem to delete
  210 # $setID - the ID of the problem's set
  211 # $problemNumber - the problem number of the problem to delete
  212 sub deleteProblem($$$$) {
  213   my $self = shift;
  214   my $userID = shift;
  215   my $setID = shift;
  216   my $n = shift;
  217   my $PSVN = $self->getPSVN($userID, $setID);
  218   my %record = $self->fetchRecord($PSVN);
  219   return unless %record;
  220   delete $record{"pfn$n"}  if exists $record{"pfn$n"};
  221   delete $record{"pva$n"}  if exists $record{"pva$n"};
  222   delete $record{"pmia$n"} if exists $record{"pmia$n"};
  223   delete $record{"pse$n"}  if exists $record{"pse$n"};
  224   delete $record{"pst$n"}  if exists $record{"pst$n"};
  225   delete $record{"pat$n"}  if exists $record{"pat$n"};
  226   delete $record{"pan$n"}  if exists $record{"pan$n"};
  227   delete $record{"pca$n"}  if exists $record{"pca$n"};
  228   delete $record{"pia$n"}  if exists $record{"pia$n"};
  229   return $self->storeRecord($PSVN, %record);
  230 }
  231 
  232 # -----
  233 
  234 # getProblemDefaults($setID, $problemNumber) - Returns a WeBWorK::Problem object
  235 #                                              containing the default values for
  236 #                                              a particular problem. (See NOTE)
  237 # $setID - set id of problem to retrieve
  238 # $problemNumber - problem number of problem to retrieve
  239 
  240 # setProblemDefaults($problem) - Replace or add problem defaults with the given
  241 #                                problem. (See NOTE)
  242 # $problem - a WeBWorK::Problem object containing problem defaults
  243 
  244 # deleteProblemDefaults($setID, $problemNumber) - remove problem defaults with
  245 #                                                 the given set and problem ID.
  246 #                                                 (See NOTE)
  247 # $setID - the set ID of the problem defaults to delete
  248 # $problemNumber - the problem number of the problem defaults to delete
  249 
  250 # -----
  251 
  252 # getPSVNs($userID) - get a list of PSVNs for a user
  253 # $userID - the user
  254 sub getPSVNs($$) {
  255   my $self = shift;
  256   my $userID = shift;
  257   return unless $self->{webwork_db}->connect("ro");
  258   my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID};
  259   $self->{webwork_db}->disconnect;
  260   return unless defined $setsForUser;
  261   my %sets = dbDecode($setsForUser);
  262   return values %sets;
  263 }
  264 
  265 # -----
  266 
  267 # getPSVN($userID, $setID) - look up a PSVN given a user ID and set ID (PSVN
  268 #                            stands for Problem Set Version Number and
  269 #                            uniquely identifies a user's version of a set.)
  270 # $userID - the user ID to lookup
  271 # $serID - the set ID to lookup
  272 sub getPSVN($$$) {
  273   my $self = shift;
  274   my $userID = shift;
  275   my $setID = shift;
  276   return unless $self->{webwork_db}->connect("ro");
  277   my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID};
  278   my $usersForSet = $self->{webwork_db}->hashRef->{SET_PREFIX.$setID};
  279   $self->{webwork_db}->disconnect;
  280   # * if setsForUser is non-empty, then there are sets built for
  281   #   this user.
  282   # * if usersForSet is non-empty, then this set has been built for
  283   #   at least one user.
  284   # * if either are empty, it is guaranteed that this set has not
  285   #   been built for this user.
  286   return unless defined $setsForUser and defined $usersForSet;
  287   return unless $setsForUser and $usersForSet;
  288   my %sets = dbDecode($setsForUser);
  289   my %users = dbDecode($usersForSet);
  290   # more sanity checks: the following should never happen.
  291   # if they do, run screaming for the hills.
  292   if (defined $sets{$setID} and not defined $users{$userID}) {
  293     die "PSVN indexes inconsistent: set exists in user index ",
  294       "but user does not exist in set index.";
  295   } elsif (not defined $sets{$setID} and defined $users{$userID}) {
  296     die "PSVN indexes inconsistent: user exists in set index ",
  297       "but set does not exist in user index.";
  298   } elsif ($sets{$setID} != $users{$userID}) {
  299     die "PSVN indexes inconsistent: user index and set index ",
  300       "gave different PSVN values.";
  301   }
  302   return $sets{$setID};
  303 }
  304 
  305 # setPSVN($userID, $setID) - adds a new PSVN to the PSVN indexesfor the given
  306 #                            user ID and set ID, if it doesn't exist. Returns
  307 #                            the PSVN.
  308 # $userID - the user ID to use
  309 # $serID - the set ID to use
  310 sub setPSVN($$$) {
  311   my $self = shift;
  312   my $userID = shift;
  313   my $setID = shift;
  314   my $PSVN = $self->getPSVN($userID, $setID);
  315   unless ($PSVN) {
  316     # yeah, create a new PSVN here
  317     my $min_psvn = 10**($self->{psvn_digits} - 1);
  318     my $max_psvn = 10**$self->{psvn_digits} - 1;
  319     my $attempts = 0;
  320     do {
  321       if (++$attempts > MAX_PSVN_GENERATION_ATTEMPTS) {
  322         die "failed to find an unused PSVN.";
  323       }
  324       $PSVN = int(rand($max_psvn-$min_psvn+1)) + $min_psvn;
  325     } while ($self->fetchRecord($PSVN));
  326     $self->{webwork_db}->connect("rw"); # open "rw" to lock
  327     # get current PSVN indexes
  328     my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID};
  329     my $usersForSet = $self->{webwork_db}->hashRef->{SET_PREFIX.$setID};
  330     my %sets = dbDecode($setsForUser);  # sets built for user $userID
  331     my %users = dbDecode($usersForSet); # users for which set $setID has been built
  332     # insert new PSVN into each hash
  333     $sets{$setID} = $PSVN;
  334     $users{$userID} = $PSVN;
  335     # re-encode the hashes
  336     $setsForUser = dbEncode(%sets);
  337     $usersForSet = dbEncode(%users);
  338     # store 'em in the database
  339     $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID} = $setsForUser;
  340     $self->{webwork_db}->hashRef->{SET_PREFIX.$setID} = $usersForSet;
  341     $self->{webwork_db}->disconnect;
  342   };
  343   return $PSVN;
  344 }
  345 
  346 # deletePSVN($userID, $setID) - remove an entry from the PSVN indexes.
  347 # $userID - the user to remove
  348 # $setID - the set to remove
  349 sub deletePSVN($$) {
  350   my $self = shift;
  351   my $userID = shift;
  352   my $setID = shift;
  353   my $PSVN = $self->getPSVN($userID, $setID);
  354   return unless $PSVN;
  355   $self->{webwork_db}->connect("rw"); # open "rw" to lock
  356   my $setsForUser = $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID};
  357   my $usersForSet = $self->{webwork_db}->hashRef->{SET_PREFIX.$setID};
  358   my %sets = dbDecode($setsForUser);  # sets built for user $userID
  359   my %users = dbDecode($usersForSet); # users for which set $setID has been built
  360   delete $sets{$setID};
  361   delete $users{$userID};
  362   $setsForUser = dbEncode(%sets);
  363   $usersForSet = dbEncode(%users);
  364   $self->{webwork_db}->hashRef->{LOGIN_PREFIX.$userID} = $setsForUser;
  365   $self->{webwork_db}->hashRef->{SET_PREFIX.$setID} = $usersForSet;
  366   $self->{webwork_db}->disconnect;
  367   return 1;
  368 }
  369 
  370 # -----
  371 
  372 # fetchRecord($PSVN) - retrieve the record associated with the given PSVN
  373 # $PSVN - problem set version number
  374 sub fetchRecord($$) {
  375   my $self = shift;
  376   my $PSVN = shift;
  377   return unless $self->{webwork_db}->connect("ro");
  378   my $result = $self->{webwork_db}->hashRef->{$PSVN};
  379   $self->{webwork_db}->disconnect;
  380   return dbDecode($result);
  381 }
  382 
  383 # storeRecord($PSVN, %record) - store the given record with the PSVN as a key
  384 # $PSVN - problem set version number
  385 # %record - the record to insert
  386 sub storeRecord($$%) {
  387   my $self = shift;
  388   my $PSVN = shift;
  389   my %record = @_;
  390   $self->{webwork_db}->connect("rw");
  391   $self->{webwork_db}->hashRef->{$PSVN} = dbEncode(%record);
  392   $self->{webwork_db}->disconnect;
  393   return 1;
  394 }
  395 
  396 # -----
  397 
  398 # hash2set(%hash) - places selected fields from a webwork database record
  399 #                   in a WeBWorK::Set object, which is then returned.
  400 # %hash - a hash representing a database record
  401 sub hash2set(%) {
  402   my %hash = @_;
  403   my $set = WeBWorK::Set->new;
  404   $set->id             ( $hash{stnm} ) if defined $hash{stnm};
  405   $set->login_id       ( $hash{stlg} ) if defined $hash{stlg};
  406   $set->set_header     ( $hash{shfn} ) if defined $hash{shfn};
  407   $set->problem_header ( $hash{phfn} ) if defined $hash{phfn};
  408   $set->open_date      ( $hash{opdt} ) if defined $hash{opdt};
  409   $set->due_date       ( $hash{dudt} ) if defined $hash{dudt};
  410   $set->answer_date    ( $hash{andt} ) if defined $hash{andt};
  411   return $set;
  412 }
  413 
  414 # set2hash($set) - unpacks a WeBWorK::Set object and returns PART of a hash
  415 #                  suitable for storage in the webwork database.
  416 # $set - a WeBWorK::Set object.
  417 sub set2hash($) {
  418   my $set = shift;
  419   return (
  420     stnm => $set->id,
  421     stlg => $set->login_id,
  422     shfn => $set->set_header,
  423     phfn => $set->problem_header,
  424     opdt => $set->open_date,
  425     dudt => $set->due_date,
  426     andt => $set->answer_date,
  427   );
  428 }
  429 
  430 # hash@problem($n, %hash) - places selected fields from a webwork
  431 #                                       database record in a WeBWorK::Problem
  432 #                                       object, which is then returned.
  433 # $n - the problem number to extract
  434 # %hash - a hash representing a database record
  435 sub hash2problem($%) {
  436   my $n = shift;
  437   my %hash = @_;
  438   my $problem = WeBWorK::Problem->new(id => $n);
  439   $problem->set_id        ( $hash{stnm}    ) if defined $hash{stnm};
  440   $problem->login_id      ( $hash{stlg}    ) if defined $hash{stlg};
  441   $problem->source_file   ( $hash{"pfn$n"} ) if defined $hash{"pfn$n"};
  442   $problem->value         ( $hash{"pva$n"} ) if defined $hash{"pva$n"};
  443   $problem->max_attempts  ( $hash{"pmia$n"}) if defined $hash{"pmia$n"};
  444   $problem->problem_seed  ( $hash{"pse$n"} ) if defined $hash{"pse$n"};
  445   $problem->status        ( $hash{"pst$n"} ) if defined $hash{"pst$n"};
  446   $problem->attempted     ( $hash{"pat$n"} ) if defined $hash{"pat$n"};
  447   $problem->last_answer   ( $hash{"pan$n"} ) if defined $hash{"pan$n"};
  448   $problem->num_correct   ( $hash{"pca$n"} ) if defined $hash{"pca$n"};
  449   $problem->num_incorrect ( $hash{"pia$n"} ) if defined $hash{"pia$n"};
  450   return $problem;
  451 }
  452 
  453 # problem2hash($problem) - unpacks a WeBWorK::Problem object and returns PART
  454 #                          of a hash suitable for storage in the webwork
  455 #                          database.
  456 # $problem - a WeBWorK::Problem object
  457 sub problem2hash($) {
  458   my $problem = shift;
  459   my $n = $problem->id;
  460 # my %hash;
  461 # $hash{stnm}    = $problem->set_id        if defined $problem->set_id;
  462 # $hash{stlg}    = $problem->login_id      if defined $problem->login_id;
  463 # $hash{"pfn$n"} = $problem->source_file   if defined $problem->source_file;
  464 # $hash{"pva$n"} = $problem->value         if defined $problem->value;
  465 # $hash{"pmia$n"}= $problem->max_attempts  if defined $problem->max_attempts;
  466 # $hash{"pse$n"} = $problem->problem_seed  if defined $problem->problem_seed;
  467 # $hash{"pst$n"} = $problem->status        if defined $problem->status;
  468 # $hash{"pat$n"} = $problem->attempted     if defined $problem->attempted;
  469 # $hash{"pan$n"} = $problem->last_answer   if defined $problem->last_answer;
  470 # $hash{"pca$n"} = $problem->num_correct   if defined $problem->num_correct;
  471 # $hash{"pia$n"} = $problem->num_incorrect if defined $problem->num_incorrect;
  472 # return %hash;
  473   return (
  474     stnm     => $problem->set_id,
  475     stlg     => $problem->login_id,
  476     "pfn$n"  => $problem->source_file,
  477     "pva$n"  => $problem->value,
  478     "pmia$n" => $problem->max_attempts,
  479     "pse$n"  => $problem->problem_seed,
  480     "pst$n"  => $problem->status,
  481     "pat$n"  => $problem->attempted,
  482     "pan$n"  => $problem->last_answer,
  483     "pca$n"  => $problem->num_correct,
  484     "pia$n"  => $problem->num_incorrect,
  485 
  486   );
  487 }
  488 
  489 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9