File Coverage

blib/lib/Apache/Auth/User/Basic.pm
Criterion Covered Total %
statement 29 34 85.2
branch 1 6 16.6
condition n/a
subroutine 10 11 90.9
pod 0 2 0.0
total 40 53 75.4


line stmt bran cond sub pod time code
1             #
2             # Apache::Auth::User::Basic
3             # An Apache basic authentication user class.
4             #
5             # (C) 2003-2007 Julian Mehnle
6             # $Id: Basic.pm 31 2007-09-18 01:39:14Z julian $
7             #
8             ##############################################################################
9              
10             package Apache::Auth::User::Basic;
11              
12 2     2   33878 use version; our $VERSION = qv('0.120');
  2         2432  
  2         12  
13              
14 2     2   171 use warnings;
  2         5  
  2         68  
15 2     2   10 use strict;
  2         8  
  2         64  
16              
17 2     2   11 use base qw(Apache::Auth::User);
  2         11  
  2         1333  
18              
19 2     2   14 use Carp;
  2         7  
  2         259  
20              
21             # Constants:
22             ##############################################################################
23              
24 2     2   66 use constant TRUE => (0 == 0);
  2         3  
  2         131  
25 2     2   11 use constant FALSE => not TRUE;
  2         13  
  2         222  
26              
27 2     2   11 use constant crypt_salt_characters => ('.', '/', '0'..'9', 'A'..'Z', 'a'..'z');
  2         3  
  2         733  
28              
29             # Interface:
30             ##############################################################################
31              
32             sub signature;
33             sub password;
34              
35             # Implementation:
36             ##############################################################################
37              
38             sub signature {
39 7     7 0 606 my ($self) = @_;
40 7         27 return $self->name;
41             }
42              
43             sub password {
44 0     0 0 0 my ($self, @value) = @_;
45 0 0       0 if (@value) {
46 0         0 $self->{password} = $value[0];
47 0 0       0 $self->{password_digest} = $self->_build_password_digest
48             if defined($self->{password});
49             }
50 0         0 return $self->{password};
51             }
52              
53             sub _build_password_digest {
54 3     3   7 my ($self) = @_;
55            
56 3 50       12 croak("Unable to build password digest from incomplete data")
57             if not defined($self->{password});
58            
59 3         1382 return crypt(
60             $self->{password},
61             join('', ($self->crypt_salt_characters)[rand(64), rand(64)])
62             );
63             }
64              
65             TRUE;