1 package Text::Tradition::UserStore;
7 use KiokuX::User::Util qw(crypt_password);
8 use Text::Tradition::Error;
10 extends 'Text::Tradition::Directory';
11 # extends 'KiokuX::Model';
13 use Text::Tradition::User;
17 Text::Tradition::UserStore - KiokuDB storage management for Users
21 my $userstore = Text::Tradition::UserStore->new(dsn => 'dbi:SQLite:foo.db');
22 my $newuser = $userstore->add_user({ username => 'fred',
23 password => 'somepassword' });
25 my $fetchuser = $userstore->find_user({ username => 'fred' });
26 if($fetchuser->check_password('somepassword')) {
27 ## login user or .. whatever
30 my $user = $userstore->deactivate_user({ username => 'fred' });
32 ## shouldnt be able to login etc
37 A L<KiokuX::Model> for managing the storage and creation of
38 L<Text::Tradition::User> objects. Subclass or replace this module in
39 order to use a different source for stemmaweb users.
45 Inherited from KiokuX::Model - dsn for the data store we are using.
49 Constant for the minimum password length when validating passwords,
54 has MIN_PASS_LEN => ( is => 'ro', isa => 'Num', default => sub { 8 } );
56 # has 'directory' => (
58 # isa => 'KiokuX::Model',
62 ## TODO: Some of these methods should probably optionally take $user objects
63 ## instead of hashrefs.
65 ## It also occurs to me that all these methods don't need to be named
66 ## XX_user, but leaving that way for now incase we merge this code
67 ## into ::Directory for one-store.
73 Takes a hashref of C<username>, C<password>.
75 Create a new user object, store in the KiokuDB backend, and return it.
80 my ($self, $userinfo) = @_;
81 my $username = $userinfo->{url} || $userinfo->{username};
82 my $password = $userinfo->{password};
84 throw( "No username given" ) unless $username;
85 throw( "Invalid password - too short?" )
86 unless ( $self->validate_password($password) || $username =~ /^https?:/ );
88 my $user = Text::Tradition::User->new(
90 password => ($password ? crypt_password($password) : ''),
93 my $scope = $self->new_scope;
94 $self->store($user->kiokudb_object_id, $user);
101 return $self->add_user(@_);
106 Takes a hashref of C<username>, optionally C<openid_identifier>.
108 Fetches the user object for the given username and returns it.
113 my ($self, $userinfo) = @_;
115 # 'display' => 'castaway.myopenid.com',
116 # 'url' => 'http://castaway.myopenid.com/',
117 my $username = $userinfo->{url} || $userinfo->{username};
119 my $scope = $self->new_scope;
120 return $self->lookup(Text::Tradition::User->id_for_user($username));
126 Takes a hashref of C<username> and C<password> (same as add_user).
128 Retrieves the user, and updates it with the new information. Username
129 changing is not currently supported. Returns the updated user object.
130 Throws an error if user not found.
135 my ($self, $userinfo) = @_;
136 my $username = $userinfo->{username};
137 my $password = $userinfo->{password};
139 throw( "Missing username or bad password" )
140 unless $username && $self->validate_password($password);
142 my $user = $self->find_user({ username => $username });
143 throw( "Could not find user $username" ) unless $user;
145 my $scope = $self->new_scope;
146 $user->password(crypt_password($password));
148 $self->update($user);
153 =head3 deactivate_user
155 Takes a hashref of C<username>.
157 Sets the users C<active> flag to false (0), and sets all traditions
158 assigned to them to non-public, updates the storage and returns the
161 Throws an error if user not found.
165 sub deactivate_user {
166 my ($self, $userinfo) = @_;
167 my $username = $userinfo->{username};
169 throw( "Need to specify a username for deactivation" ) unless $username;
171 my $user = $self->find_user({ username => $username });
172 throw( "User $username not found" ) unless $user;
175 foreach my $tradition (@{ $user->traditions }) {
176 ## Not implemented yet
177 # $tradition->public(0);
179 my $scope = $self->new_scope;
181 ## Should we be using Text::Tradition::Directory also?
182 $self->update(@{ $user->traditions });
184 $self->update($user);
189 =head3 reactivate_user
191 Takes a hashref of C<username>.
193 Returns the user object if already activated. Activates (sets the
194 active flag to true (1)), updates the storage and returns the user.
196 Throws an error if the user is not found.
200 sub reactivate_user {
201 my ($self, $userinfo) = @_;
202 my $username = $userinfo->{username};
204 throw( "Need to specify a username for reactivation" ) unless $username;
206 my $user = $self->find_user({ username => $username });
207 throw( "User $username not found" ) unless $user;
209 return $user if $user->active;
212 my $scope = $self->new_scope;
213 $self->update($user);
220 CAUTION: Delets actual data!
222 Takes a hashref of C<username>.
224 Throws an error if the user doesn't exist.
226 Removes the user from the store and returns 1.
231 my ($self, $userinfo) = @_;
232 my $username = $userinfo->{username};
234 throw( "Need to specify a username for deletion" ) unless $username;
236 my $user = $self->find_user({ username => $username });
237 throw( "User $username not found" ) unless $user;
239 my $scope = $self->new_scope;
241 ## Should we be using Text::Tradition::Directory for this bit?
242 $self->delete( @{ $user->traditions });
245 $self->delete($user);
250 =head3 validate_password
252 Takes a password string. Returns true if it is longer than
253 L</MIN_PASS_LEN>, false otherwise.
255 Used internally by L</add_user>.
259 sub validate_password {
260 my ($self, $password) = @_;
262 return if !$password;
263 return if length($password) < $self->MIN_PASS_LEN;
269 Text::Tradition::Error->throw(
270 'ident' => 'UserStore error',