view release on metacpan or  search on metacpan

examples/helloworld/app/lib/Dwarf/Validator/Constraint/Default.pm  view on Meta::CPAN

package Dwarf::Validator::Constraint::Default;
use Dwarf::Validator::Constraint;
use Dwarf::Validator::NullValue;
use Email::Valid;
use Email::Valid::Loose;
use Dwarf::Util qw/encode_utf8 decode_utf8/;
use Image::Info qw/image_type/;
use JSON;
use MIME::Base64 qw(decode_base64 decoded_base64_length);
use Scalar::Util qw/looks_like_number/;


rule NOT_NULL => sub {
	return 0 if not defined($_);
	return 0 if ref $_ eq 'ARRAY' && @$_ == 0;
	return 1;
};
alias NOT_NULL => 'REQUIRED';

rule NOT_BLANK => sub {
	return 0 if not defined($_);
	return 0 if ref $_ eq 'ARRAY' && @$_ == 0;
	$_ ne "";
};

rule INT  => sub {
	return 0 unless $_ =~ /\A[+\-]?[0-9]+\z/;
	return 0 unless $_ < 2_147_483_647;
	return 0 unless $_ > -2_147_483_648;
	return 1;
};

rule UINT => sub {
	return 0 unless $_ =~ /\A[0-9]+\z/;
	return 0 unless $_ < 2_147_483_647;
	return 1;
};

rule BIGINT => sub {
	return 0 unless $_ =~ /\A[+\-]?[0-9]+\z/;
	return 1 if $_ =~ /\A[+\-]?[0-9]{1,18}\z/;
	return 1 if $_ =~ /\A[+]?[0-9]{20,}\z/;
	return 1 if $_ =~ /\A[\-]?[0-9]{20,}\z/;
	Math::BigInt->use or die;
	my $MIN = Math::BigInt->new("-9223372036854775808");
	my $MAX = Math::BigInt->new("9223372036854775807");
	my $val = Math::BigInt->new($_);
	return 0 if $MIN->bcmp($val) > 0;
	return 0 if $val->bcmp($MAX) > 0;
	return 1;
};

rule BIGUINT => sub {
	return 0 unless $_ =~ /\A[0-9]+\z/;
	return 1 if $_ =~ /\A[0-9]{1,18}\z/;
	return 1 if $_ =~ /\A[0-9]{20,}\z/;
	Math::BigInt->use or die;
	my $MAX = Math::BigInt->new("9223372036854775807");
	my $val = Math::BigInt->new($_);
	return 0 if $val->bcmp($MAX) > 0;
	return 1;
};

rule NUMBER => sub {
	my $value = $_;
	return 1 unless defined $value;
	return looks_like_number $value;
};

examples/helloworld/app/lib/Dwarf/Validator/Constraint/Default.pm  view on Meta::CPAN

rule REGEX => sub {
	my $regex = shift;
	Carp::croak("missing args at REGEX rule") unless defined $regex;
	$_ =~ /$regex/
};
alias REGEX => 'REGEXP';

rule CHOICE => sub {
	Carp::croak("missing \$choices") if @_ == 0;

	my @choices = @_==1 && ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_;

	for my $c (@choices) {
		if ($c eq $_) {
			return 1;
		}
	}
	return 0;
};
alias CHOICE => 'IN';

rule NOT_IN => sub {
	my @choices = @_==1 && ref$_[0]eq'ARRAY' ? @{$_[0]} : @_;

	for my $c (@choices) {
		if ($c eq $_) {
			return 0;
		}
	}
	return 1;
};

rule MATCH => sub {
	my $callback = shift;
	Carp::croak("missing \$callback") if ref $callback ne 'CODE';

	$callback->($_);
};

rule JSON => sub {
	my $value = $_;
	return 1 unless defined $value;
	my $data = eval { decode_json encode_utf8 $value };
	if ($@) {
		warn $@;
		warn $value;
		return 0;
	}
	return 1;
};

rule CREDITCARD_NUMBER   => sub { $_ =~ /\A[0-9]{14,16}\z/ };
rule CREDITCARD_EXPIRE   => sub { $_ =~ /^\d{2}\/\d{2}$/ };
rule CREDITCARD_SECURITY => sub { $_ =~ /\A[0-9]{3,4}\z/ };

rule BASE64_TYPE => sub {
	Carp::croak('missing args. usage: ["BASE64_TYPE", "(jpeg|png|gif)"]') unless @_;
	my $expected = $_[0];
	my $filetype = '';

	my $decoded = decode_base64($_);
	my $type = image_type(\$decoded);

	if (my $error = $type->{error}) {
		return 0;
	}
	$filetype = lc $type->{file_type};
	return $filetype =~ /^$expected$/i;
};

rule BASE64_SIZE => sub {
	Carp::croak('missing args. usage: ["BASE64_SIZE", "10000"]') unless @_;
	my $expected = $_[0];
	my $length = decoded_base64_length($_);
	return $length < $expected;
};


file_rule FILE_NOT_NULL => sub {
	return 0 if not defined($_);
	return 0 if $_ eq "";
	return 0 if ref($_) eq 'ARRAY' && @$_ == 0;
	return 1;
};

file_rule FILE_MIME => sub {
	Carp::croak('missing args. usage: ["FILE_MIME", "text/plain"]') unless @_;
	my $expected = $_[0];
	return $_->type =~ /^$expected$/;
};

file_rule FILE_EXT => sub {
	Carp::croak('missing args. usage: ["FILE_MIME", "text/plain"]') unless @_;
	my $expected = $_[0];
	my $ext = '';
	if ($_->filename =~ /\.([^\.]+)$/) {
		$ext = lc $1;
	}
	return $ext =~ /^$expected$/;
};

# 予約
rule ARRAY => sub { 1 };

rule FILTER => sub {
	my ($filter, @args) = @_;
	Carp::croak("missing \$filter") unless $filter;

	my $opts = {
		override_param => 1,
	};
	
	if (not ref $filter) {
		$filter = $Dwarf::Validator::Filters->{uc $filter}
			or Carp::croak("$filter is not defined.");
	}
	
	Carp::croak("\$filter must be coderef.") if ref $filter ne 'CODE';

	$_ = $filter->($_, \@args, $opts);

	# パラメータを上書きしない場合は null を返す
	unless ($opts->{override_param}) {
		return Dwarf::Validator::NullValue->new;
	}

	$_;
};

filter TRIM => sub {
	my ($value, $args, $opts) = @_;
	return $value unless $value;
	$value =~ s/^\s+|\s+$//g;
	$value;