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 'Text::Tradition::Directory';
  10 # extends 'KiokuX::Model';
  11
  12 use Text::Tradition::User;
  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->{url} || $userinfo->{username};
  83     my $password = $userinfo->{password};
  84
  85     return unless ($username =~ /^https?:/
  86                    || ($username && $self->validate_password($password))) ;
  87
  88     my $user = Text::Tradition::User->new(
  89         id => $username,
  90         password => ($password ? crypt_password($password) : ''),
  91     );
  92
  93     my $scope = $self->new_scope;
  94     $self->store($user->kiokudb_object_id, $user);
  95
  96     return $user;
  97 }
  98
  99 sub create_user {
 100     my $self = shift;
 101     return $self->add_user(@_);
 102 }
 103
 104 =head3 find_user
 105
 106 Takes a hashref of C<username>, optionally C<openid_identifier>.
 107
 108 Fetches the user object for the given username and returns it.
 109
 110 =cut
 111
 112 sub find_user {
 113     my ($self, $userinfo) = @_;
 114     ## url or display?
 115     # 'display' => 'castaway.myopenid.com',
 116     # 'url' => 'http://castaway.myopenid.com/',
 117     my $username = $userinfo->{url} || $userinfo->{username};
 118
 119     my $scope = $self->new_scope;
 120     return $self->lookup(Text::Tradition::User->id_for_user($username));
 121
 122 }
 123
 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
 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
 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
 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;
 187 }
 188
 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
 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
 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
 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 }
 249
 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
 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
 268 1;