File Coverage

blib/lib/Data/Password/Check/JPassword.pm

Criterion	Covered	Total	%
statement	29	50	58.0
branch	8	14	57.1
condition	8	9	88.8
subroutine	6	14	42.8
pod	10	10	100.0
total	61	97	62.8

package Data::Password::Check::JPassword;

use 5.008008;
use strict;
use warnings;

require Exporter;
use POSIX qw( floor log );

our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw(
    password_check
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
    security is_weak is_strong is_medium advice
    password_security
    password_strong
    password_medium
    password_weak
    password_advice
);

our $VERSION = '0.02';


###########################################################
sub security
{
    my( $package, $password ) = @_;
    return $password if ref $password;
    $password =~ s/^(\s+)|(\s+$)//g;
    my $c = {number=>1, uppercase=>1, lowercase=>1, punctuation=>1, special=>1};
    while( $password =~ /(.)/g ) {
        my $char = ord $1;
        if( $char > 127 ) {
            $c->{special}++;
        }
        if( $char > 47 && $char < 58 ) {
            $c->{number} ++;
        }
        elsif( $char > 64 && $char < 91 ) {
            $c->{uppercase} ++;
        }
        elsif( $char > 96 && $char < 123 ) {
            $c->{lowercase} ++;
        }
        else {
            $c->{punctuation} += 2;
        }
    }

    my $level = $c->{number} * $c->{uppercase} * $c->{lowercase} *
                $c->{punctuation} * $c->{special};
    # $c->{level} = floor( log( $level*$level ) + 0.5 );
    # jPassword uses Math.round()... why bother?
    $c->{level} = log( $level*$level );
    $c->{password} = $password;
    return $c
}

###########################################################
# Return true if this is a strong password
sub is_strong
{
    my( $package, $password ) = @_;
    my $c = $package->security( $password );
    return $c->level >= 10;
}

###########################################################
# Return true if this is a medium-strength password
sub is_medium
{
    my( $package, $password ) = @_;
    my $c = $package->security( $password );
    return $c->level >= 5;
}

###########################################################
# Return true if this is a weak password
sub is_weak
{
    my( $package, $password ) = @_;
    my $c = $package->security( $password );
    return $c->level < 5;
}

###########################################################
sub advice
{
    my( $package, $password ) = @_;
    my $c = password_security( $password );
    return if password_strong( $c );
    foreach my $k ( qw( lowercase uppercase number punctuation special ) ) {
        return $k if $c->{$k} < 2;
    }
}





###########################################################
sub password_security
{
    return __PACKAGE__->security( @_ );
}

###########################################################
sub password_strong
{
    return __PACKAGE__->is_strong( @_ );
}

###########################################################
# Return true if this is a strong password
sub password_medium
{
    return __PACKAGE__->is_medium( @_ );
}

###########################################################
# Return true if this is a weak password
sub password_weak
{
    my( $password ) = @_;
    return __PACKAGE__->is_weak( @_ );
}

###########################################################
# Return advice for a password
sub password_advice
{
    my( $password ) = @_;
    return __PACKAGE__->is_advice( @_ );
}



1;

__END__