lib/Catalyst/Plugin/Authentication/User/Hash.pm

   1 package Catalyst::Plugin::Authentication::User::Hash;
   2 use base qw/Catalyst::Plugin::Authentication::User/;
   3
   4 use strict;
   5 use warnings;
   6
   7 sub new {
   8     my $class = shift;
   9
  10     bless { ( @_ > 1 ) ? @_ : %{ $_[0] } }, $class;
  11 }
  12
  13 sub AUTOLOAD {
  14     my $self = shift;
  15     ( my $key ) = ( our $AUTOLOAD =~ m/([^:]*)$/ );
  16
  17     $self->_accessor( $key, @_ );
  18 }
  19
  20 # this class effectively handles any method calls
  21 sub can { 1 }
  22
  23 sub id {
  24     my $self = shift;
  25     $self->_accessor( "id", @_ );
  26 }
  27
  28 ## deprecated. Let the base class handle this.
  29 #    sub store {
  30 #        my $self = shift;
  31 #        $self->_accessor( "store", @_ ) || ref $self;
  32 #    }
  33
  34 sub _accessor {
  35     my $self = shift;
  36     my $key  = shift;
  37
  38     if (@_) {
  39         my $arr = $self->{__hash_obj_key_is_array}{$key} = @_ > 1;
  40         $self->{$key} = $arr ? [@_] : shift;
  41     }
  42
  43     my $data = $self->{$key};
  44     ( $self->{__hash_obj_key_is_array}{$key} || $key =~ /roles/ )
  45       ? @{ $data || [] }
  46       : $data;
  47 }
  48
  49 ## password portion of this is no longer necessary, but here for backwards compatibility.
  50 my %features = (
  51     password => {
  52         clear      => ["password"],
  53         crypted    => ["crypted_password"],
  54         hashed     => [qw/hashed_password hash_algorithm/],
  55         self_check => undef,
  56     },
  57     roles   => ["roles"],
  58     session => 1,
  59 );
  60
  61 sub supports {
  62     my ( $self, @spec ) = @_;
  63
  64     my $cursor = \%features;
  65
  66     return 1 if @spec == 1 and exists $self->{ $spec[0] };
  67
  68     # traverse the feature list,
  69     for (@spec) {
  70         return if ref($cursor) ne "HASH";
  71         $cursor = $cursor->{$_};
  72     }
  73
  74     if ( ref $cursor ) {
  75         die "bad feature spec: @spec" unless ref $cursor eq "ARRAY";
  76
  77         # check that all the keys required for a feature are in here
  78         foreach my $key (@$cursor) {
  79             return undef unless exists $self->{$key};
  80         }
  81
  82         return 1;
  83     }
  84     else {
  85         return $cursor;
  86     }
  87 }
  88
  89 sub for_session {
  90     my $self = shift;
  91
  92     return $self; # we serialize the whole user
  93 }
  94
  95 sub from_session {
  96     my ( $self, $c, $user ) = @_;
  97     $user;
  98 }
  99
 100 __PACKAGE__;
 101
 102 __END__
 103
 104 =pod
 105
 106 =head1 NAME
 107
 108 Catalyst::Plugin::Authentication::User::Hash - An easy authentication user
 109 object based on hashes.
 110
 111 =head1 SYNOPSIS
 112
 113         use Catalyst::Plugin::Authentication::User::Hash;
 114
 115         Catalyst::Plugin::Authentication::User::Hash->new(
 116                 password => "s3cr3t",
 117         );
 118
 119 =head1 DESCRIPTION
 120
 121 This implementation of authentication user handles is supposed to go hand in
 122 hand with L<Catalyst::Plugin::Authentication::Store::Minimal>.
 123
 124 =head1 METHODS
 125
 126 =over 4
 127
 128 =item new @pairs
 129
 130 Create a new object with the key-value-pairs listed in the arg list.
 131
 132 =item supports
 133
 134 Checks for existence of keys that correspond with features.
 135
 136 =item for_session
 137
 138 Just returns $self, expecting it to be serializable.
 139
 140 =item from_session
 141
 142 Just passes returns the unserialized object, hoping it's intact.
 143
 144 =item AUTOLOAD
 145
 146 Accessor for the key whose name is the method.
 147
 148 =item id
 149
 150 =item store
 151
 152 Accessors that override superclass's dying virtual methods.
 153
 154 =back
 155
 156 =head1 SEE ALSO
 157
 158 L<Hash::AsObject>
 159
 160 =cut
 161
 162