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.016';
3 3     3   203335 use strict;
  3         33  
  3         87  
4 3     3   17 use warnings;
  3         6  
  3         76  
5              
6 3     3   21 use mro ();
  3         7  
  3         50  
7              
8 3     3   16 use Carp ();
  3         5  
  3         51  
9 3     3   15 use Scalar::Util ();
  3         6  
  3         59  
10 3     3   1762 use Encode ();
  3         31253  
  3         69  
11 3     3   2561 use Unicode::Normalize ();
  3         6299  
  3         259  
12              
13             our @CARP_NOT;
14             sub import {
15 12     12   257 my ($class, @args) = @_;
16 12         103878 for my $arg (@args) {
17 10         26 my $caller = caller;
18 10 100       51 if ($arg eq '-encoder') {
    100          
    50          
19 5         1315 require Crypt::Passphrase::Encoder;
20 3     3   25 no strict 'refs';
  3         23  
  3         91  
21 3     3   15 no warnings 'once';
  3         5  
  3         350  
22 5 100       84 push @{"$caller\::ISA"}, 'Crypt::Passphrase::Encoder' unless $caller->isa('Crypt::Passphrase::Encoder');
  4         49  
23 5         17 push @{"$caller\::CARP_NOT"}, __PACKAGE__, mro::get_linear_isa($caller);
  5         153  
24             }
25             elsif ($arg eq '-validator') {
26 4         14 require Crypt::Passphrase::Validator;
27 3     3   22 no strict 'refs';
  3         5  
  3         103  
28 3     3   20 no warnings 'once';
  3         7  
  3         2973  
29 4 50       50 push @{"$caller\::ISA"}, 'Crypt::Passphrase::Validator' unless $caller->isa('Crypt::Passphrase::Validator');
  4         51  
30 4         15 push @{"$caller\::CARP_NOT"}, __PACKAGE__, mro::get_linear_isa($caller);
  4         142  
31             }
32             elsif ($arg eq '-integration') {
33 1         36 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   49 my $short_name = shift;
43 9 50       59 my $module_name = $short_name =~ s/^(\+)?/$1 ? '' : 'Crypt::Passphrase::'/re;
  9         53  
44 9         62 my $file_name = "$module_name.pm" =~ s{::}{/}gr;
45 9         3533 require $file_name;
46 9         589 return $module_name;
47             }
48              
49             sub _load_encoder {
50 5     5   11 my $encoder = shift;
51 5 50       40 if (Scalar::Util::blessed($encoder)) {
    100          
52 0         0 return $encoder;
53             }
54             elsif (ref $encoder) {
55 1         2 my %encoder_conf = %{ $encoder };
  1         5  
56 1         5 my $encoder_module = _load_extension(delete $encoder_conf{module});
57 1         10 return $encoder_module->new(%encoder_conf);
58             }
59             else {
60 4         15 return _load_extension($encoder)->new;
61             }
62             }
63              
64             sub _load_validator {
65 4     4   7 my $validator = shift;
66 4 50       21 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         7 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 648 my ($class, %args) = @_;
86 4 50       20 Carp::croak('No encoder given to Crypt::Passphrase->new') if not $args{encoder};
87 4         20 my $encoder = _load_encoder($args{encoder});
88 4         24 my @validators = map { _load_validator($_) } @{ $args{validators} };
  4         11  
  4         21  
89 4   50     38 my $normalization = $args{normalization} || 'C';
90 4 50       17 Carp::croak("Invalid normalization form $normalization") if not $valid{$normalization};
91              
92 4         28 my $self = bless {
93             encoder => $encoder,
94             validators => [ $encoder, @validators ],
95             normalization => $normalization,
96             }, $class;
97              
98 4         25 return $self;
99             }
100              
101             sub _normalize_password {
102 13     13   31 my ($self, $password) = @_;
103 13   50     83 my $normalized = Unicode::Normalize::normalize($self->{normalization}, $password // '');
104 13         333 return Encode::encode('utf-8-strict', $normalized);
105             }
106              
107             sub hash_password {
108 3     3 1 592 my ($self, $password) = @_;
109 3         11 my $normalized = $self->_normalize_password($password);
110 3         153 return $self->{encoder}->hash_password($normalized);
111             }
112              
113             sub needs_rehash {
114 8     8 1 1043 my ($self, $hash) = @_;
115 8         36 return $self->{encoder}->needs_rehash($hash);
116             }
117              
118             sub verify_password {
119 10     10 1 1295 my ($self, $password, $hash) = @_;
120              
121 10         18 for my $validator (@{ $self->{validators} }) {
  10         35  
122 20 100       91 if ($validator->accepts_hash($hash)) {
123 10         35 my $normalized = $self->_normalize_password($password);
124 10         456 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__