| … | |
… | |
| 6 | package WeBWorK::DB::Schema::Classlist1Hash; |
6 | package WeBWorK::DB::Schema::Classlist1Hash; |
| 7 | |
7 | |
| 8 | =head1 NAME |
8 | =head1 NAME |
| 9 | |
9 | |
| 10 | WeBWorK::DB::Schema::Classlist1Hash - support access to the user table with a |
10 | WeBWorK::DB::Schema::Classlist1Hash - support access to the user table with a |
| 11 | 1.x-structured hash-style backend. |
11 | WWDBv1 hash-style backend. |
| 12 | |
12 | |
| 13 | =cut |
13 | =cut |
| 14 | |
14 | |
| 15 | use strict; |
15 | use strict; |
| 16 | use warnings; |
16 | use warnings; |
| 17 | use WeBWorK::DB::Record::User; |
|
|
| 18 | use WeBWorK::DB::Utils qw(record2hash hash2record hash2string string2hash); |
17 | use WeBWorK::DB::Utils qw(record2hash hash2record hash2string string2hash); |
| 19 | |
18 | |
| 20 | use constant TABLES => qw(user); |
19 | use constant TABLES => qw(user); |
| 21 | use constant STYLE => "hash"; |
20 | use constant STYLE => "hash"; |
| 22 | |
21 | |
| … | |
… | |
| 35 | ################################################################################ |
34 | ################################################################################ |
| 36 | # constructor |
35 | # constructor |
| 37 | ################################################################################ |
36 | ################################################################################ |
| 38 | |
37 | |
| 39 | sub new($$$) { |
38 | sub new($$$) { |
| 40 | my ($proto, $driver, $table) = @_; |
39 | my ($proto, $driver, $table, $record, $params) = @_; |
| 41 | my $class = ref($proto) || $proto; |
40 | my $class = ref($proto) || $proto; |
| 42 | die "$table: unsupported table" |
41 | die "$table: unsupported table" |
| 43 | unless grep { $_ eq $table } $proto->tables(); |
42 | unless grep { $_ eq $table } $proto->tables(); |
| 44 | die $driver->style(), ": style mismatch" |
43 | die $driver->style(), ": style mismatch" |
| 45 | unless $driver->style() eq $proto->style(); |
44 | unless $driver->style() eq $proto->style(); |
| 46 | my $self = { |
45 | my $self = { |
| 47 | driver => $driver, |
46 | driver => $driver, |
| 48 | table => $table, |
47 | table => $table, |
|
|
48 | record => $record, |
|
|
49 | params => $params, |
| 49 | }; |
50 | }; |
| 50 | bless $self, $class; |
51 | bless $self, $class; |
| 51 | return $self; |
52 | return $self; |
| 52 | } |
53 | } |
| 53 | |
54 | |
| 54 | ################################################################################ |
55 | ################################################################################ |
| 55 | # table access functions |
56 | # table access functions |
| 56 | ################################################################################ |
57 | ################################################################################ |
| 57 | |
58 | |
| 58 | sub list($) { |
59 | sub list($) { |
| 59 | my ($self) = @_; |
60 | my ($self, @keyparts) = @_; |
|
|
61 | my ($matchUserID) = @keyparts; |
| 60 | $self->{driver}->connect("ro"); |
62 | $self->{driver}->connect("ro"); |
| 61 | my @keys = grep !/^>>/, keys %{ $self->{driver}->hash() }; |
63 | my @keys = grep { not m/^>>/ } keys %{ $self->{driver}->hash() }; |
| 62 | $self->{driver}->disconnect(); |
64 | $self->{driver}->disconnect(); |
| 63 | return @keys; |
65 | if (defined $matchUserID) { |
|
|
66 | @keys = grep { $_ eq $matchUserID } @keys; |
|
|
67 | } |
|
|
68 | return map { [$_] } @keys; |
| 64 | } |
69 | } |
| 65 | |
70 | |
| 66 | sub exists($$) { |
71 | sub exists($$) { |
| 67 | my ($self, $userID) = @_; |
72 | my ($self, $userID) = @_; |
| 68 | $self->{driver}->connect("ro"); |
73 | $self->{driver}->connect("ro"); |
| … | |
… | |
| 83 | sub get($$) { |
88 | sub get($$) { |
| 84 | my ($self, $userID) = @_; |
89 | my ($self, $userID) = @_; |
| 85 | $self->{driver}->connect("ro"); |
90 | $self->{driver}->connect("ro"); |
| 86 | my $string = $self->{driver}->hash()->{$userID}; |
91 | my $string = $self->{driver}->hash()->{$userID}; |
| 87 | $self->{driver}->disconnect(); |
92 | $self->{driver}->disconnect(); |
| 88 | return undef unless $string; |
93 | return undef unless defined $string; |
| 89 | my $record = hash2record("WeBWorK::DB::Record::User", string2hash($string)); |
94 | my $record = hash2record($self->{record}, string2hash($string)); |
| 90 | $record->id($userID); |
95 | $record->id($userID); |
| 91 | return $record; |
96 | return $record; |
| 92 | } |
97 | } |
| 93 | |
98 | |
| 94 | sub put($$) { |
99 | sub put($$) { |