File Coverage

blib/lib/CGI/Application/Plugin/Authentication/Driver/Filter/sha1.pm
Criterion Covered Total %
statement 27 27 100.0
branch 22 22 100.0
condition 2 2 100.0
subroutine 5 5 100.0
pod 2 2 100.0
total 58 58 100.0


line stmt bran cond sub pod time code
1             package CGI::Application::Plugin::Authentication::Driver::Filter::sha1;
2             $CGI::Application::Plugin::Authentication::Driver::Filter::sha1::VERSION = '0.25';
3 3     3   264434 use strict;
  3         78  
  3         148  
4 3     3   18 use warnings;
  3         7  
  3         196  
5              
6 3     3   611 use UNIVERSAL::require;
  3         1527  
  3         928  
7              
8             sub check {
9 12     12 1 34 my $class = shift;
10 12         26 my $param = shift;
11 12         27 my $plain = shift;
12 12         24 my $filtered = shift;
13              
14 12 100       45 if ($param) {
    100          
    100          
15 6 100       23 return ( $class->filter( $param, $plain ) eq $filtered ) ? 1 : 0;
16             } elsif ( length($filtered) == 20 ) {
17 2 100       8 return ( $class->filter( 'binary', $plain ) eq $filtered ) ? 1 : 0;
18             } elsif ( length($filtered) == 27 ) {
19 2 100       8 return ( $class->filter( 'base64', $plain ) eq $filtered ) ? 1 : 0;
20             } else {
21 2 100       8 return ( $class->filter( undef, $plain ) eq $filtered ) ? 1 : 0;
22             }
23             }
24              
25             sub filter {
26 18     18 1 601 my $class = shift;
27 18   100     86 my $param = lc (shift || 'hex');
28 18         35 my $plain = shift;
29              
30 18 100       89 Digest::SHA->require || die "Digest::SHA is required to check SHA1 passwords";
31 17 100       767 if ( $param eq 'hex' ) {
    100          
    100          
32 6         74 return Digest::SHA::sha1_hex($plain);
33             } elsif ( $param eq 'base64' ) {
34 5         65 return Digest::SHA::sha1_base64($plain);
35             } elsif ( $param eq 'binary' ) {
36 5         65 return Digest::SHA::sha1($plain);
37             }
38 1         11 die "Unknown SHA1 format $param";
39             }
40              
41             1;
42             __END__