File Coverage

blib/lib/Crypt/Passphrase.pm

Criterion	Covered	Total	%
statement	73	91	80.2
branch	16	28	57.1
condition	2	4	50.0
subroutine	17	19	89.4
pod	6	6	100.0
total	114	148	77.0

package Crypt::Passphrase;
$Crypt::Passphrase::VERSION = '0.023';
use strict;
use warnings;

use Carp ();
use Scalar::Util ();
use Encode ();
use Unicode::Normalize ();

our @CARP_NOT;
sub import {
	my ($class, @args) = @_;
	for my $arg (@args) {
		my $caller = caller;
		if ($arg eq '-encoder') {
			require Crypt::Passphrase::Encoder;
			no strict 'refs';
			push @{"$caller\::ISA"}, 'Crypt::Passphrase::Encoder' unless $caller->isa('Crypt::Passphrase::Encoder');
		}
		elsif ($arg eq '-validator') {
			require Crypt::Passphrase::Validator;
			no strict 'refs';
			push @{"$caller\::ISA"}, 'Crypt::Passphrase::Validator' unless $caller->isa('Crypt::Passphrase::Validator');
		}
		elsif ($arg eq '-integration') {
			push @CARP_NOT, $caller;
		}
		else {
			Carp::croak("Unknown import argument $arg");
		}
	}
	return;
}

sub _load_extension {
	my $short_name = shift;
	my $module_name = $short_name =~ s/^(\+)?/$1 ? '' : 'Crypt::Passphrase::'/re;
	my $file_name = "$module_name.pm" =~ s{::}{/}gr;
	require $file_name;
	return $module_name;
}

sub _load_encoder {
	my $encoder = shift;
	if (Scalar::Util::blessed($encoder)) {
		return $encoder;
	}
	elsif (ref $encoder) {
		my %encoder_conf = %{ $encoder };
		my $encoder_module = _load_extension(delete $encoder_conf{module});
		return $encoder_module->new(%encoder_conf);
	}
	else {
		return _load_extension($encoder)->new;
	}
}

sub _load_validator {
	my $validator = shift;
	if (Scalar::Util::blessed($validator)) {
		return $validator;
	}
	elsif (ref($validator) eq 'HASH') {
		my %validator_conf = %{ $validator };
		my $validator_module = _load_extension(delete $validator_conf{module});
		return $validator_module->new(%validator_conf);
	}
	elsif (ref($validator) eq 'CODE') {
		require Crypt::Passphrase::Fallback;
		return Crypt::Passphrase::Fallback->new(callback => $validator);
	}
	else {
		return _load_extension($validator)->new;
	}
}

my %valid = map { $_ => 1 } qw/C D KC KD/;
sub new {
	my ($class, %args) = @_;
	Carp::croak('No encoder given to Crypt::Passphrase->new') if not $args{encoder};
	my $encoder = _load_encoder($args{encoder});
	my @validators = map { _load_validator($_) } @{ $args{validators} };
	my $normalization = $args{normalization} || 'C';
	Carp::croak("Invalid normalization form $normalization") if not $valid{$normalization};

	my $self = bless {
		encoder       => $encoder,
		validators    => [ $encoder, @validators ],
		normalization => $normalization,
	}, $class;

	return $self;
}

sub _normalize_password {
	my ($self, $password) = @_;
	my $normalized = Unicode::Normalize::normalize($self->{normalization}, $password // '');
	return Encode::encode('utf-8-strict', $normalized);
}

sub hash_password {
	my ($self, $password) = @_;
	my $normalized = $self->_normalize_password($password);
	return $self->{encoder}->hash_password($normalized);
}

sub needs_rehash {
	my ($self, $hash) = @_;
	return $self->{encoder}->needs_rehash($hash);
}

sub verify_password {
	my ($self, $password, $hash) = @_;

	for my $validator (@{ $self->{validators} }) {
		if ($validator->accepts_hash($hash)) {
			my $normalized = $self->_normalize_password($password);
			return $validator->verify_password($normalized, $hash);
		}
	}

	return 0;
}

sub recode_hash {
	my ($self, @args) = @_;
	return $self->{encoder}->recode_hash(@args);
}

sub curry_with_hash {
	my ($self, $hash) = @_;
	require Crypt::Passphrase::PassphraseHash;
	return Crypt::Passphrase::PassphraseHash->new($self, $hash);
}

1;

# ABSTRACT: A module for managing passwords in a cryptographically agile manner

__END__