Changes to use Class::Accessor::Fast

[catagits/Catalyst-Authentication-Store-DBIx-Class.git] / lib / Catalyst / Plugin / Authentication / Store / DBIx / Class / User.pm

package Catalyst::Plugin::Authentication::Store::DBIx::Class::User;

use strict;
use warnings;
use base qw/Catalyst::Plugin::Authentication::User/;

sub new {
    my ( $class, $authinfo, $config, $c, $lazyload) = @_;

    my $self = {};
    $self->{'resultset'} = $c->model($config->{'user_class'});
    $self->{'config'} = $config;
    $self->{'authinfo'} = {%{$authinfo}};
    
    bless $self, $class;
    
    ## if we have lazyloading turned on - we should not query the DB unless something gets read.
    ## that's the idea anyway - still have to work out how to manage that - so for now we always force
    ## lazyload to off.
    $lazyload = 0;
    
    if (!$lazyload) {
        $self->load_user($authinfo, $c);
        if (!$self->{'user'}) {
            return;
        }
    } else {
        ## what do we do with a lazyload?
        ## presumably this is coming out of session storage.  
        ## use $authinfo to fill in the user in that case?
    }
    
    return $self;
}


sub load_user {
    my ($self, $authinfo, $c) = @_;
    
    ## User can provide an arrayref containing the arguments to search on the user class.
    ## allowing maximum flexibility for authentication.
    if ($authinfo->{'searchargs'}) {
        $self->{user} = $self->{'resultset'}->search(@{$authinfo->{'searchargs'}})->first;
    } else {
        ## merge the ignore fields array into a hash - so we can do an easy check while building the query
        my %ignorefields = map { $_ => 1} @{$self->{'config'}{'ignore_fields_in_find'}},
                                    ( ref $authinfo->{'ignore_fields'} eq 'ARRAY' ? @{$authinfo->{'ignore_fields'}} : () );
                                    
        my $searchargs = {};
        
        # now we walk all the fields passed in, and build up a search hash.
        foreach my $key (grep {!$ignorefields{$_}} keys %{$authinfo}) {

            if ($self->{'resultset'}->result_source->has_column($key)) {
                $searchargs->{$key} = $authinfo->{$key};
            }
        }  
        $self->{user} = $self->{'resultset'}->search($searchargs)->first;
    }
   #$c->log->debug(dumper($self->{'user'}));

}

sub supported_features {
    my $self = shift;
    $self->{'config'}{'password_type'} = 'clear';

    return {
        password => {
            $self->{'config'}{'password_type'} => 1,
        },
        session         => 1,
        roles           => 1,
    };
}


sub roles {
    my ( $self, @wanted_roles ) = @_;

    ## shortcut if we have already retrieved them
    if (ref $self->{'roles'} eq 'ARRAY') {
        return(@{$self->{'roles'}});
    }
    
    my @roles = ();
    if (exists($self->{'config'}{'role_column'})) {
        @roles = split /[ ,\|]/, $self->get($self->{'config'}{'role_column'});
        $self->{'roles'} = \@roles;
    } elsif (exists($self->{'config'}{'role_relation'})) {
        my $relation = $self->{'config'}{'role_relation'};
        if ($self->{'user'}->$relation->result_source->has_column($self->{'config'}{'role_field'})) {
            @roles = $self->{'user'}->$relation->search(undef, { columns => [ $self->{'config'}{'role_field'}]})->all();
        } else {
            Catalyst::Exception->throw("role table does not have a column called " . $self->{'config'}{'role_field'});
        }
        my $rolefield = $self->{'config'}{'role_field'};
        @{$self->{'roles'}} =  map { $_->get_column($self->{'config'}{'role_field'}) } @roles;
    } else {
        Catalyst::Exception->throw("user->roles accessed, but no role configuration found");
    }

    return @{$self->{'roles'}};
}

sub for_session {
    shift->id;
}

sub get {
    my ($self, $field) = @_;
    
    if ($self->{'user'}->can($field)) {
        return $self->{'user'}->$field;
    } else {
        return undef;
    }
}

sub obj {
    my $self = shift;
    return $self->get_object;
}

sub get_object {
    my $self = shift;
    
    return $self->{'user'};
}

sub AUTOLOAD {
    my $self = shift;
    (my $method) = (our $AUTOLOAD =~ /([^:]+)$/);
    return if $method eq "DESTROY";

    $self->{'user'}->$method(@_);
}

1;
__END__

=head1 NAME

Catalyst::Plugin::Authentication::Store::DBIx::Class::User - A class to ...

=head1 VERSION

This documentation refers to version 0.01.

=head1 SYNOPSIS

use Catalyst::Plugin::Authentication::Store::DBIx::Class::User;

=head1 DESCRIPTION

The Catalyst::Plugin::Authentication::Store::DBIx::Class::User class implements ...

=head1 SUBROUTINES / METHODS

=head2 new (constructor)

Parameters:
    class
    authinfo
    config
    c
    lazyload

Insert description of constructor here...

=head2 load_user (method)

Parameters:
    authinfo
    c

Insert description of method here...

=head2 supported_features (method)

Parameters:
    none

Insert description of method here...

=head2 roles

Parameters:
    none

Insert description of subroutine here...

=head2 for_session

Parameters:
    none

Insert description of subroutine here...

=head2 get (method)

Parameters:
    field

Insert description of method here...

=head2 obj (method)

Parameters:
    none

Insert description of method here...

=head2 get_object (method)

Parameters:
    none

Insert description of method here...

=head2 AUTOLOAD (method)

Parameters:
    none

Insert description of method here...

=head1 DEPENDENCIES

Modules used, version dependencies, core yes/no

strict

warnings

=head1 NOTES

...

=head1 BUGS AND LIMITATIONS

None known currently, please email the author if you find any.

=head1 AUTHOR

Jason Kuri (jk@domain.tld)

=head1 LICENCE

Copyright 2006 by Jason Kuri.

This software is free.  It is licensed under the same terms as Perl itself.

=cut