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