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