Catalyst::Authentication::User::Hash - An easy authentication user

Catalyst-Plugin-Authentication documentation Contained in the Catalyst-Plugin-Authentication distribution.

Index

Code Index:

NAME

Top

Catalyst::Authentication::User::Hash - An easy authentication user object based on hashes.

SYNOPSIS

Top

	use Catalyst::Authentication::User::Hash;

	Catalyst::Authentication::User::Hash->new(
		password => "s3cr3t",
	);

DESCRIPTION

Top

This implementation of authentication user handles is supposed to go hand in hand with Catalyst::Authentication::Store::Minimal.

METHODS

Top

new( @pairs )

Create a new object with the key-value-pairs listed in the arg list.

supports( )

Checks for existence of keys that correspond with features.

for_session( )

Just returns $self, expecting it to be serializable.

from_session( )

Just passes returns the unserialized object, hoping it's intact.

AUTOLOAD( )

Accessor for the key whose name is the method.

store( )

Accessors that override superclass's dying virtual methods.

id( )

can( )

SEE ALSO

Top

Hash::AsObject

Catalyst-Plugin-Authentication documentation Contained in the Catalyst-Plugin-Authentication distribution. 
package Catalyst::Authentication::User::Hash;

use strict;
use warnings;

use base qw/Catalyst::Authentication::User/;

sub new {
    my $class = shift;

    bless { ( @_ > 1 ) ? @_ : %{ $_[0] } }, $class;
}

sub AUTOLOAD {
    my $self = shift;
    ( my $key ) = ( our $AUTOLOAD =~ m/([^:]*)$/ );

    $self->_accessor( $key, @_ );
}

# this class effectively handles any method calls
sub can { 1 }

sub id {
    my $self = shift;
    $self->_accessor( "id", @_ );
}

## deprecated. Let the base class handle this.
#    sub store {
#        my $self = shift;
#        $self->_accessor( "store", @_ ) || ref $self;
#    }

sub _accessor {
    my $self = shift;
    my $key  = shift;

    if (@_) {
        my $arr = $self->{__hash_obj_key_is_array}{$key} = @_ > 1;
        $self->{$key} = $arr ? [@_] : shift;
    }

    my $data = $self->{$key};
    ( $self->{__hash_obj_key_is_array}{$key} || $key =~ /roles/ )
      ? @{ $data || [] }
      : $data;
}

## password portion of this is no longer necessary, but here for backwards compatibility.
my %features = (
    password => {
        clear      => ["password"],
        crypted    => ["crypted_password"],
        hashed     => [qw/hashed_password hash_algorithm/],
        self_check => undef,
    },
    roles   => ["roles"],
    session => 1,
);

sub supports {
    my ( $self, @spec ) = @_;

    my $cursor = \%features;

    return 1 if @spec == 1 and exists $self->{ $spec[0] };

    # traverse the feature list,
    for (@spec) {
        return if ref($cursor) ne "HASH";
        $cursor = $cursor->{$_};
    }

    if ( ref $cursor ) {
        die "bad feature spec: @spec" unless ref $cursor eq "ARRAY";

        # check that all the keys required for a feature are in here
        foreach my $key (@$cursor) {
            return undef unless exists $self->{$key};
        }

        return 1;
    }
    else {
        return $cursor;
    }
}

sub for_session {
    my $self = shift;
    
    return $self; # we serialize the whole user
}

sub from_session {
    my ( $self, $c, $user ) = @_;
    $user;
}

__PACKAGE__;

__END__