Convert everything not actually a plugin to now live in the

[catagits/Catalyst-Plugin-Authentication.git] / lib / Catalyst / Authentication / User / Hash.pm

diff --git a/lib/Catalyst/Authentication/User/Hash.pm b/lib/Catalyst/Authentication/User/Hash.pm
new file mode 100644 (file)
index 0000000..3fd47ce
--- /dev/null
+++ b/lib/Catalyst/Authentication/User/Hash.pm
@@ -0,0 +1,161 @@
+package Catalyst::Authentication::User::Hash;
+
+use strict;
+use warnings;
+
+use base qw/Catalyst::Authentication::User/;
+
+sub new {
+    my $class = shift;
+
+    bless { ( @_ > 1 ) ? @_ : %{ $_[0] } }, $class;
+}
+
+sub AUTOLOAD {
+    my $self = shift;
+    ( my $key ) = ( our $AUTOLOAD =~ m/([^:]*)$/ );
+
+    $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;
+
+    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,
+    },
+    roles   => ["roles"],
+    session => 1,
+);
+
+sub supports {
+    my ( $self, @spec ) = @_;
+
+    my $cursor = \%features;
+
+    return 1 if @spec == 1 and exists $self->{ $spec[0] };
+
+    # traverse the feature list,
+    for (@spec) {
+        return if ref($cursor) ne "HASH";
+        $cursor = $cursor->{$_};
+    }
+
+    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};
+        }
+
+        return 1;
+    }
+    else {
+        return $cursor;
+    }
+}
+
+sub for_session {
+    my $self = shift;
+    
+    return $self; # we serialize the whole user
+}
+
+sub from_session {
+    my ( $self, $c, $user ) = @_;
+    $user;
+}
+
+__PACKAGE__;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Authentication::User::Hash - An easy authentication user
+object based on hashes.
+
+=head1 SYNOPSIS
+
+       use Catalyst::Authentication::User::Hash;
+       
+       Catalyst::Authentication::User::Hash->new(
+               password => "s3cr3t",
+       );
+
+=head1 DESCRIPTION
+
+This implementation of authentication user handles is supposed to go hand in
+hand with L<Catalyst::Authentication::Store::Minimal>.
+
+=head1 METHODS
+
+=head2 new( @pairs )
+
+Create a new object with the key-value-pairs listed in the arg list.
+
+=head2 supports( )
+
+Checks for existence of keys that correspond with features.
+
+=head2 for_session( )
+
+Just returns $self, expecting it to be serializable.
+
+=head2 from_session( )
+
+Just passes returns the unserialized object, hoping it's intact.
+
+=head2 AUTOLOAD( )
+
+Accessor for the key whose name is the method.
+
+=head2 store( )
+
+Accessors that override superclass's dying virtual methods.
+
+=head2 id( )
+
+=head2 can( )
+
+=head1 SEE ALSO
+
+L<Hash::AsObject>
+
+=cut
+
+