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