Add small example to Store.pod
[catagits/Catalyst-Plugin-Authentication.git] / lib / Catalyst / Plugin / Authentication / User / Hash.pm
CommitLineData
06675d2e 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 {
c8cdf03d 10 my $class = shift;
06675d2e 11
e300c5b6 12 bless { ( @_ > 1 ) ? @_ : %{ $_[0] } }, $class;
06675d2e 13}
14
15sub AUTOLOAD {
16 my $self = shift;
17 ( my $key ) = ( our $AUTOLOAD =~ m/([^:]*)$/ );
18
96777f3a 19 $self->_accessor( $key, @_ );
20}
21
22sub id {
23 my $self = shift;
24 $self->_accessor( "id", @_ );
25}
26
27sub store {
28 my $self = shift;
12dae309 29 ref $self || $self;
96777f3a 30}
31
32sub _accessor {
33 my $self = shift;
34 my $key = shift;
35
c8cdf03d 36 if (@_) {
37 my $arr = $self->{__hash_obj_key_is_array}{$key} = @_ > 1;
38 $self->{$key} = $arr ? [@_] : shift;
39 }
22be989b 40
c8cdf03d 41 my $data = $self->{$key};
0c4ddd06 42 ( $self->{__hash_obj_key_is_array}{$key} || $key =~ /roles/ )
da422b3a 43 ? @{ $data || [] }
0c4ddd06 44 : $data;
06675d2e 45}
46
47my %features = (
48 password => {
c8cdf03d 49 clear => ["password"],
50 crypted => ["crypted_password"],
51 hashed => [qw/hashed_password hash_algorithm/],
52 self_check => undef,
06675d2e 53 },
c8cdf03d 54 roles => ["roles"],
12dae309 55 session => 1,
06675d2e 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"
22be989b 66 if ref($cursor) ne "HASH";
67 $cursor = $cursor->{$_};
06675d2e 68 }
69
c8cdf03d 70 if ( ref $cursor ) {
71 die "bad feature spec: @spec" unless ref $cursor eq "ARRAY";
06675d2e 72
c8cdf03d 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 }
06675d2e 77
c8cdf03d 78 return 1;
79 }
80 else {
81 return $cursor;
82 }
06675d2e 83}
84
85sub for_session {
86 my $self = shift;
06675d2e 87 return $self; # let's hope we're serialization happy
88}
89
12dae309 90sub from_session {
91 my ( $self, $c, $user ) = @_;
92 $user;
93}
94
06675d2e 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
4fbe2e14 143=item id
144
145=item store
146
147Accessors that override superclass's dying virtual methods.
148
06675d2e 149=back
150
151=head1 SEE ALSO
152
153L<Hash::AsObject>
154
155=cut
156
157