File Coverage

blib/lib/Authen/Htpasswd/User.pm
Criterion Covered Total %
statement 69 69 100.0
branch 30 36 83.3
condition 4 10 40.0
subroutine 16 16 100.0
pod 8 8 100.0
total 127 139 91.3


line stmt bran cond sub pod time code
1             package Authen::Htpasswd::User;
2 3     3   18 use strict;
  3         7  
  3         106  
3 3     3   16 use base 'Class::Accessor::Fast';
  3         5  
  3         299  
4 3     3   15 use Carp;
  3         6  
  3         190  
5 3     3   16 use Authen::Htpasswd;
  3         6  
  3         49  
6 3     3   1719 use Authen::Htpasswd::Util;
  3         8  
  3         252  
7              
8 3     3   3429 use overload '""' => \&to_line, bool => sub { 1 }, fallback => 1;
  3     26   2124  
  3         34  
  26         139  
9              
10             __PACKAGE__->mk_accessors(qw/ file encrypt_hash check_hashes /);
11              
12             =head1 NAME
13              
14             Authen::Htpasswd::User - represents a user line in a .htpasswd file
15              
16             =head1 SYNOPSIS
17              
18             my $user = Authen::Htpasswd::User->new($username, $password[, @extra_info], \%options);
19             my $user = $pwfile->lookup_user($username); # from Authen::Htpasswd object
20            
21             if ($user->check_password($password)) { ... }
22             if ($user->hashed_password eq $foo) { ... }
23            
24             # these are written immediately if the user was looked up from an Authen::Htpasswd object
25             $user->username('bill');
26             $user->password('bar');
27             $user->hashed_password('tIYAwma5mxexA');
28             $user->extra_info('root', 'joe@site.com', 'Joe Sysadmin');
29             $user->set(username => 'bill', password => 'foo'); # set several at once
30            
31             print $user->to_line, "\n";
32            
33             =head1 METHODS
34              
35             =head2 new
36              
37             my $userobj = Authen::Htpasswd::User->new($username, $password[, @extra_info], \%options);
38              
39             Creates a user object. You may also specify the arguments and options together in a hash:
40             C<< { username => $foo, password => $bar, extra_info => [$email, $name], ... } >>.
41              
42             =over 4
43              
44             =item encrypt_hash
45              
46             =item check_hashes
47              
48             See L.
49              
50             =item hashed_password
51              
52             Explicitly sets the value of the hashed password, rather than generating it with C.
53              
54             =back
55              
56             =cut
57              
58             sub new {
59 22     22 1 307 my $class = shift;
60 22 50       51 croak "not enough arguments" if @_ < 2;
61            
62 22 50       67 my $self = ref $_[-1] eq 'HASH' ? pop @_ : {};
63 22   50     57 $self->{encrypt_hash} ||= 'crypt';
64 22   50     45 $self->{check_hashes} ||= [ Authen::Htpasswd::Util::supported_hashes() ];
65 22         41 $self->{autocommit} = 1;
66              
67 22         44 $self->{username} = $_[0];
68 22 100 33     58 $self->{hashed_password} ||= htpasswd_encrypt($self->{encrypt_hash}, $_[1]) if defined $_[1];
69 22 100       79 $self->{extra_info} = [ @_[2..$#_] ] if defined $_[2];
70              
71 22         126 bless $self, $class;
72             }
73              
74             =head2 check_password
75              
76             $userobj->check_password($password,\@check_hashes);
77              
78             Returns whether the password matches. C is the same as for Authen::Htpasswd.
79              
80             =cut
81              
82             sub check_password {
83 16     16 1 489 my ($self,$password,$hashes) = @_;
84 16   33     78 $hashes ||= $self->check_hashes;
85 16         106 foreach my $hash (@$hashes) {
86 49 100       165411 return 1 if $self->hashed_password eq htpasswd_encrypt($hash, $password, $self->hashed_password);
87             }
88 6         54 return 0;
89             }
90              
91             =head2 username
92              
93             =head2 hashed_password
94              
95             =head2 extra_info(@fields)
96              
97             Get and set the fields of the user line. These methods, as well as C and C below, write
98             any changes immediately if the user was lookup up from an Authen::Htpasswd object. If the username is
99             changed, the old entry is I preserved.
100              
101             =cut
102              
103             sub username {
104 14     14 1 731 my $self = shift;
105 14 100       37 if (@_) {
106 1 50       7 $self->{old_username} = $self->{username} if $self->{username} ne $_[0];
107 1         2 $self->{username} = shift;
108 1 50       3 $self->_update if $self->{autocommit};
109             }
110 14         189 return $self->{username};
111             }
112              
113             sub hashed_password {
114 105     105 1 120 my $self = shift;
115 105 100       205 if (@_) {
116 2         3 $self->{hashed_password} = shift;
117 2 100       9 $self->_update if $self->{autocommit};
118             }
119 105         409 return $self->{hashed_password};
120             }
121              
122             sub extra_info {
123 18     18 1 42 my $self = shift;
124 18 100       49 if (@_) {
125 2         5 $self->{extra_info} = [ @_ ];
126 2 100       19 $self->_update if $self->{autocommit};
127             }
128 18         303 return $self->{extra_info};
129             }
130              
131             =head2 password
132            
133             $userobj->password($newpass);
134              
135             Encrypts a new password. Dies if C<$newpass> is not provided.
136              
137             =cut
138              
139             sub password {
140 3     3 1 6 my ($self,$password) = @_;
141 3 100       206 croak "you must provide a new password" unless defined $password;
142 2         8 $self->hashed_password( htpasswd_encrypt($self->encrypt_hash, $password) );
143             }
144              
145             =head2 set
146              
147             $userobj->set(item => $value, ...);
148              
149             Sets any of the four preceding values at once. Only writes the file once if it is going to be written.
150              
151             =cut
152              
153             sub set {
154 1     1 1 5 my ($self,%attr) = @_;
155 1         2 $self->{autocommit} = 0;
156 1         6 while (my ($key,$value) = each %attr) {
157 3 50       19 croak "don't know how to set $key" unless $self->can($key);
158 3 100       11 $self->$key(ref $value eq 'ARRAY' ? @$value : $value);
159             }
160 1         4 $self->_update;
161 1         88 $self->{autocommit} = 1;
162             }
163              
164             =head2 to_line
165              
166             $userobj->to_line;
167              
168             Returns a line for the user, suitable for printing to a C<.htpasswd> file. There is no newline at the end.
169              
170             =cut
171              
172             sub to_line {
173 5     5 1 9 my $self = shift;
174 3         8 return join(':', $self->username, $self->hashed_password,
175 5 100       16 defined $self->extra_info ? @{$self->extra_info} : ());
176             }
177              
178             sub _update {
179 3     3   4 my $self = shift;
180 3 50       10 if ($self->file) {
181 3 100       25 if (defined $self->{old_username}) {
182 1         4 $self->file->delete_user($self->{old_username});
183 1         101 delete $self->{old_username};
184             }
185 3         10 $self->file->update_user($self);
186             }
187             }
188              
189             =head1 AUTHOR
190              
191             David Kamholz C
192              
193             Yuval Kogman
194              
195             =head1 COPYRIGHT & LICENSE
196              
197             Copyright (c) 2005 - 2007 the aforementioned authors.
198            
199             This program is free software; you can redistribute
200             it and/or modify it under the same terms as Perl itself.
201              
202             =cut
203              
204             1;