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

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