File Coverage

blib/lib/Authen/Simple/DBI.pm
Criterion Covered Total %
statement 15 54 27.7
branch 0 34 0.0
condition 0 3 0.0
subroutine 5 6 83.3
pod 1 1 100.0
total 21 98 21.4


line stmt bran cond sub pod time code
1             package Authen::Simple::DBI;
2              
3 1     1   879 use strict;
  1         2  
  1         44  
4 1     1   7 use warnings;
  1         2  
  1         72  
5 1     1   17 use base 'Authen::Simple::Adapter';
  1         2  
  1         1023  
6              
7 1     1   75979 use DBI qw[SQL_CHAR];
  1         43850  
  1         172  
8 1     1   11 use Params::Validate qw[];
  1         2  
  1         1501  
9              
10             our $VERSION = 0.2;
11              
12             __PACKAGE__->options({
13             dsn => {
14             type => Params::Validate::SCALAR,
15             optional => 0
16             },
17             statement => {
18             type => Params::Validate::SCALAR,
19             optional => 0
20             },
21             username => {
22             type => Params::Validate::SCALAR,
23             optional => 1
24             },
25             password => {
26             type => Params::Validate::SCALAR,
27             optional => 1
28             },
29             attributes => { # undocumented for now
30             type => Params::Validate::HASHREF,
31             default => { ChopBlanks => 1, PrintError => 0, RaiseError => 0 },
32             optional => 1
33             }
34             });
35              
36             sub check {
37 0     0 1   my ( $self, $username, $password ) = @_;
38              
39 0           my ( $dsn, $dbh, $sth, $encrypted ) = ( $self->dsn, undef, undef, undef );
40              
41 0 0         unless ( $dbh = DBI->connect_cached( $dsn, $self->username, $self->password, $self->attributes ) ) {
42              
43 0           my $error = DBI->errstr;
44              
45 0 0         $self->log->error( qq/Failed to connect to database using dsn '$dsn'. Reason: '$error'/ )
46             if $self->log;
47              
48 0           return 0;
49             }
50              
51 0 0         unless ( $sth = $dbh->prepare_cached( $self->statement ) ) {
52              
53 0           my $error = $dbh->errstr;
54 0           my $statement = $self->statement;
55              
56 0 0         $self->log->error( qq/Failed to prepare statement '$statement'. Reason: '$error'/ )
57             if $self->log;
58              
59 0           return 0;
60             }
61              
62 0 0         unless ( $sth->bind_param( 1, $username, SQL_CHAR ) ) {
63              
64 0           my $error = $sth->errstr;
65 0           my $statement = $self->statement;
66              
67 0 0         $self->log->error( qq/Failed to bind param '$username' to statement '$statement'. Reason: '$error'/ )
68             if $self->log;
69              
70 0           return 0;
71             }
72              
73 0 0         unless ( $sth->execute ) {
74              
75 0           my $error = $sth->errstr;
76 0           my $statement = $self->statement;
77              
78 0 0         $self->log->error( qq/Failed to execute statement '$statement'. Reason: '$error'/ )
79             if $self->log;
80              
81 0           return 0;
82             }
83              
84 0 0         unless ( $sth->bind_col( 1, \$encrypted ) ) {
85              
86 0           my $error = $sth->errstr;
87 0           my $statement = $self->statement;
88              
89 0 0         $self->log->error( qq/Failed to bind column. Reason: '$error'/ )
90             if $self->log;
91              
92 0           return 0;
93             }
94              
95 0 0         unless ( $sth->fetch ) {
96              
97 0           my $statement = $self->statement;
98              
99 0 0         $self->log->debug( qq/User '$username' was not found with statement '$statement'./ )
100             if $self->log;
101              
102 0           return 0;
103             }
104              
105 0           $sth->finish;
106              
107 0 0 0       unless ( defined $encrypted && length $encrypted ) {
108              
109 0 0         $self->log->debug( qq/Encrypted password for user '$username' is null./ )
110             if $self->log;
111              
112 0           return 0;
113             }
114              
115 0 0         unless ( $self->check_password( $password, $encrypted ) ) {
116              
117 0 0         $self->log->debug( qq/Failed to authenticate user '$username'. Reason: 'Invalid credentials'/ )
118             if $self->log;
119              
120 0           return 0;
121             }
122              
123 0 0         $self->log->debug( qq/Successfully authenticated user '$username'./ )
124             if $self->log;
125              
126 0           return 1;
127             }
128              
129             1;
130              
131             __END__