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 1.x-structured hash-style backend.
   12 
   13 =cut
   14 
   15 use strict;
   16 use warnings;
   17 use WeBWorK::DB::Record::User;
   18 use WeBWorK::DB::Utils qw(record2hash hash2record hash2string string2hash);
   19 
   20 use constant TABLES => qw(user);
   21 use constant STYLE  => "hash";
   22 
   23 ################################################################################
   24 # static functions
   25 ################################################################################
   26 
   27 sub tables() {
   28   return TABLES;
   29 }
   30 
   31 sub style() {
   32   return STYLE;
   33 }
   34 
   35 ################################################################################
   36 # constructor
   37 ################################################################################
   38 
   39 sub new($$$) {
   40   my ($proto, $driver, $table) = @_;
   41   my $class = ref($proto) || $proto;
   42   die "$table: unsupported table"
   43     unless grep { $_ eq $table } $proto->tables();
   44   die $driver->style(), ": style mismatch"
   45     unless $driver->style() eq $proto->style();
   46   my $self = {
   47     driver => $driver,
   48     table  => $table,
   49   };
   50   bless $self, $class;
   51   return $self;
   52 }
   53 
   54 ################################################################################
   55 # table access functions
   56 ################################################################################
   57 
   58 sub list($) {
   59   my ($self) = @_;
   60   $self->{driver}->connect("ro");
   61   my @keys = grep !/^>>/, keys %{ $self->{driver}->hash() };
   62   $self->{driver}->disconnect();
   63   return @keys;
   64 }
   65 
   66 sub exists($$) {
   67   my ($self, $userID) = @_;
   68   $self->{driver}->connect("ro");
   69   my $exists = exists $self->{driver}->hash()->{$userID};
   70   $self->{driver}->disconnect();
   71   return $exists;
   72 }
   73 
   74 sub add($$) {
   75   my ($self, $User) = @_;
   76   $self->{driver}->connect("rw");
   77   my $hash = $self->{driver}->hash();
   78   die $User->id, ": user exists" if exists $hash->{$User->id};
   79   $hash->{$User->id} = hash2string(record2hash($User));
   80   $self->{driver}->disconnect();
   81 }
   82 
   83 sub get($$) {
   84   my ($self, $userID) = @_;
   85   $self->{driver}->connect("ro");
   86   my $string = $self->{driver}->hash()->{$userID};
   87   $self->{driver}->disconnect();
   88   return undef unless $string;
   89   my $record = hash2record("WeBWorK::DB::Record::User", string2hash($string));
   90   $record->id($userID);
   91   return $record;
   92 }
   93 
   94 sub put($$) {
   95   my ($self, $User) = @_;
   96   $self->{driver}->connect("rw");
   97   my $hash = $self->{driver}->hash();
   98   die $User->id, ": user not found" unless exists $hash->{$User->id};
   99   $hash->{$User->id} = hash2string(record2hash($User));
  100   $self->{driver}->disconnect();
  101 }
  102 
  103 sub delete($$) {
  104   my ($self, $userID) = @_;
  105   $self->{driver}->connect("rw");
  106   my $hash = $self->{driver}->hash();
  107   die "$userID: user not found" unless exists $hash->{$userID};
  108   delete $hash->{$userID};
  109   $self->{driver}->disconnect();
  110 }
  111 
  112 1;