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>, optionally C<openid_identifier>.
 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     ## url or display?
 109     # 'display' => 'castaway.myopenid.com',
 110     # 'url' => 'http://castaway.myopenid.com/',
 111     my $username = $userinfo->{url} || $userinfo->{username};
 112
 113     my $scope = $self->new_scope;
 114     return $self->lookup(Text::Tradition::User->id_for_user($username));
 115
 116 }
 117
 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
 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
 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
 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;
 181 }
 182
 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
 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
 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
 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 }
 243
 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
 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
 262 1;