lib/Catalyst/Plugin/Authentication/Store/DBIx/Class/User.pm

   1 package Catalyst::Plugin::Authentication::Store::DBIx::Class::User;
   2
   3 use strict;
   4 use warnings;
   5 use base qw/Catalyst::Plugin::Authentication::User/;
   6
   7 sub new {
   8     my ( $class, $authinfo, $config, $c, $lazyload) = @_;
   9
  10     my $self = {};
  11     $self->{'resultset'} = $c->model($config->{'user_class'});
  12     $self->{'config'} = $config;
  13     $self->{'authinfo'} = {%{$authinfo}};
  14
  15     bless $self, $class;
  16
  17     ## if we have lazyloading turned on - we should not query the DB unless something gets read.
  18     ## that's the idea anyway - still have to work out how to manage that - so for now we always force
  19     ## lazyload to off.
  20     $lazyload = 0;
  21
  22     if (!$lazyload) {
  23         $self->load_user($authinfo, $c);
  24         if (!$self->{'user'}) {
  25             return;
  26         }
  27     } else {
  28         ## what do we do with a lazyload?
  29         ## presumably this is coming out of session storage.
  30         ## use $authinfo to fill in the user in that case?
  31     }
  32
  33     return $self;
  34 }
  35
  36
  37 sub load_user {
  38     my ($self, $authinfo, $c) = @_;
  39
  40     ## User can provide an arrayref containing the arguments to search on the user class.
  41     ## allowing maximum flexibility for authentication.
  42     if ($authinfo->{'searchargs'}) {
  43         $self->{user} = $self->{'resultset'}->search(@{$authinfo->{'searchargs'}})->first;
  44     } else {
  45         ## merge the ignore fields array into a hash - so we can do an easy check while building the query
  46         my %ignorefields = map { $_ => 1} @{$self->{'config'}{'ignore_fields_in_find'}},
  47                                     ( ref $authinfo->{'ignore_fields'} eq 'ARRAY' ? @{$authinfo->{'ignore_fields'}} : () );
  48
  49         my $searchargs = {};
  50
  51         # now we walk all the fields passed in, and build up a search hash.
  52         foreach my $key (grep {!$ignorefields{$_}} keys %{$authinfo}) {
  53
  54             if ($self->{'resultset'}->result_source->has_column($key)) {
  55                 $searchargs->{$key} = $authinfo->{$key};
  56             }
  57         }
  58         $self->{user} = $self->{'resultset'}->search($searchargs)->first;
  59     }
  60    #$c->log->debug(dumper($self->{'user'}));
  61
  62 }
  63
  64 sub supported_features {
  65     my $self = shift;
  66     $self->{'config'}{'password_type'} = 'clear';
  67
  68     return {
  69         password => {
  70             $self->{'config'}{'password_type'} => 1,
  71         },
  72         session         => 1,
  73         roles           => 1,
  74     };
  75 }
  76
  77
  78 sub roles {
  79     my ( $self, @wanted_roles ) = @_;
  80
  81     ## shortcut if we have already retrieved them
  82     if (ref $self->{'roles'} eq 'ARRAY') {
  83         return(@{$self->{'roles'}});
  84     }
  85
  86     my @roles = ();
  87     if (exists($self->{'config'}{'role_column'})) {
  88         @roles = split /[ ,\|]/, $self->get($self->{'config'}{'role_column'});
  89         $self->{'roles'} = \@roles;
  90     } elsif (exists($self->{'config'}{'role_relation'})) {
  91         my $relation = $self->{'config'}{'role_relation'};
  92         if ($self->{'user'}->$relation->result_source->has_column($self->{'config'}{'role_field'})) {
  93             @roles = $self->{'user'}->$relation->search(undef, { columns => [ $self->{'config'}{'role_field'}]})->all();
  94         } else {
  95             Catalyst::Exception->throw("role table does not have a column called " . $self->{'config'}{'role_field'});
  96         }
  97         my $rolefield = $self->{'config'}{'role_field'};
  98         @{$self->{'roles'}} =  map { $_->get_column($self->{'config'}{'role_field'}) } @roles;
  99     } else {
 100         Catalyst::Exception->throw("user->roles accessed, but no role configuration found");
 101     }
 102
 103     return @{$self->{'roles'}};
 104 }
 105
 106 sub for_session {
 107     shift->id;
 108 }
 109
 110 sub get {
 111     my ($self, $field) = @_;
 112
 113     if ($self->{'user'}->can($field)) {
 114         return $self->{'user'}->$field;
 115     } else {
 116         return undef;
 117     }
 118 }
 119
 120 sub obj {
 121     my $self = shift;
 122     return $self->get_object;
 123 }
 124
 125 sub get_object {
 126     my $self = shift;
 127
 128     return $self->{'user'};
 129 }
 130
 131 sub AUTOLOAD {
 132     my $self = shift;
 133     (my $method) = (our $AUTOLOAD =~ /([^:]+)$/);
 134     return if $method eq "DESTROY";
 135
 136     $self->{'user'}->$method(@_);
 137 }
 138
 139 1;
 140 __END__
 141
 142 =head1 NAME
 143
 144 Catalyst::Plugin::Authentication::Store::DBIx::Class::User - A class to ...
 145
 146 =head1 VERSION
 147
 148 This documentation refers to version 0.01.
 149
 150 =head1 SYNOPSIS
 151
 152 use Catalyst::Plugin::Authentication::Store::DBIx::Class::User;
 153
 154 =head1 DESCRIPTION
 155
 156 The Catalyst::Plugin::Authentication::Store::DBIx::Class::User class implements ...
 157
 158 =head1 SUBROUTINES / METHODS
 159
 160 =head2 new (constructor)
 161
 162 Parameters:
 163     class
 164     authinfo
 165     config
 166     c
 167     lazyload
 168
 169 Insert description of constructor here...
 170
 171 =head2 load_user (method)
 172
 173 Parameters:
 174     authinfo
 175     c
 176
 177 Insert description of method here...
 178
 179 =head2 supported_features (method)
 180
 181 Parameters:
 182     none
 183
 184 Insert description of method here...
 185
 186 =head2 roles
 187
 188 Parameters:
 189     none
 190
 191 Insert description of subroutine here...
 192
 193 =head2 for_session
 194
 195 Parameters:
 196     none
 197
 198 Insert description of subroutine here...
 199
 200 =head2 get (method)
 201
 202 Parameters:
 203     field
 204
 205 Insert description of method here...
 206
 207 =head2 obj (method)
 208
 209 Parameters:
 210     none
 211
 212 Insert description of method here...
 213
 214 =head2 get_object (method)
 215
 216 Parameters:
 217     none
 218
 219 Insert description of method here...
 220
 221 =head2 AUTOLOAD (method)
 222
 223 Parameters:
 224     none
 225
 226 Insert description of method here...
 227
 228 =head1 DEPENDENCIES
 229
 230 Modules used, version dependencies, core yes/no
 231
 232 strict
 233
 234 warnings
 235
 236 =head1 NOTES
 237
 238 ...
 239
 240 =head1 BUGS AND LIMITATIONS
 241
 242 None known currently, please email the author if you find any.
 243
 244 =head1 AUTHOR
 245
 246 Jason Kuri (jk@domain.tld)
 247
 248 =head1 LICENCE
 249
 250 Copyright 2006 by Jason Kuri.
 251
 252 This software is free.  It is licensed under the same terms as Perl itself.
 253
 254 =cut