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