| Catalyst-Authentication-Store-KiokuDB documentation | Contained in the Catalyst-Authentication-Store-KiokuDB distribution. |
Catalyst::Authentication::User::KiokuDB - User object for KiokuDB
use Catalyst::Authentication::User::KiokuDB; Catalyst::Authentication::User::KiokuDB->new( username => "kitteh", password => "baddog", roles => [qw/sleep eat play purr/], );
This implementation of authentication user object is intended to go hand in hand with Catalyst::Authentication::Store::KiokuDB.
Implements nothing beyond the requisite interface from its superclass
Robin Berjon, <robin@berjon.com>, http://robineko.com/
This program is free software, you can redistribute it and/or modify it under the same terms as Perl itself.
| Catalyst-Authentication-Store-KiokuDB documentation | Contained in the Catalyst-Authentication-Store-KiokuDB distribution. |
package Catalyst::Authentication::User::KiokuDB; use Moose; use base qw/Catalyst::Authentication::User/; has id => ( isa => 'Str', is => 'rw', ); has username => ( isa => 'Str', is => 'rw', ); has password => ( isa => 'Str', is => 'rw', ); has crypted_password => ( isa => 'Str', is => 'rw', ); has hashed_password => ( isa => 'Str', is => 'rw', ); has hash_algorithm => ( isa => 'Str', is => 'rw', ); has roles => ( isa => 'ArrayRef', is => 'rw', auto_deref => 1, ); sub TO_JSON { my $self = shift; my %ret; for my $k (qw/id username password crypted_password hashed_password hash_algorithm roles/) { my $v = $self->$k; $ret{$k} = $v if defined $v; } return \%ret; } # all hail the gods of cut and paste 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 $self->can($spec[0]); # XXX is this correct? for (@spec) { return if ref($cursor) ne "HASH"; $cursor = $cursor->{$_}; } if (ref $cursor) { die "Bad feature spec: '@spec'" unless ref $cursor eq "ARRAY"; foreach my $key (@$cursor) { return undef unless $self->can($key); } return 1; } else { return $cursor; } } sub for_session { my $self = shift; return $self; # KiokuDB should be fine with storing objects in the session } sub from_session { my ($self, $c, $user) = @_; return $user; # normally we should have gotten ourselves back } no Moose; 1;