package InputCheck;
$InputCheck::VERSION = '0.0.5';

=head1 NAME

InputCheck - A simple input check


=head1 SYNOPSIS

    use InputCheck;

	my $check = InputCheck->new(
		id       => ['INT'],
		passwd   => ['LENGTH{3-8}', 'ASCII'],
		name     => ['NOT_NULL'],
		hurigana => ['NOT_NULL', 'HIRAGANA'],
		email1   => ['EMAIL',    'IDENTICAL{email2}'],
		email2   => ['EMAIL_MX', 'IDENTICAL{email1}'],
		zip      => ['ZIP'],
	);

	$check->prepare(ZIP => sub {
			my ($value) = @_;
			if ($value =~ /\d{3}-\d{4}/) {
				return 1;
			}
			return 0;
		}
	);

	$check->execute(%form);

	if ($check->is_error() == 1) {
		
		die "Input Error!";
		
		#
		# my $t = HTML::Template->new(file=>"error.tmpl")
		# $t->param($check->get_error());
		# $t->output();
		#
	}

=head1 AUTHOR

KIMURA, takefumi
  E<lt>takefumi@takefumi.comE<gt>
  http://www.godtomato.net/
  http://wiki.godtomato.net/works/?cmd=view;name=InputCheck

=head1 SEE ALSO

L<Email::Valid>

=cut

use strict;
use Email::Valid;

# -------------------------------------------------------------------------
# new
#
# -------------------------------------------------------------------------
sub new {
	my $class = shift;
	my (%plan) = @_;

	my $check = bless {CHECK_PLAN => \%plan}, $class;

	$check->prepare(
		NOT_NULL  => \&is_NOT_NULL,
		EMAIL     => \&is_EMAIL,
		EMAIL_MX  => \&is_EMAIL_MX,
		HIRAGANA  => \&is_HIRAGANA,
		KATAKANA  => \&is_KATAKANA,
		INT       => \&is_INT,
		TEL       => \&is_TEL,
		LENGTH    => \&is_LENGTH,
		ASCII     => \&is_ASCII,
		DATE      => \&is_DATE,
		IDENTICAL => \&is_IDENTICAL,
	);

	return $check
}

# -------------------------------------------------------------------------
# チェックパターンの準備
#
# -------------------------------------------------------------------------
sub prepare {
	my $self = shift;
	my (%func) = @_;

	while (my ($key, $value) = each %func) {
		 $self->{CHECK}->{$key} = $value;
	}

	return $self;
}

# -------------------------------------------------------------------------
# チェック実行
#
# -------------------------------------------------------------------------
sub execute {
	my $self = shift;
	my (%form) = @_;

	my %plan = %{$self->{CHECK_PLAN}};

	my %error;
	while (my ($key, $check_array_ref) = each %plan) {
		for my $fname (@{$check_array_ref}) {

			#
			# 引数の設定
			#
			my @arg = ($form{$key});

			#
			# 文字の長さチェック
			#
			if ($fname =~ /^LENGTH\{(\d+)?([\,\.\-])?(\d+)?\}$/) {
				$fname = "LENGTH";
				push(@arg, $1, $2, $3);
			}
			
			#
			# ある値と同じかどうか
			#
			elsif ($fname =~ /^IDENTICAL{(\w+)}$/) {
				$fname = "IDENTICAL";
				push(@arg, $form{$1});
			}

			#
			# 関数があるかチェック
			#
			if (!exists $self->{CHECK}->{$fname}) {
				die qq{unknown check function: "$fname"};
			}

			#
			# NOT_NULL 以外で NULL だったら次へ
			#（ただし、@arg が 1 つの場合のみ）
			#
			if ($fname ne 'NOT_NULL' and scalar(@arg) == 1 and $arg[0] eq "") {
				next;
			}

			#
			# チェック実行
			#
			my $func = $self->{CHECK}->{$fname};
			if (&$func(@arg) == 0 ) {
				push(@{$error{$key}}, $fname);
			}
		}
	}

	$self->{ERROR} = \%error;

	return $self;
}

# -------------------------------------------------------------------------
# エラーかどうか
#
# -------------------------------------------------------------------------
sub is_error {
	my $self = shift;

	if (scalar(keys %{$self->{ERROR}}) > 0) {
		return 1;
	}
	else {
		return 0;
	}
}

