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 use Text::Tradition::Error;
   9
  10 extends 'Text::Tradition::Directory';
  11 # extends 'KiokuX::Model';
  12
  13 use Text::Tradition::User;
  14
  15 =head1 NAME
  16
  17 Text::Tradition::UserStore - KiokuDB storage management for Users
  18
  19 =head1 SYNOPSIS
  20
  21     my $userstore = Text::Tradition::UserStore->new(dsn => 'dbi:SQLite:foo.db');
  22     my $newuser = $userstore->add_user({ username => 'fred',
  23                                          password => 'somepassword' });
  24
  25     my $fetchuser = $userstore->find_user({ username => 'fred' });
  26     if($fetchuser->check_password('somepassword')) {
  27        ## login user or .. whatever
  28     }
  29
  30     my $user = $userstore->deactivate_user({ username => 'fred' });
  31     if(!$user->active) {
  32       ## shouldnt be able to login etc
  33     }
  34
  35 =head1 DESCRIPTION
  36
  37 A L<KiokuX::Model> for managing the storage and creation of
  38 L<Text::Tradition::User> objects. Subclass or replace this module in
  39 order to use a different source for stemmaweb users.
  40
  41 =head2 ATTRIBUTES
  42
  43 =head3 dsn
  44
  45 Inherited from KiokuX::Model - dsn for the data store we are using.
  46
  47 =head3 MIN_PASS_LEN
  48
  49 Constant for the minimum password length when validating passwords,
  50 defaults to "8".
  51
  52 =cut
  53
  54 has MIN_PASS_LEN => ( is => 'ro', isa => 'Num', default => sub { 8 } );
  55
  56 # has 'directory' => (
  57 #     is => 'rw',
  58 #     isa => 'KiokuX::Model',
  59 #     handles => []
  60 #     );
  61
  62 ## TODO: Some of these methods should probably optionally take $user objects
  63 ## instead of hashrefs.
  64
  65 ## It also occurs to me that all these methods don't need to be named
  66 ## XX_user, but leaving that way for now incase we merge this code
  67 ## into ::Directory for one-store.
  68
  69 =head2 METHODS
  70
  71 =head3 add_user
  72
  73 Takes a hashref of C<username>, C<password>.
  74
  75 Create a new user object, store in the KiokuDB backend, and return it.
  76
  77 =cut
  78
  79 sub add_user {
  80     my ($self, $userinfo) = @_;
  81     my $username = $userinfo->{url} || $userinfo->{username};
  82     my $password = $userinfo->{password};
  83
  84         throw( "No username given" ) unless $username;
  85         throw( "Invalid password - must be at least " . $self->MIN_PASS_LEN
  86                 . " characters long" )
  87                 unless ( $self->validate_password($password) || $username =~ /^https?:/ );
  88
  89     my $user = Text::Tradition::User->new(
  90         id => $username,
  91         password => ($password ? crypt_password($password) : ''),
  92     );
  93
  94     my $scope = $self->new_scope;
  95     $self->store($user->kiokudb_object_id, $user);
  96
  97     return $user;
  98 }
  99
 100 sub create_user {
 101     my $self = shift;
 102     return $self->add_user(@_);
 103 }
 104
 105 =head3 find_user
 106
 107 Takes a hashref of C<username>, optionally C<openid_identifier>.
 108
 109 Fetches the user object for the given username and returns it.
 110
 111 =cut
 112
 113 sub find_user {
 114     my ($self, $userinfo) = @_;
 115     ## url or display?
 116     # 'display' => 'castaway.myopenid.com',
 117     # 'url' => 'http://castaway.myopenid.com/',
 118     my $username = $userinfo->{url} || $userinfo->{username};
 119
 120     my $scope = $self->new_scope;
 121     return $self->lookup(Text::Tradition::User->id_for_user($username));
 122
 123 }
 124
 125 =head3 modify_user
 126
 127 Takes a hashref of C<username> and C<password> (same as add_user).
 128
 129 Retrieves the user, and updates it with the new information. Username
 130 changing is not currently supported. Returns the updated user object.
 131 Throws an error if user 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     throw( "Missing username or bad password" )
 141         unless $username && $self->validate_password($password);
 142
 143     my $user = $self->find_user({ username => $username });
 144     throw( "Could not find user $username" ) unless $user;
 145
 146     my $scope = $self->new_scope;
 147     $user->password(crypt_password($password));
 148
 149     $self->update($user);
 150
 151     return $user;
 152 }
 153
 154 =head3 deactivate_user
 155
 156 Takes a hashref of C<username>.
 157
 158 Sets the users C<active> flag to false (0), and sets all traditions
 159 assigned to them to non-public, updates the storage and returns the
 160 deactivated user.
 161
 162 Throws an error if user not found.
 163
 164 =cut
 165
 166 sub deactivate_user {
 167     my ($self, $userinfo) = @_;
 168     my $username = $userinfo->{username};
 169
 170     throw( "Need to specify a username for deactivation" ) unless $username;
 171
 172     my $user = $self->find_user({ username => $username });
 173     throw( "User $username not found" ) unless $user;
 174
 175     $user->active(0);
 176     foreach my $tradition (@{ $user->traditions }) {
 177         ## Not implemented yet
 178         # $tradition->public(0);
 179     }
 180     my $scope = $self->new_scope;
 181
 182     ## Should we be using Text::Tradition::Directory also?
 183     $self->update(@{ $user->traditions });
 184
 185     $self->update($user);
 186
 187     return $user;
 188 }
 189
 190 =head3 reactivate_user
 191
 192 Takes a hashref of C<username>.
 193
 194 Returns the user object if already activated. Activates (sets the
 195 active flag to true (1)), updates the storage and returns the user.
 196
 197 Throws an error if the user is not found.
 198
 199 =cut
 200
 201 sub reactivate_user {
 202     my ($self, $userinfo) = @_;
 203     my $username = $userinfo->{username};
 204
 205     throw( "Need to specify a username for reactivation" ) unless $username;
 206
 207     my $user = $self->find_user({ username => $username });
 208     throw( "User $username not found" ) unless $user;
 209
 210     return $user if $user->active;
 211
 212     $user->active(1);
 213     my $scope = $self->new_scope;
 214     $self->update($user);
 215
 216     return $user;
 217 }
 218
 219 =head3 delete_user
 220
 221 CAUTION: Delets actual data!
 222
 223 Takes a hashref of C<username>.
 224
 225 Throws an error if the user doesn't exist.
 226
 227 Removes the user from the store and returns 1.
 228
 229 =cut
 230
 231 sub delete_user {
 232     my ($self, $userinfo) = @_;
 233     my $username = $userinfo->{username};
 234
 235     throw( "Need to specify a username for deletion" ) unless $username;
 236
 237     my $user = $self->find_user({ username => $username });
 238     throw( "User $username not found" ) unless $user;
 239
 240     my $scope = $self->new_scope;
 241
 242     ## Should we be using Text::Tradition::Directory for this bit?
 243     $self->delete( @{ $user->traditions });
 244
 245     ## Poof, gone.
 246     $self->delete($user);
 247
 248     return 1;
 249 }
 250
 251 =head3 validate_password
 252
 253 Takes a password string. Returns true if it is longer than
 254 L</MIN_PASS_LEN>, false otherwise.
 255
 256 Used internally by L</add_user>.
 257
 258 =cut
 259
 260 sub validate_password {
 261     my ($self, $password) = @_;
 262
 263     return if !$password;
 264     return if length($password) < $self->MIN_PASS_LEN;
 265
 266     return 1;
 267 }
 268
 269 sub throw {
 270         Text::Tradition::Error->throw(
 271                 'ident' => 'UserStore error',
 272                 'message' => $_[0],
 273                 );
 274 }
 275
 276 1;