File Coverage

blib/lib/Catalyst/Authentication/Store/Htpasswd/User.pm
Criterion Covered Total %
statement 26 29 89.6
branch 2 6 33.3
condition n/a
subroutine 11 12 91.6
pod 5 5 100.0
total 44 52 84.6


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Catalyst::Authentication::Store::Htpasswd::User;
4 5     5   19 use base qw/Catalyst::Authentication::User Class::Accessor::Fast/;
  5         6  
  5         2471  
5              
6 5     5   1411986 use strict;
  5         8  
  5         89  
7 5     5   33 use warnings;
  5         6  
  5         173  
8              
9 5     5   34 BEGIN { __PACKAGE__->mk_accessors(qw/_user _store/) }
10              
11 5     5   21244 use overload '""' => sub { shift->id }, fallback => 1;
  5     2   9  
  5         48  
  2         9926  
12              
13             sub new {
14 4     4 1 38 my ( $class, $store, $user ) = @_;
15              
16 4 50       67 return unless $user;
17              
18 4         44 bless { _store => $store, _user => $user }, $class;
19             }
20              
21             sub id {
22 4     4 1 1329 my $self = shift;
23 4         14 return $self->_user->username;
24             }
25              
26             sub supported_features {
27             return {
28 4     4 1 59 password => {
29             self_check => 1,
30             },
31             session => 1,
32             roles => 1,
33             };
34             }
35              
36             sub check_password {
37 3     3 1 1135 my ( $self, $password ) = @_;
38 3         38 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             *for_session = \&id;
48              
49             *get_object = \&_user;
50              
51             sub AUTOLOAD {
52 2     2   103 my $self = shift;
53            
54 2         13 ( my $method ) = ( our $AUTOLOAD =~ /([^:]+)$/ );
55              
56 2 50       5 return if $method eq "DESTROY";
57            
58 2         5 $self->_user->$method;
59             }
60              
61             1;
62              
63             __END__
64              
65             =pod
66              
67             =head1 NAME
68              
69             Catalyst::Authentication::Store::Htpasswd::User - A user object
70             representing an entry in an htpasswd file.
71              
72             =head1 DESCRIPTION
73              
74             This object wraps an L<Authen::Htpasswd::User> object. An instance of it will be returned
75             by C<< $c->user >> when using L<Catalyst::Authentication::Store::Htpasswd>. Methods
76             not defined in this module are passed through to the L<Authen::Htpasswd::User> object. The
77             object stringifies to the username.
78              
79             =head1 METHODS
80              
81             =head2 new($store,$user)
82              
83             Creates a new object from a store object, normally an instance of
84             L<Catalyst::Authentication::Store::Htpasswd::Backend>, and a user object,
85             normally an instance of L<Authen::Htpasswd::User>.
86              
87             =head2 id
88              
89             Returns the username.
90              
91             =head2 check_password($password)
92              
93             Returns whether the password is valid.
94              
95             =head2 roles
96              
97             Returns an array of roles, which is extracted from a comma-separated list in the
98             third field of the htpasswd file.
99              
100             =head2 for_session
101              
102             Returns the username, which is then stored in the session.
103              
104             =head2 supported_features
105              
106             Returns data about which featurs this user module supports.
107              
108             =head2 get_object
109              
110             Returns the underlieing L<Authen::Htpasswd::User> object for this user
111              
112             =head1 AUTHORS
113              
114             Yuval Kogman C<nothingmuch@woobling.org>
115              
116             David Kamholz C<dkamholz@cpan.org>
117              
118             Tomas Doran C<bobtfish@bobtfish.net>
119              
120             =head1 COPYRIGHT & LICENSE
121              
122             Copyright (c) 2005 the aforementioned authors. All rights
123             reserved. This program is free software; you can redistribute
124             it and/or modify it under the same terms as Perl itself.
125              
126             =cut
127              
128