File Coverage

blib/lib/ClearPress/authenticator/db.pm
Criterion Covered Total %
statement 51 60 85.0
branch 13 22 59.0
condition 6 6 100.0
subroutine 11 11 100.0
pod 5 5 100.0
total 86 104 82.6


line stmt bran cond sub pod time code
1             # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
2             # vim:ts=8:sw=2:et:sta:sts=2
3             #########
4             # Author: rmp
5             #
6             package ClearPress::authenticator::db;
7 2     2   18534 use strict;
  2         4  
  2         48  
8 2     2   9 use warnings;
  2         4  
  2         45  
9 2     2   9 use base qw(ClearPress::authenticator Class::Accessor);
  2         4  
  2         548  
10 2     2   13 use Readonly;
  2         2  
  2         73  
11 2     2   10 use Carp;
  2         2  
  2         74  
12 2     2   8 use English qw(-no_match_vars);
  2         4  
  2         9  
13              
14             our $VERSION = q[476.4.2];
15              
16             __PACKAGE__->mk_accessors(qw(dbh));
17              
18             our $SUPPORTED_CIPHERS = {
19             mysql => sub { my ($self, $str) = @_; $self->dyn_use('Crypt::MySQL'); return Crypt::MySQL::password($str); },
20             mysql41 => sub { my ($self, $str) = @_; $self->dyn_use('Crypt::MySQL'); return Crypt::MySQL::password41($str); },
21             sha1 => sub { my ($self, $str) = @_; $self->dyn_use('Digest::SHA'); return Digest::SHA::sha1_hex($str); },
22             sha128 => sub { my ($self, $str) = @_; $self->dyn_use('Digest::SHA'); return Digest::SHA::sha128_hex($str); },
23             sha256 => sub { my ($self, $str) = @_; $self->dyn_use('Digest::SHA'); return Digest::SHA::sha256_hex($str); },
24             sha384 => sub { my ($self, $str) = @_; $self->dyn_use('Digest::SHA'); return Digest::SHA::sha384_hex($str); },
25             sha512 => sub { my ($self, $str) = @_; $self->dyn_use('Digest::SHA'); return Digest::SHA::sha512_hex($str); },
26             md5 => sub { my ($self, $str) = @_; $self->dyn_use('Digest::MD5'); return Digest::MD5::md5_hex($str); },
27             };
28             Readonly::Scalar our $DEFAULT_TABLE => 'user';
29             Readonly::Scalar our $DEFAULT_USERNAME_FIELD => 'username';
30             Readonly::Scalar our $DEFAULT_PASSWORD_FIELD => 'pass';
31             Readonly::Scalar our $DEFAULT_CIPHER => 'sha1';
32              
33             sub table {
34 3     3 1 10 my ($self, $v) = @_;
35              
36 3 50       8 if($v) {
37 0         0 $self->{table} = $v;
38             }
39              
40 3 50       8 if($self->{table}) {
41 0         0 return $self->{table};
42             }
43              
44 3         8 return $DEFAULT_TABLE;
45             }
46              
47             sub username_field {
48 3     3 1 9 my ($self, $v) = @_;
49              
50 3 50       7 if($v) {
51 0         0 $self->{username_field} = $v;
52             }
53              
54 3 50       21 if($self->{username_field}) {
55 0         0 return $self->{username_field};
56             }
57              
58 3         5 return $DEFAULT_USERNAME_FIELD;
59             }
60              
61             sub password_field {
62 3     3 1 5 my ($self, $v) = @_;
63              
64 3 50       8 if($v) {
65 0         0 $self->{password_field} = $v;
66             }
67              
68 3 50       5 if($self->{password_field}) {
69 0         0 return $self->{password_field};
70             }
71              
72 3         6 return $DEFAULT_PASSWORD_FIELD;
73             }
74              
75             sub cipher {
76 3     3 1 6 my ($self, $v) = @_;
77              
78 3 50       5 if($v) {
79 0         0 $self->{cipher} = $v;
80             }
81              
82 3 50       5 if($self->{cipher}) {
83 0         0 return $self->{cipher};
84             }
85              
86 3         6 return $DEFAULT_CIPHER;
87             }
88              
89             sub authen_credentials {
90 6     6 1 45 my ($self, $ref) = @_;
91              
92 6 100 100     56 if(!$ref ||
      100        
93             !$ref->{username} ||
94             !$ref->{password} ) {
95 3         17 return;
96             }
97              
98 3         12 my $dbh = $self->dbh();
99 3         60 my $table = $self->table;
100 3         8 my $user_f = $self->username_field;
101 3         8 my $pass_f = $self->password_field;
102 3         5 my $c_type = $self->cipher;
103 3         4 my $cipher = $SUPPORTED_CIPHERS->{$c_type};
104              
105 3 50       10 if(!$cipher) {
106 0         0 croak qq[Unsupported cipher: $c_type];
107             }
108              
109 3         6 my $digest = $cipher->($self, $ref->{password});
110 3         9 my $query = qq[SELECT $user_f FROM $table WHERE $user_f=? AND $pass_f=?];
111 3         27 my $results = $dbh->selectall_arrayref($query, {}, $ref->{username}, $digest);
112              
113 3 100       260 if(!scalar @{$results}) {
  3         11  
114 2         11 return;
115             }
116              
117 1         5 return $ref;
118             }
119              
120             1;
121             __END__