/usr/share/perl5/Catalyst/Authentication/User/Hash.pm is in libcatalyst-plugin-authentication-perl 0.10023-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 | 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
|