Commit | Line | Data |
2006bd3f |
1 | package Text::Tradition::UserStore; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Moose; |
7 | use KiokuX::User::Util qw(crypt_password); |
f7ff202c |
8 | use Text::Tradition::Error; |
2006bd3f |
9 | |
cf7e4e7b |
10 | extends 'Text::Tradition::Directory'; |
11 | # extends 'KiokuX::Model'; |
d1ba091f |
12 | |
2006bd3f |
13 | use Text::Tradition::User; |
2006bd3f |
14 | |
1384ec2d |
15 | =head1 NAME |
16 | |
17 | Text::Tradition::UserStore - KiokuDB storage management for Users |
18 | |
19 | =head1 SYNOPSIS |
20 | |
21 | my $userstore = Text::Tradition::UserStore->new(dsn => 'dbi:SQLite:foo.db'); |
22 | my $newuser = $userstore->add_user({ username => 'fred', |
23 | password => 'somepassword' }); |
24 | |
25 | my $fetchuser = $userstore->find_user({ username => 'fred' }); |
26 | if($fetchuser->check_password('somepassword')) { |
27 | ## login user or .. whatever |
28 | } |
29 | |
30 | my $user = $userstore->deactivate_user({ username => 'fred' }); |
31 | if(!$user->active) { |
32 | ## shouldnt be able to login etc |
33 | } |
34 | |
35 | =head1 DESCRIPTION |
36 | |
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. |
40 | |
41 | =head2 ATTRIBUTES |
42 | |
43 | =head3 dsn |
44 | |
45 | Inherited from KiokuX::Model - dsn for the data store we are using. |
46 | |
47 | =head3 MIN_PASS_LEN |
48 | |
49 | Constant for the minimum password length when validating passwords, |
50 | defaults to "8". |
51 | |
52 | =cut |
53 | |
ef02228c |
54 | has MIN_PASS_LEN => ( is => 'ro', isa => 'Num', default => sub { 8 } ); |
55 | |
d1ba091f |
56 | # has 'directory' => ( |
57 | # is => 'rw', |
58 | # isa => 'KiokuX::Model', |
59 | # handles => [] |
60 | # ); |
2006bd3f |
61 | |
570cf8ba |
62 | ## TODO: Some of these methods should probably optionally take $user objects |
63 | ## instead of hashrefs. |
64 | |
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. |
68 | |
1384ec2d |
69 | =head2 METHODS |
70 | |
71 | =head3 add_user |
72 | |
73 | Takes a hashref of C<username>, C<password>. |
74 | |
75 | Create a new user object, store in the KiokuDB backend, and return it. |
76 | |
77 | =cut |
78 | |
2006bd3f |
79 | sub add_user { |
ef02228c |
80 | my ($self, $userinfo) = @_; |
63bedbf3 |
81 | my $username = $userinfo->{url} || $userinfo->{username}; |
ef02228c |
82 | my $password = $userinfo->{password}; |
83 | |
f7ff202c |
84 | throw( "No username given" ) unless $username; |
b77f6c1b |
85 | throw( "Invalid password - must be at least " . $self->MIN_PASS_LEN |
86 | . " characters long" ) |
f7ff202c |
87 | unless ( $self->validate_password($password) || $username =~ /^https?:/ ); |
88 | |
2006bd3f |
89 | my $user = Text::Tradition::User->new( |
90 | id => $username, |
63bedbf3 |
91 | password => ($password ? crypt_password($password) : ''), |
2006bd3f |
92 | ); |
93 | |
d1ba091f |
94 | my $scope = $self->new_scope; |
95 | $self->store($user->kiokudb_object_id, $user); |
2006bd3f |
96 | |
97 | return $user; |
98 | } |
99 | |
63bedbf3 |
100 | sub create_user { |
101 | my $self = shift; |
102 | return $self->add_user(@_); |
103 | } |
104 | |
1384ec2d |
105 | =head3 find_user |
106 | |
031a15f4 |
107 | Takes a hashref of C<username>, optionally C<openid_identifier>. |
1384ec2d |
108 | |
109 | Fetches the user object for the given username and returns it. |
110 | |
111 | =cut |
112 | |
2006bd3f |
113 | sub find_user { |
d1ba091f |
114 | my ($self, $userinfo) = @_; |
031a15f4 |
115 | ## url or display? |
116 | # 'display' => 'castaway.myopenid.com', |
117 | # 'url' => 'http://castaway.myopenid.com/', |
118 | my $username = $userinfo->{url} || $userinfo->{username}; |
2006bd3f |
119 | |
570cf8ba |
120 | my $scope = $self->new_scope; |
d1ba091f |
121 | return $self->lookup(Text::Tradition::User->id_for_user($username)); |
2006bd3f |
122 | |
123 | } |
124 | |
1384ec2d |
125 | =head3 modify_user |
126 | |
127 | Takes a hashref of C<username> and C<password> (same as add_user). |
128 | |
129 | Retrieves the user, and updates it with the new information. Username |
f7ff202c |
130 | changing is not currently supported. Returns the updated user object. |
131 | Throws an error if user not found. |
1384ec2d |
132 | |
133 | =cut |
134 | |
ef02228c |
135 | sub modify_user { |
136 | my ($self, $userinfo) = @_; |
137 | my $username = $userinfo->{username}; |
138 | my $password = $userinfo->{password}; |
139 | |
f7ff202c |
140 | throw( "Missing username or bad password" ) |
141 | unless $username && $self->validate_password($password); |
ef02228c |
142 | |
143 | my $user = $self->find_user({ username => $username }); |
f7ff202c |
144 | throw( "Could not find user $username" ) unless $user; |
ef02228c |
145 | |
146 | my $scope = $self->new_scope; |
147 | $user->password(crypt_password($password)); |
148 | |
149 | $self->update($user); |
150 | |
151 | return $user; |
152 | } |
153 | |
1384ec2d |
154 | =head3 deactivate_user |
155 | |
156 | Takes a hashref of C<username>. |
157 | |
158 | Sets the users C<active> flag to false (0), and sets all traditions |
159 | assigned to them to non-public, updates the storage and returns the |
160 | deactivated user. |
161 | |
f7ff202c |
162 | Throws an error if user not found. |
1384ec2d |
163 | |
164 | =cut |
165 | |
570cf8ba |
166 | sub deactivate_user { |
167 | my ($self, $userinfo) = @_; |
168 | my $username = $userinfo->{username}; |
169 | |
f7ff202c |
170 | throw( "Need to specify a username for deactivation" ) unless $username; |
570cf8ba |
171 | |
172 | my $user = $self->find_user({ username => $username }); |
f7ff202c |
173 | throw( "User $username not found" ) unless $user; |
570cf8ba |
174 | |
175 | $user->active(0); |
176 | foreach my $tradition (@{ $user->traditions }) { |
177 | ## Not implemented yet |
178 | # $tradition->public(0); |
179 | } |
180 | my $scope = $self->new_scope; |
181 | |
182 | ## Should we be using Text::Tradition::Directory also? |
183 | $self->update(@{ $user->traditions }); |
184 | |
185 | $self->update($user); |
186 | |
187 | return $user; |
ef02228c |
188 | } |
189 | |
1384ec2d |
190 | =head3 reactivate_user |
191 | |
192 | Takes a hashref of C<username>. |
193 | |
194 | Returns the user object if already activated. Activates (sets the |
195 | active flag to true (1)), updates the storage and returns the user. |
196 | |
f7ff202c |
197 | Throws an error if the user is not found. |
1384ec2d |
198 | |
199 | =cut |
200 | |
570cf8ba |
201 | sub reactivate_user { |
202 | my ($self, $userinfo) = @_; |
203 | my $username = $userinfo->{username}; |
204 | |
f7ff202c |
205 | throw( "Need to specify a username for reactivation" ) unless $username; |
570cf8ba |
206 | |
207 | my $user = $self->find_user({ username => $username }); |
f7ff202c |
208 | throw( "User $username not found" ) unless $user; |
570cf8ba |
209 | |
210 | return $user if $user->active; |
211 | |
212 | $user->active(1); |
213 | my $scope = $self->new_scope; |
214 | $self->update($user); |
215 | |
216 | return $user; |
217 | } |
218 | |
1384ec2d |
219 | =head3 delete_user |
220 | |
221 | CAUTION: Delets actual data! |
222 | |
223 | Takes a hashref of C<username>. |
224 | |
f7ff202c |
225 | Throws an error if the user doesn't exist. |
1384ec2d |
226 | |
227 | Removes the user from the store and returns 1. |
228 | |
229 | =cut |
230 | |
570cf8ba |
231 | sub delete_user { |
232 | my ($self, $userinfo) = @_; |
233 | my $username = $userinfo->{username}; |
234 | |
f7ff202c |
235 | throw( "Need to specify a username for deletion" ) unless $username; |
570cf8ba |
236 | |
237 | my $user = $self->find_user({ username => $username }); |
f7ff202c |
238 | throw( "User $username not found" ) unless $user; |
570cf8ba |
239 | |
240 | my $scope = $self->new_scope; |
241 | |
242 | ## Should we be using Text::Tradition::Directory for this bit? |
243 | $self->delete( @{ $user->traditions }); |
244 | |
245 | ## Poof, gone. |
246 | $self->delete($user); |
247 | |
248 | return 1; |
249 | } |
ef02228c |
250 | |
1384ec2d |
251 | =head3 validate_password |
252 | |
253 | Takes a password string. Returns true if it is longer than |
254 | L</MIN_PASS_LEN>, false otherwise. |
255 | |
256 | Used internally by L</add_user>. |
257 | |
258 | =cut |
259 | |
ef02228c |
260 | sub validate_password { |
261 | my ($self, $password) = @_; |
262 | |
263 | return if !$password; |
264 | return if length($password) < $self->MIN_PASS_LEN; |
265 | |
266 | return 1; |
267 | } |
268 | |
f7ff202c |
269 | sub throw { |
270 | Text::Tradition::Error->throw( |
271 | 'ident' => 'UserStore error', |
272 | 'message' => $_[0], |
273 | ); |
274 | } |
275 | |
2006bd3f |
276 | 1; |