File Coverage

blib/lib/CGI/Application/Plugin/Authentication/Driver/Filter/md5.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::md5;
2             $CGI::Application::Plugin::Authentication::Driver::Filter::md5::VERSION = '0.23';
3 3     3   1918 use strict;
  3         7  
  3         70  
4 3     3   13 use warnings;
  3         6  
  3         61  
5              
6 3     3   409 use UNIVERSAL::require;
  3         984  
  3         20  
7              
8             sub check {
9 12     12 1 24 my $class = shift;
10 12         18 my $param = shift;
11 12         17 my $plain = shift;
12 12         15 my $filtered = shift;
13              
14 12 100       75 if ($param) {
    100          
    100          
15 6 100       14 return ( $class->filter( $param, $plain ) eq $filtered ) ? 1 : 0;
16             } elsif ( length($filtered) == 16 ) {
17 2 100       10 return ( $class->filter( 'binary', $plain ) eq $filtered ) ? 1 : 0;
18             } elsif ( length($filtered) == 22 ) {
19 2 100       5 return ( $class->filter( 'base64', $plain ) eq $filtered ) ? 1 : 0;
20             } else {
21 2 100       4 return ( $class->filter( undef, $plain ) eq $filtered ) ? 1 : 0;
22             }
23             }
24              
25             sub filter {
26 18     18 1 614 my $class = shift;
27 18   100     58 my $param = lc (shift || 'hex');
28 18         28 my $plain = shift;
29              
30 18 100       59 Digest::MD5->require || die "Digest::MD5 is required to check MD5 passwords";
31 17 100       522 if ( $param eq 'hex' ) {
    100          
    100          
32 6         48 return Digest::MD5::md5_hex($plain);
33             } elsif ( $param eq 'base64' ) {
34 5         32 return Digest::MD5::md5_base64($plain);
35             } elsif ( $param eq 'binary' ) {
36 5         34 return Digest::MD5::md5($plain);
37             }
38 1         9 die "Unknown MD5 format $param";
39             }
40              
41             1;
42             __END__