-#!/usr/bin/perl
-
package Catalyst::Plugin::Authentication::User::Hash;
use base qw/Catalyst::Plugin::Authentication::User/;
use warnings;
sub new {
- my $class = shift;
+ my $class = shift;
- bless { @_ }, $class;
+ bless { ( @_ > 1 ) ? @_ : %{ $_[0] } }, $class;
}
sub AUTOLOAD {
my $self = shift;
( my $key ) = ( our $AUTOLOAD =~ m/([^:]*)$/ );
-
- if ( @_ ) {
- my $arr = $self->{__hash_obj_key_is_array}{$key} = @_ > 1;
- $self->{$key} = $arr ? [ @_ ] : shift;
- }
+ $self->_accessor( $key, @_ );
+}
+
+# this class effectively handles any method calls
+sub can { 1 }
+
+sub id {
+ my $self = shift;
+ $self->_accessor( "id", @_ );
+}
+
+## deprecated. Let the base class handle this.
+# sub store {
+# my $self = shift;
+# $self->_accessor( "store", @_ ) || ref $self;
+# }
+
+sub _accessor {
+ my $self = shift;
+ my $key = shift;
- my $data = $self->{$key};
- $self->{__hash_obj_key_is_array}{$key} ? @$data : $data;
+ if (@_) {
+ my $arr = $self->{__hash_obj_key_is_array}{$key} = @_ > 1;
+ $self->{$key} = $arr ? [@_] : shift;
+ }
+
+ my $data = $self->{$key};
+ ( $self->{__hash_obj_key_is_array}{$key} || $key =~ /roles/ )
+ ? @{ $data || [] }
+ : $data;
}
+## password portion of this is no longer necessary, but here for backwards compatibility.
my %features = (
password => {
- clear => ["password"],
- crypted => ["crypted_password"],
- hashed => [qw/hashed_password hash_algorithm/],
- self_check => undef,
+ clear => ["password"],
+ crypted => ["crypted_password"],
+ hashed => [qw/hashed_password hash_algorithm/],
+ self_check => undef,
},
- roles => ["roles"],
+ roles => ["roles"],
session => 1,
);
my $cursor = \%features;
+ return 1 if @spec == 1 and exists $self->{ $spec[0] };
+
# traverse the feature list,
for (@spec) {
- die "bad feature spec: @spec"
- if ref($cursor) ne "HASH";
+ return if ref($cursor) ne "HASH";
$cursor = $cursor->{$_};
}
- if (ref $cursor) {
- die "bad feature spec: @spec" unless ref $cursor eq "ARRAY";
+ if ( ref $cursor ) {
+ die "bad feature spec: @spec" unless ref $cursor eq "ARRAY";
- # check that all the keys required for a feature are in here
- foreach my $key (@$cursor) {
- return undef unless exists $self->{$key};
- }
+ # check that all the keys required for a feature are in here
+ foreach my $key (@$cursor) {
+ return undef unless exists $self->{$key};
+ }
- return 1;
- } else {
- return $cursor;
- }
+ return 1;
+ }
+ else {
+ return $cursor;
+ }
}
sub for_session {
my $self = shift;
-
- return $self; # let's hope we're serialization happy
+
+ return $self; # we serialize the whole user
}
sub from_session {
my ( $self, $c, $user ) = @_;
-
- return $user; # if we're serialization happy this should work
+ $user;
}
__PACKAGE__;
Accessor for the key whose name is the method.
+=item id
+
+=item store
+
+Accessors that override superclass's dying virtual methods.
+
=back
=head1 SEE ALSO