File Coverage

blib/lib/Catalyst/Plugin/Authentication/Store/Htpasswd/User.pm
Criterion Covered Total %
statement 27 31 87.1
branch 2 6 33.3
condition n/a
subroutine 11 13 84.6
pod 4 6 66.6
total 44 56 78.5


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Catalyst::Plugin::Authentication::Store::Htpasswd::User;
4 2     2   8 use base qw/Catalyst::Plugin::Authentication::User Class::Accessor::Fast/;
  2         2  
  2         825  
5              
6 2     2   662063 use strict;
  2         4  
  2         33  
7 2     2   6 use warnings;
  2         2  
  2         53  
8              
9 2     2   12 BEGIN { __PACKAGE__->mk_accessors(qw/user store/) }
10              
11 2     2   11981 use overload '""' => sub { shift->id }, fallback => 1;
  2     0   4  
  2         20  
  0         0  
12              
13             sub new {
14 3     3 1 712 my ( $class, $store, $user ) = @_;
15              
16 3 50       10 return unless $user;
17              
18 3         27 bless { store => $store, user => $user }, $class;
19             }
20              
21             sub id {
22 1     1 1 1 my $self = shift;
23 1         3 return $self->user->username;
24             }
25              
26             sub supported_features {
27             return {
28 4     4 0 56 password => {
29             self_check => 1,
30             },
31             session => 1,
32             roles => 1,
33             };
34             }
35              
36             sub check_password {
37 2     2 1 579 my ( $self, $password ) = @_;
38 2         12 return $self->user->check_password( $password );
39             }
40              
41             sub roles {
42 0     0 1 0 my $self = shift;
43 0         0 my $field = $self->user->extra_info->[0];
44 0 0       0 return defined $field ? split /,/, $field : ();
45             }
46              
47             sub for_session {
48 1     1 0 1450 my $self = shift;
49 1         3 return $self->id;
50             }
51              
52             sub AUTOLOAD {
53 2     2   109 my $self = shift;
54            
55 2         16 ( my $method ) = ( our $AUTOLOAD =~ /([^:]+)$/ );
56              
57 2 50       6 return if $method eq "DESTROY";
58            
59 2         5 $self->user->$method;
60             }
61              
62             __PACKAGE__;
63              
64             __END__
65              
66             =pod
67              
68             =head1 NAME
69              
70             Catalyst::Plugin::Authentication::Store::Htpasswd::User - A user object
71             representing an entry in an htpasswd file.
72              
73             =head1 DESCRIPTION
74              
75             This object wraps an L<Authen::Htpasswd::User> object. An instance of it will be returned
76             by C<< $c->user >> when using L<Catalyst::Plugin::Authentication::Store::Htpasswd>. Methods
77             not defined in this module are passed through to the L<Authen::Htpasswd::User> object. The
78             object stringifies to the username.
79              
80             =head1 METHODS
81              
82             =head2 new($store,$user)
83              
84             Creates a new object from a store object, normally an instance of
85             L<Catalyst::Plugin::Authentication::Store::Htpasswd::Backend>, and a user object,
86             normally an instance of L<Authen::Htpasswd::User>.
87              
88             =head2 id
89              
90             Returns the username.
91              
92             =head2 check_password($password)
93              
94             Returns whether the password is valid.
95              
96             =head2 roles
97              
98             Returns an array of roles, which is extracted from a comma-separated list in the
99             third field of the htpasswd file.
100              
101             =head1 COPYRIGHT & LICENSE
102              
103             Copyright (c) 2005 the aforementioned authors. All rights
104             reserved. This program is free software; you can redistribute
105             it and/or modify it under the same terms as Perl itself.
106              
107             =cut
108              
109