Parent Directory
| 
Revision Log
Revision 798 - (view) (download) (as text)
| 1 : | sh002i | 798 | ################################################################################ |
| 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; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |