File Coverage

blib/lib/Catalyst/Authentication/Store/Htpasswd.pm
Criterion Covered Total %
statement 36 36 100.0
branch 5 8 62.5
condition 2 4 50.0
subroutine 11 11 100.0
pod 4 4 100.0
total 58 63 92.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Catalyst::Authentication::Store::Htpasswd; # git description: v1.004-4-g52efa08
4             # ABSTRACT: Authen::Htpasswd based user storage/authentication
5              
6 4     4   2049837 use base qw/Class::Accessor::Fast/;
  4         12  
  4         1752  
7 4     4   11605 use strict;
  4         13  
  4         70  
8 4     4   20 use warnings;
  4         16  
  4         109  
9              
10 4     4   1757 use Authen::Htpasswd 0.13;
  4         41228  
  4         26  
11 4     4   1953 use Catalyst::Authentication::Store::Htpasswd::User;
  4         14  
  4         45  
12 4     4   148 use Scalar::Util qw/blessed/;
  4         10  
  4         293  
13              
14             our $VERSION = '1.005';
15              
16 4     4   43 BEGIN { __PACKAGE__->mk_accessors(qw/file user_field user_class/) }
17              
18             sub new {
19 3     3 1 28503 my ($class, $config, $app, $realm) = @_;
20            
21 3         10 my $file = delete $config->{file};
22 3 100       14 unless (ref $file) {
23 1 50       16 my $filename = ($file =~ m|^/|) ? $file : $app->path_to($file)->stringify;
24 1 50       509 die("Cannot find htpasswd file: $filename\n") unless (-r $filename);
25 1         9 $file = Authen::Htpasswd->new($filename);
26             }
27 3         4186 $config->{file} = $file;
28 3   50     27 $config->{user_class} ||= __PACKAGE__ . '::User';
29 3   50     19 $config->{user_field} ||= 'username';
30            
31 3         28 bless { %$config }, $class;
32             }
33              
34             sub find_user {
35 4     4 1 44565 my ($self, $authinfo, $c) = @_;
36 4         18 my $htpasswd_user = $self->file->lookup_user($authinfo->{$self->user_field});
37 4         2125 $self->user_class->new( $self, $htpasswd_user );
38             }
39              
40             sub user_supports {
41 3     3 1 17738 my $self = shift;
42              
43             # this can work as a class method, but in that case you can't have
44             # a custom user class
45 3 50       40 ref($self) ? $self->user_class->supports(@_)
46             : Catalyst::Authentication::Store::Htpasswd::User->supports(@_);
47             }
48              
49             sub from_session {
50 1     1 1 111 my ( $self, $c, $id ) = @_;
51 1         5 $self->find_user( { username => $id } );
52             }
53              
54             1;
55              
56             __END__
57              
58             =pod
59              
60             =encoding UTF-8
61              
62             =head1 NAME
63              
64             Catalyst::Authentication::Store::Htpasswd - Authen::Htpasswd based user storage/authentication
65              
66             =head1 VERSION
67              
68             version 1.005
69              
70             =head1 SYNOPSIS
71              
72             use Catalyst qw/
73             Authentication
74             /;
75              
76             __PACKAGE__->config(
77             authentication => {
78             default_realm => 'test',
79             realms => {
80             test => {
81             credential => {
82             class => 'Password',
83             password_field => 'password',
84             password_type => 'self_check',
85             },
86             store => {
87             class => 'Htpasswd',
88             file => 'htpasswd',
89             },
90             },
91             },
92             },
93             );
94              
95             sub login : Global {
96             my ( $self, $c ) = @_;
97              
98             $c->authenticate({ username => $c->req->param("login"), password => $c->req->param("password") });
99             }
100              
101             =head1 DESCRIPTION
102              
103             This plugin uses L<Authen::Htpasswd> to let your application use C<<.htpasswd>>
104             files for it's authentication storage.
105              
106             =head1 METHODS
107              
108             =head2 new
109              
110             Simple constructor, dies if the htpassword file can't be found
111              
112             =head2 find_user
113              
114             Looks up the user, and returns a Catalyst::Authentication::Store::Htpasswd::User object.
115              
116             =head2 user_supports
117              
118             Delegates to L<Catalyst::Authentication::Store::Htpasswd::User->user_supports|Catalyst::Authentication::Store::Htpasswd::User#user_supports>
119              
120             =head2 from_session
121              
122             Delegates the user lookup to C<< find_user >>
123              
124             =head1 CONFIGURATION
125              
126             =head2 file
127              
128             The path to the htpasswd file. If the path starts with a slash, then it is assumed to be a fully
129             qualified path, otherwise the path is fed through C<< $c->path_to >> and so normalised to the
130             application root.
131              
132             Alternatively, it is possible to pass in an L<Authen::Htpasswd> object here, and this will be
133             used as the htpasswd file.
134              
135             =head2 user_class
136              
137             Change the user class which this store returns. Defaults to L<Catalyst::Authentication::Store::Htpasswd::User>.
138             This can be used to add additional functionality to the user class by sub-classing it, but will not normally be
139             needed.
140              
141             =head2 user_field
142              
143             Change the field that the username is found in in the information passed into the call to C<< $c->authenticate() >>.
144              
145             This defaults to I< username >, and generally you should be able to use the module as shown in the synopsis, however
146             if you need a different field name then this setting can change the default.
147              
148             Example:
149              
150             __PACKAGE__->config( authentication => { realms => { test => {
151             store => {
152             class => 'Htpasswd',
153             user_field => 'email_address',
154             },
155             }}});
156             # Later in your code
157             $c->authenticate({ email_address => $c->req->param("email"), password => $c->req->param("password") });
158              
159             =head1 SEE ALSO
160              
161             L<Authen::Htpasswd>.
162              
163             =head1 SUPPORT
164              
165             Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Catalyst-Authentication-Store-Htpasswd>
166             (or L<bug-Catalyst-Authentication-Store-Htpasswd@rt.cpan.org|mailto:bug-Catalyst-Authentication-Store-Htpasswd@rt.cpan.org>).
167              
168             There is also a mailing list available for users of this distribution, at
169             L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst>.
170              
171             There is also an irc channel available for users of this distribution, at
172             L<C<#catalyst> on C<irc.perl.org>|irc://irc.perl.org/#catalyst>.
173              
174             =head1 AUTHOR
175              
176             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
177              
178             =head1 CONTRIBUTORS
179              
180             =for stopwords David Kamholz Tomas Doran Karen Etheridge Tom Bloor Ilmari Vacklin
181              
182             =over 4
183              
184             =item *
185              
186             David Kamholz <dkamholz@cpan.org>
187              
188             =item *
189              
190             Tomas Doran <bobtfish@bobtfish.net>
191              
192             =item *
193              
194             Karen Etheridge <ether@cpan.org>
195              
196             =item *
197              
198             Tom Bloor <t.bloor@shadowcat.co.uk>
199              
200             =item *
201              
202             Ilmari Vacklin <ilmari.vacklin@cs.helsinki.fi>
203              
204             =back
205              
206             =head1 COPYRIGHT AND LICENCE
207              
208             This software is copyright (c) 2005 by יובל קוג'מן (Yuval Kogman).
209              
210             This is free software; you can redistribute it and/or modify it under
211             the same terms as the Perl 5 programming language system itself.
212              
213             =cut