File Coverage

blib/lib/App/Genpass.pm

Criterion	Covered	Total	%
statement	86	124	69.3
branch	15	40	37.5
condition	11	27	40.7
subroutine	13	16	81.2
pod	4	4	100.0
total	129	211	61.1

package App::Genpass;
# ABSTRACT: Quickly and easily create secure passwords
$App::Genpass::VERSION = '2.34';
use Carp;
use Moo;
use Sub::Quote 'quote_sub';
use MooX::Types::MooseLike::Base qw/Int Str Bool ArrayRef/;
use Getopt::Long qw/:config no_ignore_case/;
use File::Spec;
use Config::Any;
use File::HomeDir;
use List::AllUtils qw( any none shuffle );

has uppercase => (
    is      => 'ro',
    isa     => ArrayRef,
    default => quote_sub( q{ [ 'A' .. 'Z' ] } ),
);

has lowercase => (
    is      => 'ro',
    isa     => ArrayRef,
    default => quote_sub( q{ [ 'a' .. 'z' ] } ),
);

has numerical => (
    is      => 'ro',
    isa     => ArrayRef,
    default => quote_sub( q{ [ '0' .. '9' ] } ),
);

has unreadable => (
    is      => 'ro',
    isa     => ArrayRef,
    default => quote_sub( q{ [ split //sm, q{oO0l1I} ] } ),
);

has specials => (
    is      => 'ro',
    isa     => ArrayRef,
    default => quote_sub( q{ [ split //sm, q{!@#$%^&*()} ] } ),
);

has number => (
    is      => 'ro',
    isa     => Int,
    default => quote_sub( q{1} ),
);

has readable => (
    is      => 'ro',
    isa     => Bool,
    default => quote_sub( q{1} ),
);

has verify => (
    is      => 'ro',
    isa     => Bool,
    default => quote_sub( q{1} ),
);

has length => (
    is  => 'ro',
    isa => Int,
);

has minlength => (
    is      => 'rw',
    isa     => Int,
    default => quote_sub( q{8} ),
);

has maxlength => (
    is      => 'rw',
    isa     => Int,
    default => quote_sub( q{10} ),
);

sub parse_opts {
    my $class = shift;
    my %opts  = ();

    GetOptions(
        'configfile=s'  => \$opts{'configfile'},
        'lowercase=s@'  => \$opts{'lowercase'},
        'uppercase=s@'  => \$opts{'uppercase'},
        'numerical=i@'  => \$opts{'numerical'},
        'unreadable=s@' => \$opts{'unreadable'},
        'specials=s@'   => \$opts{'specials'},
        'n|number=i'    => \$opts{'number'},
        'r|readable!'   => \$opts{'readable'},
        'v|verify!'     => \$opts{'verify'},
        'l|length=i'    => \$opts{'length'},
        'm|minlength=i' => \$opts{'minlength'},
        'x|maxlength=i' => \$opts{'maxlength'},
    ) or croak q{Can't get options.};

    # remove undefined keys
    foreach my $key ( keys %opts ) {
        defined $opts{$key} or delete $opts{$key};
    }

    return %opts;
}

sub new_with_options {
    my $class   = shift;
    my %opts    = $class->parse_opts;
    my @configs = (
        File::Spec->catfile( File::HomeDir->my_home, '.genpass.yaml' ),
        '/etc/genpass.yaml',
    );

    if ( ! exists $opts{'configfile'} ) {
        foreach my $file (@configs) {
            if ( -e $file && -r $file ) {
                $opts{'configfile'} = $file;
                last;
            }
        }
    }

    if ( exists $opts{'configfile'} ) {
        %opts = (
            %opts,
            %{ $class->get_config_from_file( $opts{'configfile'} ) },
        );
    }

    my $self = $class->new( %opts, @_ );

    return $self;
}

sub get_config_from_file {
    my ($class, $file) = @_;

    $file = $file->() if ref $file eq 'CODE';
    my $files_ref = ref $file eq 'ARRAY' ? $file : [$file];

    my $can_config_any_args = $class->can('config_any_args');
    my $extra_args = $can_config_any_args ?
        $can_config_any_args->($class, $file) : {};
    ;
    my $raw_cfany = Config::Any->load_files({
        %$extra_args,
        use_ext         => 1,
        files           => $files_ref,
        flatten_to_hash => 1,
    } );

    my %raw_config;
    foreach my $file_tested ( reverse @{$files_ref} ) {
        if ( ! exists $raw_cfany->{$file_tested} ) {
            warn qq{Specified configfile '$file_tested' does not exist, } .
                qq{is empty, or is not readable\n};
                next;
        }

        my $cfany_hash = $raw_cfany->{$file_tested};
        die "configfile must represent a hash structure in file: $file_tested"
            unless $cfany_hash && ref $cfany_hash && ref $cfany_hash eq 'HASH';

        %raw_config = ( %raw_config, %{$cfany_hash} );
    }

    \%raw_config;
}

sub _get_chars {
    my $self      = shift;
    my @all_types = qw( lowercase uppercase numerical specials );
    my @chars     = ();
    my @types     = ();

    # adding all the combinations
    foreach my $type (@all_types) {
        if ( my $ref = $self->$type ) {
            push @chars, @{$ref};
            push @types, $type;
        }
    }

    # removing the unreadable chars
    if ( $self->readable ) {
        my @remove_chars = (
            @{ $self->unreadable },
            @{ $self->specials   },
        );

        @chars = grep {
            local $a = $_;
            none { $a eq $_ } @remove_chars;
        } @chars;

        # removing specials
        pop @types;
    }

    # make both refs
    return [ \@types, @chars ];
}

sub generate {
    my ( $self, $number ) = @_;

    my $length;
    my $verify        = $self->verify;
    my @passwords     = ();
    my @verifications = ();
    my $EMPTY         = q{};

    my ( $char_types, @chars ) = @{ $self->_get_chars };

    my @char_types   = @{$char_types};
    my $num_of_types = scalar @char_types;

    if ( (defined($self->length) && $num_of_types > $self->length)
         || ($num_of_types > $self->minlength) ) {
        $length = defined($self->length) ? $self->length : $self->minlength.' minimum';
        croak <<"_DIE_MSG";
You wanted a shorter password that the variety of characters you've selected.
You requested $num_of_types types of characters but only have $length length.
_DIE_MSG
    }

    if ($self->minlength > $self->maxlength) {
        carp "minlength > maxlength, so I'm switching them";
        my $min = $self->maxlength;
        $self->maxlength($self->minlength);
        $self->minlength($min);
    }

    $length = $self->length
            || $self->minlength + int(rand(abs($self->maxlength - $self->minlength) + 1));

    $number ||= $self->number;

    # each password iteration needed
    foreach my $pass_iter ( 1 .. $number ) {
        my $password  = $EMPTY;
        my $char_type = shift @char_types;

        # generating the password
        while ( $length > length $password ) {
            my $char = $chars[ int rand @chars ];

            # for verifying, we just check that it has small capital letters
            # if that doesn't work, we keep asking it to get a new random one
            # the check if it has large capital letters and so on
            if ( $verify && $char_type && @{ $self->$char_type } ) {
                # verify $char_type
                if ( @{ $self->$char_type } ) {
                    while ( ! any { $_ eq $char } @{ $self->$char_type } ) {
                        $char = $chars[ int rand @chars ];
                    }
                }

                $char_type =
                    scalar @char_types > 0 ? shift @char_types : $EMPTY;
            }

            $password .= $char;
        }

        # since the verification process creates a situation of ordered types
        # (lowercase, uppercase, numerical, special)
        # we need to shuffle the string
        $password = join $EMPTY, shuffle( split //sm, $password );

        $number == 1 && return $password;

        push @passwords, $password;

        @char_types = @{$char_types};
    }

    return wantarray ? @passwords : \@passwords;
}


1;

__END__