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