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 { @_ }, $class;
  13 }
  14
  15 sub AUTOLOAD {
  16     my $self = shift;
  17     ( my $key ) = ( our $AUTOLOAD =~ m/([^:]*)$/ );
  18
  19
  20         if ( @_ ) {
  21                 my $arr = $self->{__hash_obj_key_is_array}{$key} = @_ > 1;
  22                 $self->{$key} = $arr ? [ @_ ] : shift;
  23         }
  24
  25         my $data = $self->{$key};
  26     $self->{__hash_obj_key_is_array}{$key} ? @$data : $data;
  27 }
  28
  29 my %features = (
  30     password => {
  31         clear   => ["password"],
  32         crypted => ["crypted_password"],
  33         hashed  => [qw/hashed_password hash_algorithm/],
  34                 self_check => undef,
  35     },
  36         roles => ["roles"],
  37     session => 1,
  38 );
  39
  40 sub supports {
  41     my ( $self, @spec ) = @_;
  42
  43     my $cursor = \%features;
  44
  45     # traverse the feature list,
  46     for (@spec) {
  47         die "bad feature spec: @spec"
  48           if ref($cursor) ne "HASH";
  49         $cursor = $cursor->{$_};
  50     }
  51
  52         if (ref $cursor) {
  53                 die "bad feature spec: @spec" unless ref $cursor eq "ARRAY";
  54
  55                 # check that all the keys required for a feature are in here
  56                 foreach my $key (@$cursor) {
  57                         return undef unless exists $self->{$key};
  58                 }
  59
  60                 return 1;
  61         } else {
  62                 return $cursor;
  63         }
  64 }
  65
  66 sub for_session {
  67     my $self = shift;
  68
  69     return $self;    # let's hope we're serialization happy
  70 }
  71
  72 sub from_session {
  73     my ( $self, $c, $user ) = @_;
  74
  75     return $user;    # if we're serialization happy this should work
  76 }
  77
  78 __PACKAGE__;
  79
  80 __END__
  81
  82 =pod
  83
  84 =head1 NAME
  85
  86 Catalyst::Plugin::Authentication::User::Hash - An easy authentication user
  87 object based on hashes.
  88
  89 =head1 SYNOPSIS
  90
  91         use Catalyst::Plugin::Authentication::User::Hash;
  92
  93         Catalyst::Plugin::Authentication::User::Hash->new(
  94                 password => "s3cr3t",
  95         );
  96
  97 =head1 DESCRIPTION
  98
  99 This implementation of authentication user handles is supposed to go hand in
 100 hand with L<Catalyst::Plugin::Authentication::Store::Minimal>.
 101
 102 =head1 METHODS
 103
 104 =over 4
 105
 106 =item new @pairs
 107
 108 Create a new object with the key-value-pairs listed in the arg list.
 109
 110 =item supports
 111
 112 Checks for existence of keys that correspond with features.
 113
 114 =item for_session
 115
 116 Just returns $self, expecting it to be serializable.
 117
 118 =item from_session
 119
 120 Just passes returns the unserialized object, hoping it's intact.
 121
 122 =item AUTOLOAD
 123
 124 Accessor for the key whose name is the method.
 125
 126 =back
 127
 128 =head1 SEE ALSO
 129
 130 L<Hash::AsObject>
 131
 132 =cut
 133
 134