lib/Text/Tradition/UserStore.pm

   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
   9 extends 'KiokuX::Model';
  10
  11 use Text::Tradition::User;
  12 # use Text::Tradition::Directory;
  13
  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
  53 has MIN_PASS_LEN => ( is => 'ro', isa => 'Num', default => sub { 8 } );
  54
  55 # has 'directory' => (
  56 #     is => 'rw',
  57 #     isa => 'KiokuX::Model',
  58 #     handles => []
  59 #     );
  60
  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
  68 ## To die or not to die, on error, this is the question.
  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
  80 sub add_user {
  81     my ($self, $userinfo) = @_;
  82     my $username = $userinfo->{username};
  83     my $password = $userinfo->{password};
  84
  85     return unless $username && $self->validate_password($password);
  86
  87     my $user = Text::Tradition::User->new(
  88         id => $username,
  89         password => crypt_password($password),
  90     );
  91
  92     my $scope = $self->new_scope;
  93     $self->store($user->kiokudb_object_id, $user);
  94
  95     return $user;
  96 }
  97
  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
 106 sub find_user {
 107     my ($self, $userinfo) = @_;
 108     my $username = $userinfo->{username};
 109
 110     my $scope = $self->new_scope;
 111     return $self->lookup(Text::Tradition::User->id_for_user($username));
 112
 113 }
 114
 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
 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
 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
 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;
 178 }
 179
 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
 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
 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
 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 }
 240
 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
 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
 259 1;