Parent Directory
| 
Revision Log
added REAL logout support. keys now get invalidated at logout. also, fixed a bug in classlist (see the diff). also, added a sub to Utils (see the diff). -sam
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::DB::Classlist; 7 8 =head1 NAME 9 10 WeBWorK::DB::Classlist - interface with the WeBWorK classlist database. 11 12 =cut 13 14 use strict; 15 use warnings; 16 use WeBWorK::User; 17 use WeBWorK::Utils qw(dbDecode dbEncode); 18 19 # there should be a `use' line for each database type 20 use WeBWorK::DB::GDBM; 21 22 # new($courseEnv) 23 # $courseEnv - an instance of CourseEnvironment 24 sub new($$) { 25 my $invocant = shift; 26 my $class = ref($invocant) || $invocant; 27 my $courseEnv = shift; 28 my $dbModule = fullyQualifiedPackageName($courseEnv->{dbInfo}->{cldb_type}); 29 my $self = { 30 classlist_file => $courseEnv->{dbInfo}->{cldb_file}, 31 }; 32 $self->{classlist_db} = $dbModule->new($self->{classlist_file}); 33 bless $self, $class; 34 return $self; 35 } 36 37 sub fullyQualifiedPackageName($) { 38 my $n = shift; 39 my $package = __PACKAGE__; 40 $package =~ s/([^:]*)$/$n/; 41 return $package; 42 } 43 44 # ----- 45 46 # getUsers() - returns a list of user IDs present in the database 47 sub getUsers($) { 48 my $self = shift; 49 return unless $self->{classlist_db}->connect("ro"); 50 my @result = keys %{$self->{classlist_db}->hashRef}; 51 $self->{classlist_db}->disconnect; 52 @result = grep !/^>>/, @result; # remove keys which start with ">>" 53 return @result; 54 } 55 56 # ----- 57 58 # getUser($userID) - returns a WeBWorK::User object if $userID exists 59 # or an undefined value if not. 60 # $userID - the ID of the user requested 61 sub getUser($$) { 62 my $self = shift; 63 my $userID = shift; 64 if ($userID =~ /^>>/) { 65 warn "Attempt to use the special key $userID as a user!"; 66 return; 67 } 68 return unless $self->{classlist_db}->connect("ro"); 69 my $result = $self->{classlist_db}->hashRef->{$userID}; 70 $self->{classlist_db}->disconnect; 71 return unless defined $result; 72 return hash2user($userID, dbDecode($result)); 73 } 74 75 # setUser($user) - if a user with the same user ID as $user exists, that user 76 # is replaced. if not, a new user is added. A true value is 77 # returned in success, an undefined value on failure. 78 # $user - an instance of WeBWorK::User containing user data 79 sub setUser($$) { 80 my $self = shift; 81 my $user = shift; 82 if ($user->id =~ /^>>/) { 83 warn "Attempt to use the special key \"", $user->id, "\" as a user ID!"; 84 return; 85 } 86 die "Can't add/modify user ", $user->id, ": classlist database locked" if $self->locked; 87 return unless $self->{classlist_db}->connect("rw"); 88 $self->{classlist_db}->hashRef->{$user->id} = dbEncode(user2hash($user)); 89 $self->{classlist_db}->disconnect; 90 return 1; 91 } 92 93 # deleteUser($userID) - removed a user with the specified user ID. Returns 94 # a true value on success, an undefined one on failure. 95 # $userID - the ID of the user to delete 96 sub deleteUser($$) { 97 my $self = shift; 98 my $userID = shift; 99 if ($userID =~ /^>>/) { 100 warn "Attempt to use the special key \"$userID\" as a user ID!"; 101 return; 102 } 103 die "Can't delete user $userID: classlist database locked" if $self->locked; 104 return unless $self->{classlist_db}->connect("rw"); 105 delete $self->{classlist_db}->hashRef->{$userID}; 106 $self->{classlist_db}->disconnect; 107 return 1; 108 } 109 110 # ----- 111 112 # lock() - locks the database associated with this classlist object. when 113 # a database is locked, it cannot be modified except to unlock it. 114 sub lock($) { 115 my $self = shift; 116 return unless $self->{classlist_db}->connect("rw"); 117 $self->{classlist_db}->hashRef->{">>lock_status"} = "locked"; 118 $self->{classlist_db}->disconnect; 119 return 1; 120 } 121 122 # unlock() - unlocks the database associated with this classlist object. 123 sub unlock($) { 124 my $self = shift; 125 return unless $self->{classlist_db}->connect("rw"); 126 # the old code sets this to "unlocked", but I going to delete it instead 127 delete $self->{classlist_db}->hashRef->{">>lock_status"}; 128 $self->{classlist_db}->disconnect; 129 return 1; 130 } 131 132 # locked() - returns true if the database is locked, false if it is not. 133 sub locked($) { 134 my $self = shift; 135 return unless $self->{classlist_db}->connect("ro"); 136 my $result = $self->{classlist_db}->hashRef->{">>lock_status"}; 137 $self->{classlist_db}->disconnect; 138 return (defined $result and $result eq "locked"); 139 } 140 141 # ----- 142 143 # the classlist_DBglue.pl library from the WeBWorK 1.x series uses four 144 # character hash keys -- we want to use more descriptive field names, so 145 # we do some conversion here. 146 # 147 # This is a little dangerous, since we hardcode User's schema, but I don't 148 # think it'll be a problem -- hopefully future backends will use the new 149 # field names and the old ones will wither away. 150 151 sub hash2user($%) { 152 my $userID = shift; 153 my %hash = @_; 154 my $user = WeBWorK::User->new(id => $userID); 155 $user->first_name ( $hash{stfn} ) if defined $hash{stfn}; 156 $user->last_name ( $hash{stln} ) if defined $hash{stln}; 157 $user->email_address ( $hash{stea} ) if defined $hash{stea}; 158 $user->student_id ( $hash{stid} ) if defined $hash{stid}; 159 $user->status ( $hash{stst} ) if defined $hash{stst}; 160 $user->section ( $hash{clsn} ) if defined $hash{clsn}; 161 $user->recitation ( $hash{clrc} ) if defined $hash{clrc}; 162 $user->comment ( $hash{comt} ) if defined $hash{comt}; 163 return $user; 164 } 165 166 sub user2hash($) { 167 my $user = shift; 168 my %hash; 169 $hash{stfn} = $user->first_name if defined $user->first_name; 170 $hash{stln} = $user->last_name if defined $user->last_name; 171 $hash{stea} = $user->email_address if defined $user->email_address; 172 $hash{stid} = $user->student_id if defined $user->student_id; 173 $hash{stst} = $user->status if defined $user->status; 174 $hash{clsn} = $user->section if defined $user->section; 175 $hash{clrc} = $user->recitation if defined $user->recitation; 176 $hash{comt} = $user->comment if defined $user->comment; 177 return %hash; 178 } 179 180 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |