package Data::Password::Check;
use strict;
use warnings;
use Carp;

our $VERSION = '0.03';

=head1 NAME

Data::Password::Check - sanity check passwords

=head1 DESCRIPTION

Users can be lazy. If you're a perl programmer this is a good thing. If you're
choosing a password this is a bad thing.

This module performs some sanity checks on passwords. Details on checks than
can be performed are described below.

=head1 SYNOPSIS

Basic use of the module is as follows:

  use Data::Password::Check;

  # check a password
  my $pwcheck = Data::Password::Check->check({
    'password' => $some_password
  });

  # did we have any errors?
  if ($pwcheck->has_errors) {
    # print the errors
      print(
       join("\n", @{ $result->error_list }),
       "\n"
      );
  }

=cut

=head1 PUBLIC METHODS

These methods are publically available. Use them to your heart's content.

=head2 check($proto,$options)

This is the main function for this module. You must pass one mandatory value in
the $options hash-reference - a password:

  # check a password
  $result = Data::Password::Check->check({'password' => $pwd_to_check});

There are other options that may be passed to invoke further password tests if
required.

=cut
sub check($$) {
	my ($proto, $options) = @_;
	my ($self, $class);

	$class = ref($proto) || $proto;
	$self = {};
	bless $self, $class;

	# make sure $options is a hash-reference
 	unless (ref($options) eq 'HASH') {
		Carp::carp("You need to pass a hash-reference of options to check()");
		return undef;
	}

	# make sure we at least have a password value
	unless (exists $options->{'password'}) {
		Carp::carp("You need to supply a password to check()!");
		return undef;
	}

	# store the password so it's easier to refer to
	# (i.e. $self->{'password'} rather than $self->{'options'}{'password'})
	$self->{'password'} = $options->{'password'};

	# make a copy of the incomong options
	$self->{'options'} = $options;

	# perform the password checks
	$self->_do_checks;

	return $self;
}

=head2 has_errors($class)

This function is used to determine if there were any errors found while sanity
checking the supplied password. It does not return the errors themselves.

Returns B<1> if there were errors, B<0> otherwise

=cut
sub has_errors($) {
	my ($self) = @_;
	return (exists $self->{'_error_count'} and $self->{'_error_count'} > 0);
}

=head2 error_list($class)

This function returns an array-reference to a list of the error messages.
If there are no errors B<undef> is returned.

=cut
sub error_list($) {
	my ($self) = @_;
	if ($self->has_errors) {
		return $self->{'_errors'};
	}

	return undef;
}


=head1 AVAILABLE CHECKS

By default the module will perform all checks listed below. You can limit the
number of checks by passing a list of desired tests via the B<tests> option
when calling check(). e.g.

  Data::Password::Check->check({
    ...
    'tests' => [ 'length' ], # check only that the password meets a minimum-length requirement
    ...
  });

=cut

=head2 length

Make sure the password it at least 6 characters long. If B<min_length> was passed
as an option to check(), this value will be used instead, assuming it's a
positive integer.

=cut
sub _check_length($) {
	my ($self) = @_;
	my $min_length = 6;

	# does the user want a different length
	if (exists $self->{'options'}{'min_length'} and not defined $self->{'options'}{'min_length'}) {
		# issue a warning
		Carp::cluck("min_length argument must be a defined value");
		# return undef
		return undef;
	}
	elsif (exists $self->{'options'}{'min_length'} and defined $self->{'options'}{'min_length'}) {
		# is it a positive, on-zero, integer?
		if ($self->{'options'}{'min_length'} =~ /^[1-9]\d*$/) {
			$min_length = $self->{'options'}{'min_length'};
		}
		else {
			# issue a warning
			Carp::cluck("min_length argument [$self->{'options'}{'min_length'} isn't a positive, non-zero, integer");
			# return undef
			return undef;
		}
	}

	# if password is undefined, set it to '', so we aren't comparing undef with anything 
	unless (defined $self->{'password'}) {
		$self->{'password'} = '';
	}

	# now we can check that the password meets the minimum length requirement
	if (length($self->{'password'}) >= $min_length) {
		return 1;
	}
	else {
		# store a failure message
		$self->_add_error("The password must be at least $min_length characters");
	}
}

=head2 silly

Make sure the password isn't a known silly word (e.g 'password' is a bad choice
for a password).

The default list contains I<qwerty>, and I<password> only. You may choose to
replace this list of words or to add your own to the end of the list.

If you wish to B<replace> the list of silly-words, you should pass them in via
the options when calling check(), as 'silly_words'. e.g.

  Data::Password::Check->check({
	...
    'silly_words' => [ 'my', 'silly', 'words' ],
	...
  });

If you would like to add words to the existing list, you should pass them in
via the 'silly_words_append' option when calling check(). e.g.

  Data::Password::Check->check({
	...
    'silly_words_append' => [ 'more', 'silly', 'words' ],
	...
  });

All matching is case-insensitive, and if you choose to append words, duplicates
will be omitted.

=cut
sub _check_silly($) {
	my ($self) = @_;
	# default words we don't want people to use as passwords
	my @silly_words = qw{
		password
		qwerty
	};
	# does the user want to REPLACE the current list of words
	if (exists $self->{'options'}{'silly_words'}) {
		# is it an array-ref?
		if (ref($self->{'options'}{'silly_words'}) eq 'ARRAY') {
			# override the default checks
			@silly_words = @{ $self->{'options'}{'silly_words'} };
		}
		else {
			Carp::carp("The 'silly_words' option must be an array-reference. Continuing with default list.");
		}
	}

	# does the user want to ADD to the existing list of word
	if (exists $self->{'options'}{'silly_words_append'}) {
		# is it an array-ref?
		if (ref($self->{'options'}{'silly_words_append'}) eq 'ARRAY') {
			# push the words onto the end of the list
			# make sure we don't already have the word
			foreach my $append (@{ $self->{'options'}{'silly_words_append'} }) {
				unless ( grep { /^$append$/ } @silly_words ) {
					push @silly_words, $append;
				}
			}
		}
		else {
			Carp::carp("The 'silly_words' option must be an array-reference. Continuing with default list.");
		}
	}

	# now we loop through the silly_words and make sure our password doesn't match them
	foreach my $silly (@silly_words) {
		# do a case-insensitive match, but look for the whole string
		if ($self->{'password'} =~ /^$silly$/i) {
			$self->_add_error("You may not use '$self->{'password'}' as your password");
		}
	}
}

=head2 repeated

Make sure the password isn't a single character repeated, e.g. 'aaaaaaaaaa'.

=cut
sub _check_repeated($) {
	my ($self) = @_;

	# is the password made up of the same character repeated?
	if ($self->{'password'} =~ /^(.)\1+$/) {
		$self->_add_error("You cannot use a single repeated character as a password");
	}
}


=head1 PRIVATE METHODS

These methods are private to this module. If you choose to use them outside the
module, all bets are off.

=head2 _do_checks($self)

This function calls each required test in turn. It's an internal function
called within check().

=cut
sub _do_checks($) {
	my ($self) = @_;
	my (@checks, $fn, $custom_checks);

	# the list of checks to make
	@checks = qw(
		length
		silly
		repeated
	);
	# custom_checks defaults to false
	$custom_checks = 0;

	# allow the user to override the list of checks
	# we require the 'tests' option to exist, and to be an array-reference
	if (exists $self->{'options'}{'tests'}) {
		if (ref($self->{'options'}{'tests'}) eq 'ARRAY') {
			# override the default checks
			@checks = @{ $self->{'options'}{'tests'} };
			# set the custom_checks flag
			$custom_checks = 1;
		}
		else {
			Carp::carp("The 'tests' option must be an array-reference. Continuing with default tests.");
		}
	}

	# loop through the checks we would like to do
	foreach my $test (@checks) {
		# set the name of the function we'd like to call
		my $fn = "_check_${test}";
		# if we can run the function, do so
		if ($self->can("_check_${test}")) {
			unless (defined $self->$fn) {
				# make a note that we skipped the test
				push @{ $self->{'skipped_tests'} }, $test;
				Carp::carp("skipped test '$test' due to errors") if $self->{'DEBUG'};
			};
		}
		# otherwise warn that we're trying to call something
		# that we can't find
		else {
			# warn or carp, depending on whether we've got a custom
			# list of tests
			if ($custom_checks) {
				Carp::carp("The are no password checks available for '$test'");
			}
			else {
				warn "no such password check function: $fn()";
			}
		}
	}
}

=head2 _add_error($class,$message)

This function is used to add an error message to the internal store.
The errors can later be retrieved using the B<error_list()> method.

=cut
sub _add_error($$) {
	my ($self, $message) = @_;

	# increase the count of errors we've added
	$self->{'_error_count'} ++;

	# add the error message to a list of messages
	push @{ $self->{'_errors'} }, $message;
}

=head2 _skipped_test($class,$testname)

This function exists so that it's possible to work out if a test was skipped
because "something went wrong" - usually because of an invalid option passed in
via the check() options.

This function was written to enable some tests in the "make test" phase of
installing the module.

=cut
sub _skipped_test($$) {
	my ($self, $testname) = @_;

	# do we have a list of skipped tests?
	if (exists $self->{'skipped_tests'}) {
		# does $testname exist in the list?
		if (grep { /^$testname$/ } @{ $self->{'skipped_tests'} }) {
			return 1;
		}
	}

	# no indication that we skipped the test
	return 0;
}

=head1 AUTHOR

Chisel Wright, E<lt>chisel@herlpacker.co.ukE<gt>

=head1 COPYRIGHT AND LICENCE

Copyright (C) 2004 by Chisel Wright

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.

=cut

# be true
1;
