File Coverage

blib/lib/Crypt/XkcdPassword.pm
Criterion Covered Total %
statement 23 44 52.2
branch 0 12 0.0
condition 0 3 0.0
subroutine 8 10 80.0
pod n/a
total 31 69 44.9


line stmt bran cond sub pod time code
1             package Crypt::XkcdPassword;
2              
3 4     4   107030 use 5.010001;
  4         21  
  4         179  
4 4     4   4594 use utf8;
  4         40  
  4         22  
5              
6             BEGIN {
7 4     4   223 $Crypt::XkcdPassword::AUTHORITY = "cpan:TOBYINK";
8 4         92 $Crypt::XkcdPassword::VERSION = "0.006";
9             }
10              
11 4     4   3038 use match::simple qw( M );
  4         35769  
  4         40  
12 4     4   8006 use Carp qw( carp croak );
  4         9  
  4         205  
13 4     4   3544 use Module::Runtime qw( require_module );
  4         6551  
  4         25  
14 4     4   4718 use Types::Standard qw( CodeRef Str );
  4         312795  
  4         51  
15              
16 4     4   8715 use Moo;
  4         68221  
  4         28  
17             with qw(Role::Commons::Authority);
18              
19             has rng => (
20             is => "rw",
21             isa => CodeRef,
22             default => sub { sub { int(rand($_[0])) } },
23             );
24              
25             has words => (
26             is => "rw",
27             isa => Str,
28             default => sub { "EN" },
29             );
30              
31             *chars = *provider = sub {};
32              
33             sub make_password
34             {
35 0     0     my ($self, $length, $filter) = @_;
36            
37 0 0         $self = $self->new unless ref $self;
38            
39 0 0         $length = 4 unless defined $length;
40 0 0         $length = 4 unless $length > 0;
41            
42 0           my $rng = $self->rng;
43 0           my $words = $self->_word_list;
44 0           my $word_count = @$words;
45              
46 0           my @password;
47 0           while (@password < $length)
48             {
49 0           local $_ = my $maybe = $words->[ $rng->($word_count) ];
50 0 0 0       push @password, $maybe
51             if (!defined $filter or $maybe |M| $filter);
52             }
53              
54 0           return join q{ }, @password;
55             }
56              
57             sub _word_list
58             {
59 0     0     my ($self) = @_;
60 0           my $class = sprintf "Crypt::XkcdPassword::Words::%s", $self->words;
61            
62 0 0         eval { require_module($class) } or do {
  0            
63 0           carp "$class could not be loaded, switching to 'EN'";
64 0 0         croak "No point switching!" if $self->words eq "EN";
65 0           $self->words("EN");
66 0           return $self->_word_list;
67             };
68            
69 0           return $class->words;
70             }
71              
72             __PACKAGE__
73             __END__