File Coverage

blib/lib/Crypt/Passphrase.pm
Criterion Covered Total %
statement 88 104 84.6
branch 19 28 67.8
condition 2 4 50.0
subroutine 20 22 90.9
pod 5 6 83.3
total 134 164 81.7


line stmt bran cond sub pod time code
1             package Crypt::Passphrase;
2             $Crypt::Passphrase::VERSION = '0.014';
3 3     3   204899 use strict;
  3         32  
  3         88  
4 3     3   18 use warnings;
  3         6  
  3         68  
5              
6 3     3   15 use mro ();
  3         4  
  3         37  
7              
8 3     3   14 use Carp ();
  3         6  
  3         46  
9 3     3   15 use Scalar::Util ();
  3         5  
  3         48  
10 3     3   1705 use Encode ();
  3         30466  
  3         72  
11 3     3   2388 use Unicode::Normalize ();
  3         6282  
  3         268  
12              
13             our @CARP_NOT;
14             sub import {
15 12     12   262 my ($class, @args) = @_;
16 12         103893 for my $arg (@args) {
17 10         25 my $caller = caller;
18 10 100       50 if ($arg eq '-encoder') {
    100          
    50          
19 5         1444 require Crypt::Passphrase::Encoder;
20 3     3   22 no strict 'refs';
  3         7  
  3         96  
21 3     3   15 no warnings 'once';
  3         6  
  3         348  
22 5 100       82 push @{"$caller\::ISA"}, 'Crypt::Passphrase::Encoder' unless $caller->isa('Crypt::Passphrase::Encoder');
  4         52  
23 5         19 push @{"$caller\::CARP_NOT"}, __PACKAGE__, mro::get_linear_isa($caller);
  5         166  
24             }
25             elsif ($arg eq '-validator') {
26 4         15 require Crypt::Passphrase::Validator;
27 3     3   22 no strict 'refs';
  3         7  
  3         102  
28 3     3   16 no warnings 'once';
  3         14  
  3         3020  
29 4 50       84 push @{"$caller\::ISA"}, 'Crypt::Passphrase::Validator' unless $caller->isa('Crypt::Passphrase::Validator');
  4         45  
30 4         14 push @{"$caller\::CARP_NOT"}, __PACKAGE__, mro::get_linear_isa($caller);
  4         149  
31             }
32             elsif ($arg eq '-integration') {
33 1         23 push @CARP_NOT, $caller;
34             }
35             else {
36 0         0 Carp::croak("Unknown import argument $arg");
37             }
38             }
39             }
40              
41             sub _load_extension {
42 9     9   25 my $short_name = shift;
43 9 50       56 my $module_name = $short_name =~ s/^(\+)?/$1 ? '' : 'Crypt::Passphrase::'/re;
  9         48  
44 9         55 my $file_name = "$module_name.pm" =~ s{::}{/}gr;
45 9         3676 require $file_name;
46 9         607 return $module_name;
47             }
48              
49             sub _load_encoder {
50 5     5   13 my $encoder = shift;
51 5 50       54 if (Scalar::Util::blessed($encoder)) {
    100          
52 0         0 return $encoder;
53             }
54             elsif (ref $encoder) {
55 1         2 my %encoder_conf = %{ $encoder };
  1         6  
56 1         4 my $encoder_module = _load_extension(delete $encoder_conf{module});
57 1         11 return $encoder_module->new(%encoder_conf);
58             }
59             else {
60 4         13 return _load_extension($encoder)->new;
61             }
62             }
63              
64             sub _load_validator {
65 4     4   8 my $validator = shift;
66 4 50       19 if (Scalar::Util::blessed($validator)) {
    50          
    50          
67 0         0 return $validator;
68             }
69             elsif (ref($validator) eq 'HASH') {
70 0         0 my %validator_conf = %{ $validator };
  0         0  
71 0         0 my $validator_module = _load_extension(delete $validator_conf{module});
72 0         0 return $validator_module->new(%validator_conf);
73             }
74             elsif (ref($validator) eq 'CODE') {
75 0         0 require Crypt::Passphrase::Fallback;
76 0         0 return Crypt::Passphrase::Fallback->new(callback => $validator);
77             }
78             else {
79 4         9 return _load_extension($validator)->new;
80             }
81             }
82              
83             my %valid = map { $_ => 1 } qw/C D KC KD/;
84             sub new {
85 4     4 1 601 my ($class, %args) = @_;
86 4 50       21 Carp::croak('No encoder given to Crypt::Passphrase->new') if not $args{encoder};
87 4         20 my $encoder = _load_encoder($args{encoder});
88 4         26 my @validators = map { _load_validator($_) } @{ $args{validators} };
  4         15  
  4         28  
89 4   50     44 my $normalization = $args{normalization} || 'C';
90 4 50       20 Carp::croak("Invalid normalization form $normalization") if not $valid{$normalization};
91              
92 4         29 my $self = bless {
93             encoder => $encoder,
94             validators => [ $encoder, @validators ],
95             normalization => $normalization,
96             }, $class;
97              
98 4         26 return $self;
99             }
100              
101             sub _normalize_password {
102 13     13   30 my ($self, $password) = @_;
103 13   50     120 my $normalized = Unicode::Normalize::normalize($self->{normalization}, $password // '');
104 13         274 return Encode::encode('utf-8-strict', $normalized);
105             }
106              
107             sub hash_password {
108 3     3 1 681 my ($self, $password) = @_;
109 3         11 my $normalized = $self->_normalize_password($password);
110 3         149 return $self->{encoder}->hash_password($normalized);
111             }
112              
113             sub needs_rehash {
114 8     8 1 1035 my ($self, $hash) = @_;
115 8         41 return $self->{encoder}->needs_rehash($hash);
116             }
117              
118             sub verify_password {
119 10     10 1 1280 my ($self, $password, $hash) = @_;
120              
121 10         16 for my $validator (@{ $self->{validators} }) {
  10         51  
122 20 100       74 if ($validator->accepts_hash($hash)) {
123 10         33 my $normalized = $self->_normalize_password($password);
124 10         431 return $validator->verify_password($normalized, $hash);
125             }
126             }
127              
128 0           return 0;
129             }
130              
131             sub curry_with_hash {
132 0     0 1   my ($self, $hash) = @_;
133 0           require Crypt::Passphrase::PassphraseHash;
134 0           return Crypt::Passphrase::PassphraseHash->new($self, $hash);
135             }
136              
137             sub curry_with_password {
138 0     0 0   my ($self, $password) = @_;
139 0           my $hash = $self->hash_password($password);
140 0           return $self->curry_with_hash($hash);
141             }
142              
143             1;
144              
145             # ABSTRACT: A module for managing passwords in a cryptographically agile manner
146              
147             __END__