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) = @_; |
82 | my $username = $userinfo->{username}; |
83 | my $password = $userinfo->{password}; |
84 | |
85 | return unless $username && $self->validate_password($password); |
2006bd3f |
86 | |
87 | my $user = Text::Tradition::User->new( |
88 | id => $username, |
89 | password => crypt_password($password), |
90 | ); |
91 | |
d1ba091f |
92 | my $scope = $self->new_scope; |
93 | $self->store($user->kiokudb_object_id, $user); |
2006bd3f |
94 | |
95 | return $user; |
96 | } |
97 | |
1384ec2d |
98 | =head3 find_user |
99 | |
031a15f4 |
100 | Takes a hashref of C<username>, optionally C<openid_identifier>. |
1384ec2d |
101 | |
102 | Fetches the user object for the given username and returns it. |
103 | |
104 | =cut |
105 | |
2006bd3f |
106 | sub find_user { |
d1ba091f |
107 | my ($self, $userinfo) = @_; |
031a15f4 |
108 | ## url or display? |
109 | # 'display' => 'castaway.myopenid.com', |
110 | # 'url' => 'http://castaway.myopenid.com/', |
111 | my $username = $userinfo->{url} || $userinfo->{username}; |
2006bd3f |
112 | |
570cf8ba |
113 | my $scope = $self->new_scope; |
d1ba091f |
114 | return $self->lookup(Text::Tradition::User->id_for_user($username)); |
2006bd3f |
115 | |
116 | } |
117 | |
1384ec2d |
118 | =head3 modify_user |
119 | |
120 | Takes a hashref of C<username> and C<password> (same as add_user). |
121 | |
122 | Retrieves the user, and updates it with the new information. Username |
123 | changing is not currently supported. |
124 | |
125 | Returns the updated user object, or undef if not found. |
126 | |
127 | =cut |
128 | |
ef02228c |
129 | sub modify_user { |
130 | my ($self, $userinfo) = @_; |
131 | my $username = $userinfo->{username}; |
132 | my $password = $userinfo->{password}; |
133 | |
134 | return unless $username && $self->validate_password($password); |
135 | |
136 | my $user = $self->find_user({ username => $username }); |
137 | return unless $user; |
138 | |
139 | my $scope = $self->new_scope; |
140 | $user->password(crypt_password($password)); |
141 | |
142 | $self->update($user); |
143 | |
144 | return $user; |
145 | } |
146 | |
1384ec2d |
147 | =head3 deactivate_user |
148 | |
149 | Takes a hashref of C<username>. |
150 | |
151 | Sets the users C<active> flag to false (0), and sets all traditions |
152 | assigned to them to non-public, updates the storage and returns the |
153 | deactivated user. |
154 | |
155 | Returns undef if user not found. |
156 | |
157 | =cut |
158 | |
570cf8ba |
159 | sub deactivate_user { |
160 | my ($self, $userinfo) = @_; |
161 | my $username = $userinfo->{username}; |
162 | |
163 | return if !$username; |
164 | |
165 | my $user = $self->find_user({ username => $username }); |
166 | return if !$user; |
167 | |
168 | $user->active(0); |
169 | foreach my $tradition (@{ $user->traditions }) { |
170 | ## Not implemented yet |
171 | # $tradition->public(0); |
172 | } |
173 | my $scope = $self->new_scope; |
174 | |
175 | ## Should we be using Text::Tradition::Directory also? |
176 | $self->update(@{ $user->traditions }); |
177 | |
178 | $self->update($user); |
179 | |
180 | return $user; |
ef02228c |
181 | } |
182 | |
1384ec2d |
183 | =head3 reactivate_user |
184 | |
185 | Takes a hashref of C<username>. |
186 | |
187 | Returns the user object if already activated. Activates (sets the |
188 | active flag to true (1)), updates the storage and returns the user. |
189 | |
190 | Returns undef if the user is not found. |
191 | |
192 | =cut |
193 | |
570cf8ba |
194 | sub reactivate_user { |
195 | my ($self, $userinfo) = @_; |
196 | my $username = $userinfo->{username}; |
197 | |
198 | return if !$username; |
199 | |
200 | my $user = $self->find_user({ username => $username }); |
201 | return if !$user; |
202 | |
203 | return $user if $user->active; |
204 | |
205 | $user->active(1); |
206 | my $scope = $self->new_scope; |
207 | $self->update($user); |
208 | |
209 | return $user; |
210 | } |
211 | |
1384ec2d |
212 | =head3 delete_user |
213 | |
214 | CAUTION: Delets actual data! |
215 | |
216 | Takes a hashref of C<username>. |
217 | |
218 | Returns undef if the user doesn't exist. |
219 | |
220 | Removes the user from the store and returns 1. |
221 | |
222 | =cut |
223 | |
570cf8ba |
224 | sub delete_user { |
225 | my ($self, $userinfo) = @_; |
226 | my $username = $userinfo->{username}; |
227 | |
228 | return if !$username; |
229 | |
230 | my $user = $self->find_user({ username => $username }); |
231 | return if !$user; |
232 | |
233 | my $scope = $self->new_scope; |
234 | |
235 | ## Should we be using Text::Tradition::Directory for this bit? |
236 | $self->delete( @{ $user->traditions }); |
237 | |
238 | ## Poof, gone. |
239 | $self->delete($user); |
240 | |
241 | return 1; |
242 | } |
ef02228c |
243 | |
1384ec2d |
244 | =head3 validate_password |
245 | |
246 | Takes a password string. Returns true if it is longer than |
247 | L</MIN_PASS_LEN>, false otherwise. |
248 | |
249 | Used internally by L</add_user>. |
250 | |
251 | =cut |
252 | |
ef02228c |
253 | sub validate_password { |
254 | my ($self, $password) = @_; |
255 | |
256 | return if !$password; |
257 | return if length($password) < $self->MIN_PASS_LEN; |
258 | |
259 | return 1; |
260 | } |
261 | |
2006bd3f |
262 | 1; |