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