View of /trunk/webwork2/lib/WeBWorK/DB/Schema/Classlist1Hash.pm

    1 ################################################################################
    2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
    3 # $Id$
    4 ################################################################################
    5 
    6 package WeBWorK::DB::Schema::Classlist1Hash;
    7 
    8 =head1 NAME
    9 
   10 WeBWorK::DB::Schema::Classlist1Hash - support access to the user table with a
   11 WWDBv1 hash-style backend.
   12 
   13 =cut
   14 
   15 use strict;
   16 use warnings;
   17 use WeBWorK::DB::Utils qw(record2hash hash2record hash2string string2hash);
   18 
   19 use constant TABLES => qw(user);
   20 use constant STYLE  => "hash";
   21 
   22 ################################################################################
   23 # static functions
   24 ################################################################################
   25 
   26 sub tables() {
   27   return TABLES;
   28 }
   29 
   30 sub style() {
   31   return STYLE;
   32 }
   33 
   34 ################################################################################
   35 # constructor
   36 ################################################################################
   37 
   38 sub new($$$) {
   39   my ($proto, $driver, $table, $record, $params) = @_;
   40   my $class = ref($proto) || $proto;
   41   die "$table: unsupported table"
   42     unless grep { $_ eq $table } $proto->tables();
   43   die $driver->style(), ": style mismatch"
   44     unless $driver->style() eq $proto->style();
   45   my $self = {
   46     driver => $driver,
   47     table  => $table,
   48     record => $record,
   49     params => $params,
   50   };
   51   bless $self, $class;
   52   return $self;
   53 }
   54 
   55 ################################################################################
   56 # table access functions
   57 ################################################################################
   58 
   59 sub list($) {
   60   my ($self, @keyparts) = @_;
   61   my ($matchUserID) = @keyparts;
   62   $self->{driver}->connect("ro");
   63   my @keys = grep { not m/^>>/ } keys %{ $self->{driver}->hash() };
   64   $self->{driver}->disconnect();
   65   if (defined $matchUserID) {
   66     @keys = grep { $_ eq $matchUserID } @keys;
   67   }
   68   return map { [$_] } @keys;
   69 }
   70 
   71 sub exists($$) {
   72   my ($self, $userID) = @_;
   73   $self->{driver}->connect("ro");
   74   my $exists = exists $self->{driver}->hash()->{$userID};
   75   $self->{driver}->disconnect();
   76   return $exists;
   77 }
   78 
   79 sub add($$) {
   80   my ($self, $User) = @_;
   81   $self->{driver}->connect("rw");
   82   my $hash = $self->{driver}->hash();
   83   die $User->user_id, ": user exists" if exists $hash->{$User->user_id};
   84   $hash->{$User->user_id} = hash2string(record2hash($User));
   85   $self->{driver}->disconnect();
   86 }
   87 
   88 sub get($$) {
   89   my ($self, $userID) = @_;
   90   $self->{driver}->connect("ro");
   91   my $string = $self->{driver}->hash()->{$userID};
   92   $self->{driver}->disconnect();
   93   return undef unless defined $string;
   94   my $record = hash2record($self->{record}, string2hash($string));
   95   $record->user_id($userID);
   96   return $record;
   97 }
   98 
   99 sub put($$) {
  100   my ($self, $User) = @_;
  101   $self->{driver}->connect("rw");
  102   my $hash = $self->{driver}->hash();
  103   die $User->user_id, ": user not found" unless exists $hash->{$User->user_id};
  104   $hash->{$User->user_id} = hash2string(record2hash($User));
  105   $self->{driver}->disconnect();
  106 }
  107 
  108 sub delete($$) {
  109   my ($self, $userID) = @_;
  110   $self->{driver}->connect("rw");
  111   my $hash = $self->{driver}->hash();
  112   die "$userID: user not found" unless exists $hash->{$userID};
  113   delete $hash->{$userID};
  114   $self->{driver}->disconnect();
  115 }
  116 
  117 1;