# -------------------------------------------------------------------------
# エラー情報を取得
#
# -------------------------------------------------------------------------
sub get_error {
	my $self = shift;
	my (%alias) = @_;

	#
	# エラーハッシュの作成
	#
	my %error;
	my @error;
	while (my ($key, $err_array_ref) = each %{$self->{ERROR}}) {
		
		#
		# エラーコードを設定
		#
		$error{"_err[$key]"} = 1;
		for my $err (@$err_array_ref){
			$error{"_err[$key][$err]"} = 1;
			push(@error, {err => "_err[$key][$err]"});
		}
		
		#
		# alias が設定されていれば エラーコードを追加
		#
		if (exists $alias{$key}) {
			my $alias = $alias{$key};

			$error{"_err[$alias]"} = 1;
			for my $err (@$err_array_ref){
				$error{"_err[$alias][$err]"} = 1;
			}
		}
	}

	return (%error, _err_all => \@error , _err => (scalar @error));
}

# -------------------------------------------------------------------------
# チェックパターン
#
# -------------------------------------------------------------------------

sub is_NOT_NULL {
	my ($value) = @_;

	if ($value ne ""){
		return 1;
	}
	
	return 0;
}

sub is_EMAIL {
	my ($value) = @_;

	if (Email::Valid->address(-address => $value)) {
		return 1;
	}

	return 0;
}

sub is_EMAIL_MX {
	my ($value) = @_;

	if (Email::Valid->address(-address=>$value, -mxcheck=>1)) {
		return 1;
	}
	return 0;
}

sub is_INT {
	my ($value) = @_;

	if ($value =~ /^\-?[\d]+$/){
		return 1;
	}
	return 0;
}


sub is_TEL {
	my ($value) = @_;

	if ($value =~ /^[\-\d]+$/){
		return 1;
	}
	return 0;
}

sub is_LENGTH {
	my ($value, $min, $f, $max) = @_;

	#
	# NULL は無視
	#
	if ($value eq "") {
		return 1;
	}

	#
	# 3,8 ... 3文字以上8文字以下
	#
	if ($min ne "" and $f ne "" and $max ne "") {
		if (length($value) >= $min and length($value) <= $max) {
			return 1;
		}
	}

	#
	# 10  ... 10文字
	#
	if ($min ne "" and $f eq "" and $max eq "") {
		if (length($value) == $min) {
			return 1;
		}
	}

	#
	# 3,  ... 3文字以上
	#
	if ($min ne "" and $f ne "" and $max eq "") {
		if (length($value) >= $min) {
			return 1;
		}
	}

	#
	# ,8  ... 8文字以下
	#
	if ($min eq "" and $f ne "" and $max ne "") {
		if (length($value) <= $max) {
			return 1;
		}
	}

	return 0;
}

sub is_IDENTICAL {
	my ($value, $value2) = @_;

	if ($value eq  $value2) {
		return 1;
	}
	return 0;
}

sub is_ASCII {
	my ($value) = @_;

	if ($value =~ /^[\x21-\x7E]+$/) {
		return 1;
	}
	return 0;
}

sub is_HIRAGANA {
	my ($value) = @_;

	if ($value =~ /^(?:\xA4[\x00-\xFF]|\xA1\xBC)+$/) {
		return 1;
	}
	return 0;
}

sub is_KATAKANA {
	my ($value) = @_;

	if ($value =~ /^(?:\xA5[\x00-\xFF]|\xA1\xBC)+$/) {
		return 1;
	}
	return 0;
}

sub is_DATE {
	my ($value) = @_;
	
	my ($y, $m, $d) = split(/\D/, $value);

	if ($d > 31 or $d < 1 or $m > 12 or $m < 1 or $y == 0) {
		return 0;
	}
	if ($d > 30 and ($m == 4 or $m == 6 or $m == 9 or $m == 11)) {
		return 0;
	}
	if ($d > 29 and $m == 2) {
		return 0;
	}
	if ($m == 2 and $d > 28 and $y % 100 != 0 and $y % 4 != 0) {
		return 0;
	}
	return 1;
}

1;
