lib/Catalyst/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 use base qw/Class::Accessor::Fast/;
   7
   8 BEGIN {
   9     __PACKAGE__->mk_accessors(qw/config resultset _user _roles/);
  10 }
  11
  12 sub new {
  13     my ( $class, $config, $c) = @_;
  14
  15     my $self = {
  16         resultset => $c->model($config->{'user_class'}),
  17         config => $config,
  18         _roles => undef,
  19         _user => undef
  20     };
  21
  22     bless $self, $class;
  23
  24
  25     if (!exists($self->config->{'id_field'})) {
  26         my @pks = $self->{'resultset'}->result_source->primary_columns;
  27         if ($#pks == 0) {
  28             $self->config->{'id_field'} = $pks[0];
  29         } else {
  30             Catalyst::Exception->throw("user table does not contain a single primary key column - please specify 'id_field' in config!");
  31         }
  32     }
  33     if (!$self->{'resultset'}->result_source->has_column($self->config->{'id_field'})) {
  34         Catalyst::Exception->throw("id_field set to " .  $self->config->{'id_field'} . " but user table has no column by that name!");
  35     }
  36
  37     ## if we have lazyloading turned on - we should not query the DB unless something gets read.
  38     ## that's the idea anyway - still have to work out how to manage that - so for now we always force
  39     ## lazyload to off.
  40     $self->config->{lazyload} = 0;
  41
  42 #    if (!$self->config->{lazyload}) {
  43 #        return $self->load_user($authinfo, $c);
  44 #    } else {
  45 #        ## what do we do with a lazyload?
  46 #        ## presumably this is coming out of session storage.
  47 #        ## use $authinfo to fill in the user in that case?
  48 #    }
  49
  50     return $self;
  51 }
  52
  53
  54 sub load {
  55     my ($self, $authinfo, $c) = @_;
  56
  57     my $dbix_class_config = 0;
  58
  59     if (exists($authinfo->{'dbix_class'})) {
  60         $authinfo = $authinfo->{'dbix_class'};
  61         $dbix_class_config = 1;
  62     }
  63
  64     ## User can provide an arrayref containing the arguments to search on the user class.
  65     ## or even provide a prepared resultset, allowing maximum flexibility for user retreival.
  66     ## these options are only available when using the dbix_class authinfo hash.
  67     if ($dbix_class_config && exists($authinfo->{'resultset'})) {
  68         $self->_user($authinfo->{'resultset'}->first);
  69     } elsif ($dbix_class_config && exists($authinfo->{'searchargs'})) {
  70         $self->_user($self->resultset->search(@{$authinfo->{'searchargs'}})->first);
  71     } else {
  72         ## merge the ignore fields array into a hash - so we can do an easy check while building the query
  73         my %ignorefields = map { $_ => 1} @{$self->config->{'ignore_fields_in_find'}};
  74         my $searchargs = {};
  75
  76         # now we walk all the fields passed in, and build up a search hash.
  77         foreach my $key (grep {!$ignorefields{$_}} keys %{$authinfo}) {
  78             if ($self->resultset->result_source->has_column($key)) {
  79                 $searchargs->{$key} = $authinfo->{$key};
  80             }
  81         }
  82         $self->_user($self->resultset->search($searchargs)->first);
  83     }
  84
  85     if ($self->get_object) {
  86         return $self;
  87     } else {
  88         return undef;
  89     }
  90     #$c->log->debug(dumper($self->{'user'}));
  91
  92 }
  93
  94 sub supported_features {
  95     my $self = shift;
  96
  97     return {
  98         session         => 1,
  99         roles           => 1,
 100     };
 101 }
 102
 103
 104 sub roles {
 105     my ( $self ) = shift;
 106     ## this used to load @wantedroles - but that doesn't seem to be used by the roles plugin, so I dropped it.
 107
 108     ## shortcut if we have already retrieved them
 109     if (ref $self->_roles eq 'ARRAY') {
 110         return(@{$self->_roles});
 111     }
 112
 113     my @roles = ();
 114     if (exists($self->config->{'role_column'})) {
 115         my $role_data = $self->get($self->config->{'role_column'});
 116         if ($role_data) {
 117             @roles = split /[ ,\|]+/, $self->get($self->config->{'role_column'});
 118         }
 119         $self->_roles(\@roles);
 120     } elsif (exists($self->config->{'role_relation'})) {
 121         my $relation = $self->config->{'role_relation'};
 122         if ($self->_user->$relation->result_source->has_column($self->config->{'role_field'})) {
 123             @roles = map { $_->get_column($self->config->{'role_field'}) } $self->_user->$relation->search(undef, { columns => [ $self->config->{'role_field'}]})->all();
 124             $self->_roles(\@roles);
 125         } else {
 126             Catalyst::Exception->throw("role table does not have a column called " . $self->config->{'role_field'});
 127         }
 128     } else {
 129         Catalyst::Exception->throw("user->roles accessed, but no role configuration found");
 130     }
 131
 132     return @{$self->_roles};
 133 }
 134
 135 sub for_session {
 136     my $self = shift;
 137
 138     return $self->get($self->config->{'id_field'});
 139 }
 140
 141 sub from_session {
 142     my ($self, $frozenuser, $c) = @_;
 143
 144     # this could be a lot better.  But for now it just assumes $frozenuser is an id and uses find_user
 145     # XXX: hits the database on every request?  Not good...
 146     return $self->load( { $self->config->{'id_field'} => $frozenuser }, $c);
 147 }
 148
 149 sub get {
 150     my ($self, $field) = @_;
 151
 152     if ($self->_user->can($field)) {
 153         return $self->_user->$field;
 154     } else {
 155         return undef;
 156     }
 157 }
 158
 159 sub get_object {
 160     my $self = shift;
 161
 162     return $self->_user;
 163 }
 164
 165 sub obj {
 166     my $self = shift;
 167
 168     return $self->get_object;
 169 }
 170
 171 sub AUTOLOAD {
 172     my $self = shift;
 173     (my $method) = (our $AUTOLOAD =~ /([^:]+)$/);
 174     return if $method eq "DESTROY";
 175
 176     $self->_user->$method(@_);
 177 }
 178
 179 1;
 180 __END__
 181
 182 =head1 NAME
 183
 184 Catalyst::Plugin::Authentication::Store::DBIx::Class::User - The backing user
 185 class for the Catalyst::Plugin::Authentication::Store::DBIx::Class storage
 186 module.
 187
 188 =head1 VERSION
 189
 190 This documentation refers to version 0.10.
 191
 192 =head1 SYNOPSIS
 193
 194 Internal - not used directly, please see
 195 L<Catalyst::Plugin::Authentication::Store::DBIx::Class> for details on how to
 196 use this module. If you need more information than is present there, read the
 197 source.
 198
 199
 200
 201 =head1 DESCRIPTION
 202
 203 The Catalyst::Plugin::Authentication::Store::DBIx::Class::User class implements user storage
 204 connected to an underlying DBIx::Class schema object.
 205
 206 =head1 SUBROUTINES / METHODS
 207
 208 =head2 new
 209
 210 Constructor.
 211
 212 =head2 load ( $authinfo, $c )
 213
 214 Retrieves a user from storage using the information provided in $authinfo.
 215
 216 =head2 supported_features
 217
 218 Indicates the features supported by this class.  These are currently Roles and Session.
 219
 220 =head2 roles
 221
 222 Returns an array of roles associated with this user, if roles are configured for this user class.
 223
 224 =head2 for_session
 225
 226 Returns a serialized user for storage in the session.  Currently, this is the value of the field
 227 specified by the 'id_field' config variable.
 228
 229 =head2 from_session
 230
 231 Revives a serialized user from storage in the session.  Currently, this uses the serialized data as the
 232 value of the 'id_field' config variable.
 233
 234 =head2 get ( $fieldname )
 235
 236 Returns the value of $fieldname for the user in question.  Roughly translates to a call to
 237 the DBIx::Class::Row's get_column( $fieldname ) routine.
 238
 239 =head2 get_object
 240
 241 Retrieves the DBIx::Class object that corresponds to this user
 242
 243 =head2 obj (method)
 244
 245 Synonym for get_object
 246
 247 =head1 BUGS AND LIMITATIONS
 248
 249 None known currently, please email the author if you find any.
 250
 251 =head1 AUTHOR
 252
 253 Jason Kuri (jayk@cpan.org)
 254
 255 =head1 LICENSE
 256
 257 Copyright (c) 2007 the aforementioned authors. All rights
 258 reserved. This program is free software; you can redistribute
 259 it and/or modify it under the same terms as Perl itself.
 260
 261 =cut