r1731 - in packages: . libformvalidator-simple-perl
libformvalidator-simple-perl/branches
libformvalidator-simple-perl/branches/upstream
libformvalidator-simple-perl/branches/upstream/current
libformvalidator-simple-perl/branches/upstream/current/lib
libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator
libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple
libformvalidator-simple-perl/branches/upstream/current/t
libformvalidator-simple-perl/branches/upstream/current/t/conf
libformvalidator-simple-perl/branches/upstream/current/t/lib
libformvalidator-simple-perl/branches/upstream/current/t/lib/FormValidator
libformvalidator-simple-perl/branches/upstream/current/t/lib/FormValidator/Simple
libformvalidator-simple-perl/branches/upstream/current/t/lib/FormValidator/Simple/Plugin
Krzysztof Krzyzaniak
eloy at costa.debian.org
Fri Dec 23 22:08:47 UTC 2005
Author: eloy
Date: 2005-12-23 22:08:15 +0000 (Fri, 23 Dec 2005)
New Revision: 1731
Added:
packages/libformvalidator-simple-perl/
packages/libformvalidator-simple-perl/branches/
packages/libformvalidator-simple-perl/branches/upstream/
packages/libformvalidator-simple-perl/branches/upstream/current/
packages/libformvalidator-simple-perl/branches/upstream/current/Changes
packages/libformvalidator-simple-perl/branches/upstream/current/MANIFEST
packages/libformvalidator-simple-perl/branches/upstream/current/META.yml
packages/libformvalidator-simple-perl/branches/upstream/current/Makefile.PL
packages/libformvalidator-simple-perl/branches/upstream/current/README
packages/libformvalidator-simple-perl/branches/upstream/current/lib/
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple.pm
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/ArrayList.pm
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Constants.pm
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Constraint.pm
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Constraints.pm
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Data.pm
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Exception.pm
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Iterator.pm
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Messages.pm
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Profile.pm
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Result.pm
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Results.pm
packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Validator.pm
packages/libformvalidator-simple-perl/branches/upstream/current/t/
packages/libformvalidator-simple-perl/branches/upstream/current/t/00_compile.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/01_constraint.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/02_constraints.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/03_profile.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/04_result.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/05_results.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/06_data.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/07_simple.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/08_length.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/09_ascii.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/10_int.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/11_space.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/12_duplication.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/13_datetime.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/14_regex.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/15_any.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/16_plugin.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/17_pod.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/18_invalids.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/19_url.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/20_numeric_cmp.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/21_decimal.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/22_messages.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/23_messages_yaml.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/24_options.t
packages/libformvalidator-simple-perl/branches/upstream/current/t/conf/
packages/libformvalidator-simple-perl/branches/upstream/current/t/conf/messages.yml
packages/libformvalidator-simple-perl/branches/upstream/current/t/lib/
packages/libformvalidator-simple-perl/branches/upstream/current/t/lib/FormValidator/
packages/libformvalidator-simple-perl/branches/upstream/current/t/lib/FormValidator/Simple/
packages/libformvalidator-simple-perl/branches/upstream/current/t/lib/FormValidator/Simple/Plugin/
packages/libformvalidator-simple-perl/branches/upstream/current/t/lib/FormValidator/Simple/Plugin/Sample.pm
packages/libformvalidator-simple-perl/tags/
Log:
[svn-inject] Installing original source of libformvalidator-simple-perl
Added: packages/libformvalidator-simple-perl/branches/upstream/current/Changes
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/Changes 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/Changes 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,42 @@
+Revision history for Perl extension FormValidator::Simple.
+
+0.11 Thu Nov 24 00:45:00 2005
+ - added set_option method
+
+0.10 Thu Nov 17 12:00:00 2005
+ - added error-message handler
+
+0.09 Wed Nov 16 23:00:00 2005
+ - added documentation for FormValidation::Simple::Results
+
+0.08 Tue Nov 15 21:00:00 2005
+ - added some methods to FormValidator::Simple::Results.
+ changed behavior of validation DATE and DATETIME,
+ now it returns string or DateTime object or Time::Piece one,
+ you can choose it in option-setting.
+
+0.07 Mon Oct 31 21:00:00 2005
+ - added validation DECIMAL
+
+0.06 Thu Oct 27 21:00:00 2005
+ - added validations: numeric comparisons
+ GREATER_THAN LESS_THAN EQUAL_TO BETWEEN
+ ( suggested by Jody Alkema )
+
+0.05 Thu Oct 20 01:00:00 2005
+ - added validation HTTP_URL
+
+0.04 Wed Oct 19 20:00:00 2005
+ - added validation SELECTED_AT_LEAST
+ fixed some code didn't work as expected.
+
+0.03 Sun Oct 1 22:00:00 2005
+ - little bit fixed documentation and Makefile.PL
+
+0.02 Sun Sep 25 22:00:00 2005
+ - cpan release version
+
+0.01 Thu Sep 1 10:38:22 2005
+ - original version; created by h2xs 1.23 with options
+ -X -A FormValidator::Simple
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/MANIFEST 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/MANIFEST 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,45 @@
+Changes
+lib/FormValidator/Simple.pm
+lib/FormValidator/Simple/ArrayList.pm
+lib/FormValidator/Simple/Constants.pm
+lib/FormValidator/Simple/Constraint.pm
+lib/FormValidator/Simple/Constraints.pm
+lib/FormValidator/Simple/Data.pm
+lib/FormValidator/Simple/Exception.pm
+lib/FormValidator/Simple/Iterator.pm
+lib/FormValidator/Simple/Messages.pm
+lib/FormValidator/Simple/Profile.pm
+lib/FormValidator/Simple/Result.pm
+lib/FormValidator/Simple/Results.pm
+lib/FormValidator/Simple/Validator.pm
+Makefile.PL
+MANIFEST
+META.yml
+README
+t/00_compile.t
+t/01_constraint.t
+t/02_constraints.t
+t/03_profile.t
+t/04_result.t
+t/05_results.t
+t/06_data.t
+t/07_simple.t
+t/08_length.t
+t/09_ascii.t
+t/10_int.t
+t/11_space.t
+t/12_duplication.t
+t/13_datetime.t
+t/14_regex.t
+t/15_any.t
+t/16_plugin.t
+t/17_pod.t
+t/18_invalids.t
+t/19_url.t
+t/20_numeric_cmp.t
+t/21_decimal.t
+t/22_messages.t
+t/23_messages_yaml.t
+t/24_options.t
+t/conf/messages.yml
+t/lib/FormValidator/Simple/Plugin/Sample.pm
Added: packages/libformvalidator-simple-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/META.yml 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/META.yml 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,21 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: FormValidator-Simple
+version: 0.11
+version_from: lib/FormValidator/Simple.pm
+installdirs: site
+requires:
+ Class::Accessor: 0.22
+ Class::Data::Inheritable: 0.04
+ Class::Inspector: 1.13
+ Date::Calc: 5.4
+ Email::Valid: 0.15
+ Email::Valid::Loose: 0.04
+ List::MoreUtils: 0.16
+ Mail::Address: 0
+ Tie::IxHash: 1.21
+ UNIVERSAL::require: 0.1
+ YAML: 0.39
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.29
Added: packages/libformvalidator-simple-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/Makefile.PL 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/Makefile.PL 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,19 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ NAME => 'FormValidator::Simple',
+ VERSION_FROM => 'lib/FormValidator/Simple.pm', # finds $VERSION
+ PREREQ_PM => {
+ 'Class::Accessor' => 0.22,
+ 'Class::Inspector' => 1.13,
+ 'Class::Data::Inheritable' => 0.04,
+ 'UNIVERSAL::require' => 0.10,
+ 'Mail::Address' => 0,
+ 'Email::Valid' => 0.15,
+ 'Email::Valid::Loose' => 0.04,
+ 'Date::Calc' => 5.4,
+ 'Tie::IxHash' => 1.21,
+ 'YAML' => 0.39,
+ 'List::MoreUtils' => 0.16,
+ }, # e.g., Module::Name => 1.1
+);
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/README
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/README 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/README 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,34 @@
+FormValidator-Simple version 0.01
+=================================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+COPYRIGHT AND LICENCE
+
+
+Copyright (C) 2005 by Lyo Kato
+
+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.5 or,
+at your option, any later version of Perl 5 you may have available.
+
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/ArrayList.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/ArrayList.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/ArrayList.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,42 @@
+package FormValidator::Simple::ArrayList;
+use strict;
+use base qw/Class::Accessor::Fast/;
+use FormValidator::Simple::Iterator;
+
+__PACKAGE__->mk_accessors(qw/records/);
+
+sub new {
+ my $class = shift;
+ my $self = bless { }, $class;
+ $self->records( [ ] );
+ $self->_init(@_);
+ return $self;
+}
+
+sub _init {
+ my ($self, @args) = @_;
+}
+
+sub append {
+ my ($self, $record) = @_;
+ push @{ $self->records }, $record;
+}
+
+sub get_record_at {
+ my ($self, $index) = @_;
+ return $self->records->[$index];
+}
+
+sub records_count {
+ my $self = shift;
+ return scalar @{ $self->records };
+}
+
+sub iterator {
+ my $self = shift;
+ return FormValidator::Simple::Iterator->new($self);
+}
+
+1;
+__END__
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Constants.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Constants.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Constants.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,13 @@
+package FormValidator::Simple::Constants;
+use strict;
+use base qw/Exporter/;
+our @EXPORT = qw/SUCCESS FAIL TRUE FALSE/;
+
+sub SUCCESS { 1 }
+sub FAIL { !SUCCESS }
+sub TRUE { 1 }
+sub FALSE { !TRUE }
+
+1;
+__END__
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Constraint.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Constraint.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Constraint.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,58 @@
+package FormValidator::Simple::Constraint;
+use strict;
+use base qw/Class::Accessor::Fast/;
+use FormValidator::Simple::Exception;
+use FormValidator::Simple::Validator;
+use FormValidator::Simple::Constants;
+
+__PACKAGE__->mk_accessors(qw/name command negative args/);
+
+sub new {
+ my $class = shift;
+ my $self = bless { }, $class;
+ $self->_init(@_);
+ return $self;
+}
+
+sub _init {
+ my ($self, $setting) = @_;
+ if (ref $setting) {
+ my($name, @args) = @$setting;
+ $self->name($name);
+ $self->args( [@args] );
+ } else {
+ $self->name($setting);
+ $self->args( [] );
+ }
+ $self->_check_name;
+}
+
+sub _check_name {
+ my $self = shift;
+ my $name = $self->name;
+ if($name =~ /^NOT_(.+)$/) {
+ $self->command($1);
+ $self->negative( TRUE );
+ } else {
+ $self->command($name);
+ $self->negative( FALSE );
+ }
+}
+
+sub check {
+ my ($self, $params) = @_;
+
+ my $command = $self->command;
+ FormValidator::Simple::Exception->throw(
+ qq/Unknown validation "$command"./
+ ) unless FormValidator::Simple::Validator->can($command);
+
+ my ($result, $data) = FormValidator::Simple::Validator->$command($params, $self->args);
+ $result = not $result if $self->negative;
+ return ($result, $data);
+}
+
+
+1;
+__END__
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Constraints.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Constraints.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Constraints.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,25 @@
+package FormValidator::Simple::Constraints;
+use strict;
+use base qw/FormValidator::Simple::ArrayList/;
+use FormValidator::Simple::Constants;
+use FormValidator::Simple::Iterator;
+
+__PACKAGE__->mk_accessors(qw/needs_blank_check/);
+
+sub _init {
+ my $self = shift;
+ $self->needs_blank_check( FALSE );
+}
+
+sub iterator {
+ my $self = shift;
+ return FormValidator::Simple::Constraint::Iterator->new($self);
+}
+
+package FormValidator::Simple::Constraint::Iterator;
+use base qw/FormValidator::Simple::Iterator/;
+
+1;
+__END__
+
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Data.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Data.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Data.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,53 @@
+package FormValidator::Simple::Data;
+use strict;
+use UNIVERSAL;
+use FormValidator::Simple::Exception;
+use FormValidator::Simple::Constants;
+
+sub new {
+ my $class = shift;
+ my $self = bless { }, $class;
+ $self->_init(@_);
+ return $self;
+}
+
+sub _init {
+ my ($self, $input) = @_;
+ $self->{_records} = {};
+ my $errmsg = qq/Set input data as a hashref or object that has the method 'param()'./;
+ if ( UNIVERSAL::isa( $input, 'UNIVERSAL' ) ) {
+ unless ( $input->can('param') ) {
+ FormValidator::Simple::Exception->throw($errmsg);
+ }
+ foreach my $key ( $input->param ) {
+ my @v = $input->param($key);
+ $self->{_records}{$key} = scalar(@v) > 1 ? \@v : $v[0];
+ }
+ }
+ elsif ( ref $input eq 'HASH' ) {
+ $self->{_records} = $input;
+ }
+ else {
+ FormValidator::Simple::Exception->throw($errmsg);
+ }
+}
+
+sub has_key {
+ my ($self, $key) = @_;
+ return exists $self->{_records}{$key} ? TRUE : FALSE;
+}
+
+sub param {
+ my ($self, $keys) = @_;
+ my @values = map {
+ exists $self->{_records}{$_}
+ ? $self->{_records}{$_}
+ : ''
+ ;
+ } @$keys;
+ return wantarray ? @values : \@values;
+}
+
+1;
+__END__
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Exception.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Exception.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Exception.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,12 @@
+package FormValidator::Simple::Exception;
+use strict;
+
+sub throw {
+ my ($self, $msg) = @_;
+ require Carp;
+ Carp::croak($msg);
+}
+
+1;
+__END__
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Iterator.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Iterator.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Iterator.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,32 @@
+package FormValidator::Simple::Iterator;
+use strict;
+
+sub new {
+ my $class = shift;
+ my $self = bless { }, $class;
+ $self->_init(@_);
+ return $self;
+}
+
+sub _init {
+ my ($self, $records) = @_;
+ $self->{_index} = 0;
+ $self->{_records} = $records;
+}
+
+sub reset {
+ my $self = shift;
+ $self->{_index} = 0;
+}
+
+sub next {
+ my $self = shift;
+ return unless ($self->{_records}->records_count > $self->{_index});
+ my $record = $self->{_records}->get_record_at($self->{_index});
+ $self->{_index}++;
+ return $record;
+}
+
+1;
+__END__
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Messages.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Messages.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Messages.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,61 @@
+package FormValidator::Simple::Messages;
+use strict;
+use YAML;
+use FormValidator::Simple::Exception;
+
+sub new {
+ my $class = shift;
+ my $self = bless {
+ _data => undef,
+ }, $class;
+ return $self;
+}
+
+sub load {
+ my ($self, $data) = @_;
+ if (ref $data eq 'HASH') {
+ $self->{_data} = $data;
+ }
+ elsif (-e $data && -f _ && -r _) {
+ eval {
+ $self->{_data} = YAML::LoadFile($data);
+ };
+ if ($@) {
+ FormValidator::Simple::Exception->throw(
+ qq/failed to load YAML file. "$@"/
+ );
+ }
+ }
+ else {
+ FormValidator::Simple::Exception->throw(
+ qq/set hash reference or YAML file path./
+ );
+ }
+}
+
+sub get {
+ my ($self, $action, $name, $type) = @_;
+ my $data = $self->{_data};
+ unless ($data) {
+ FormValidator::Simple::Exception->throw(
+ qq/set messages before calling get()./
+ );
+ }
+ unless ( exists $data->{$action} ) {
+ return "$name is invalid.";
+ }
+ if ( exists $data->{$action}{$name} ) {
+ my $conf = $data->{$action}{$name};
+ if ( exists $conf->{$type} ) {
+ return $conf->{$type};
+ }
+ elsif ( exists $conf->{DEFAULT} ) {
+ return $conf->{DEFAULT};
+ }
+ }
+ return "$name is invalid.";
+}
+
+1;
+__END__
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Profile.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Profile.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Profile.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,112 @@
+package FormValidator::Simple::Profile;
+use strict;
+use base qw/FormValidator::Simple::ArrayList/;
+use FormValidator::Simple::Exception;
+use FormValidator::Simple::Iterator;
+
+sub _init {
+ my($self, $prof) = @_;
+ while ( my($keys, $constraints) = splice(@$prof, 0, 2) ) {
+ my $record = FormValidator::Simple::Profile::Record->new;
+ $record->set_keys($keys);
+ $record->set_constraints($constraints);
+ $self->append($record);
+ }
+}
+
+sub iterator {
+ my $self = shift;
+ return FormValidator::Simple::Profile::Iterator->new($self);
+}
+
+package FormValidator::Simple::Profile::Record;
+use base qw/Class::Accessor::Fast/;
+use FormValidator::Simple::Exception;
+use FormValidator::Simple::Constants;
+use FormValidator::Simple::Constraints;
+use FormValidator::Simple::Constraint;
+
+__PACKAGE__->mk_accessors(qw/name keys constraints/);
+
+sub new {
+ my $class = shift;
+ my $self = bless { }, $class;
+ $self->_init(@_);
+ return $self;
+}
+
+sub _init {
+ my $self = shift;
+ $self->name( q{ } );
+ $self->keys( [] );
+ $self->constraints( FormValidator::Simple::Constraints->new );
+}
+
+sub set_keys {
+ my ($self, $keys) = @_;
+ if (ref $keys) {
+ if (ref $keys eq 'HASH') {
+ my ($name, $params) = each %$keys;
+ $self->name($name);
+ if(ref $params) {
+ $self->keys( $params );
+ }
+ else {
+ $self->keys( [$params] );
+ }
+ }
+ else {
+ FormValidator::Simple::Exception->throw(
+ qq/set keys of profile as hashref or single scalar./
+ );
+ }
+ }
+ else {
+ $self->name( $keys );
+ $self->keys( [$keys] );
+ }
+}
+
+sub set_constraints {
+ my ($self, $constraints) = @_;
+ $self->constraints( FormValidator::Simple::Constraints->new );
+ if (ref $constraints) {
+
+ if (ref $constraints eq 'ARRAY') {
+
+ SETTING:
+ foreach my $setting ( @$constraints ) {
+ my $const = FormValidator::Simple::Constraint->new($setting);
+ if ($const->name eq 'NOT_BLANK') {
+ $self->constraints->needs_blank_check( TRUE );
+ next SETTING;
+ }
+ else {
+ $self->constraints->append($const);
+ }
+ }
+
+ }
+ else {
+ FormValidator::Simple::Exception->throw(
+ qq/set constraints as arrayref or single scalar./
+ );
+ }
+ }
+ else {
+ my $const = FormValidator::Simple::Constraint->new($constraints);
+ if ($const->name eq 'NOT_BLANK') {
+ $self->constraints->needs_blank_check( TRUE );
+ }
+ else {
+ $self->constraints->append($const);
+ }
+ }
+}
+
+package FormValidator::Simple::Profile::Iterator;
+use base qw/FormValidator::Simple::Iterator/;
+
+1;
+__END__
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Result.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Result.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Result.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,64 @@
+package FormValidator::Simple::Result;
+use strict;
+use base qw/Class::Accessor::Fast/;
+use FormValidator::Simple::Constants;
+use FormValidator::Simple::Exception;
+use Tie::IxHash;
+
+__PACKAGE__->mk_accessors(qw/name constraints data is_blank/);
+
+sub new {
+ my $class = shift;
+ my $self = bless { }, $class;
+ $self->_init(@_);
+ return $self;
+}
+
+sub _init {
+ my ($self, $name) = @_;
+ my %constraints = ();
+ tie (%constraints, 'Tie::IxHash');
+ $self->name($name);
+ $self->constraints(\%constraints);
+ $self->data(q{});
+ $self->is_blank( FALSE );
+}
+
+sub set {
+ my ($self, $constraint, $result) = @_;
+ $self->constraints->{$constraint} = $result;
+}
+
+sub is_valid {
+ my $self = shift;
+ return FALSE if $self->is_blank;
+ foreach my $result ( values %{ $self->constraints } ) {
+ return FALSE unless $result;
+ }
+ return TRUE;
+}
+
+sub is_invalid {
+ my $self = shift;
+ return FALSE if $self->is_blank;
+ foreach my $result ( values %{ $self->constraints } ) {
+ return TRUE unless $result;
+ }
+ return FALSE;
+}
+
+sub is_valid_for {
+ my ($self, $constraint) = @_;
+ return TRUE unless exists $self->constraints->{$constraint};
+ return $self->constraints->{$constraint} ? TRUE : FALSE;
+}
+
+sub is_invalid_for {
+ my ($self, $constraint) = @_;
+ return FALSE unless exists $self->constraints->{$constraint};
+ return $self->constraints->{$constraint} ? FALSE : TRUE;
+}
+
+1;
+__END__
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Results.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Results.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Results.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,345 @@
+package FormValidator::Simple::Results;
+use strict;
+use base qw/Class::Accessor::Fast/;
+use FormValidator::Simple::Result;
+use FormValidator::Simple::Exception;
+use FormValidator::Simple::Constants;
+use Tie::IxHash;
+use List::MoreUtils;
+
+__PACKAGE__->mk_accessors(qw/_records message/);
+
+sub new {
+ my $class = shift;
+ my $self = bless { }, $class;
+ $self->_init(@_);
+ return $self;
+}
+
+sub _init {
+ my ($self, %args) = @_;
+ my %hash = ();
+ tie (%hash, 'Tie::IxHash');
+ $self->_records(\%hash);
+
+ my $messages = delete $args{messages};
+ $self->message($messages);
+}
+
+sub messages {
+ my ($self, $action) = @_;
+ my @messages = ();
+ my $keys = $self->error;
+ foreach my $key ( @$keys ) {
+ my $types = $self->error($key);
+ foreach my $type ( @$types ) {
+ push @messages,
+ $self->message->get($action, $key, $type);
+ }
+ }
+ @messages = List::MoreUtils::uniq(@messages);
+ return \@messages;
+}
+
+sub register {
+ my ($self, $name) = @_;
+ $self->_records->{$name}
+ ||= FormValidator::Simple::Result->new($name);
+}
+
+sub record {
+ my ($self, $name) = @_;
+ $self->register($name)
+ unless exists $self->_records->{$name};
+ return $self->_records->{$name};
+}
+
+sub set_result {
+ my ($self, $name, $type, $result) = @_;
+ $self->register($name);
+ $self->record($name)->set($type, $result);
+}
+
+sub success {
+ my $self = shift;
+ return ($self->has_missing or $self->has_invalid) ? FALSE : TRUE;
+}
+
+sub has_error {
+ my $self = shift;
+ return ($self->has_missing or $self->has_invalid) ? TRUE : FALSE;
+}
+
+sub has_blank {
+ my $self = shift;
+ foreach my $record ( values %{ $self->_records } ) {
+ return TRUE if $record->is_blank;
+ }
+ return FALSE;
+}
+
+*has_missing = \&has_blank;
+
+sub has_invalid {
+ my $self = shift;
+ foreach my $record ( values %{ $self->_records } ) {
+ return TRUE if $record->is_invalid;
+ }
+ return FALSE;
+}
+
+sub valid {
+ my ($self, $name) = @_;
+ if ($name) {
+ return unless exists $self->_records->{$name};
+ return $self->record($name)->is_valid
+ ? $self->record($name)->data : FALSE;
+ }
+ else {
+ my %valids
+ = map { ( $_->name, $_->data ) } grep { $_->is_valid } values %{ $self->_records };
+ return \%valids;
+ }
+}
+
+sub error {
+ my ($self, $name, $constraint) = @_;
+ if ($name) {
+ if ($constraint) {
+ if ($constraint eq 'NOT_BLANK') {
+ return $self->record($name)->is_blank
+ ? TRUE
+ : FALSE
+ ;
+ }
+ return $self->record($name)->is_invalid_for($constraint)
+ ? TRUE
+ : FALSE
+ ;
+ }
+ else {
+ if ($self->record($name)->is_blank) {
+ return wantarray ? 'NOT_BLANK' : ['NOT_BLANK'];
+ }
+ elsif ($self->record($name)->is_invalid) {
+ my $constraints = $self->record($name)->constraints;
+ my @invalids = grep { !$constraints->{$_} } keys %$constraints;
+ return wantarray ? @invalids : \@invalids;
+ }
+ else {
+ return FALSE;
+ }
+ }
+ }
+ else {
+ my @errors =
+ map { $_->name } grep { $_->is_blank or $_->is_invalid } values %{ $self->_records };
+ return wantarray ? @errors : \@errors;
+ }
+}
+
+sub blank {
+ my ($self, $name) = @_;
+ if ($name) {
+ return $self->record($name)->is_blank ? TRUE : FALSE;
+ }
+ else {
+ my @blanks
+ = map { $_->name } grep { $_->is_blank } values %{ $self->_records };
+ return wantarray ? @blanks : \@blanks;
+ }
+}
+
+*missing = \␣
+
+sub invalid {
+ my ($self, $name, $constraint) = @_;
+ if ($name) {
+ if ($constraint) {
+ $self->record($name)->is_invalid_for($constraint)
+ ? TRUE : FALSE;
+ }
+ else {
+ if ($self->record($name)->is_invalid) {
+ my $constraints = $self->record($name)->constraints;
+ my @invalids = grep { !$constraints->{$_} } keys %$constraints;
+ return wantarray ? @invalids : \@invalids;
+ }
+ else {
+ return FALSE;
+ }
+ }
+ }
+ else {
+ my @invalids
+ = map { $_->name } grep { $_->is_invalid } values %{ $self->_records };
+ return wantarray ? @invalids : \@invalids;
+ }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FormValidator::Simple::Results - results of validation
+
+=head1 SYNOPSIS
+
+ my $results = FormValidator::Simple->check( $req => [
+ name => [qw/NOT_BLANK ASCII/, [qw/LENGTH 0 10/] ],
+ email => [qw/NOT_BLANK EMAIL_LOOSE/, [qw/LENGTH 0 30/] ],
+ ] );
+
+ if ( $results->has_error ) {
+ foreach my $key ( @{ $results->error() } ) {
+ foreach my $type ( @{ $results->erorr($key) } ) {
+ print "invalid: $key - $type \n";
+ }
+ }
+ }
+
+=head1 DESCRIPTION
+
+This is for handling resuls of FormValidator::Simple's check.
+
+This object behaves like Data::FormValidator's results object, but
+has some specific methods.
+
+=head1 CHECK RESULT
+
+=over 4
+
+=item has_missing
+
+If there are missing values ( failed in validation 'NOT_BLANK' ), this method returns true.
+
+ if ( $results->has_missing ) {
+ ...
+ }
+
+=item has_invalid
+
+If there are invalid values ( failed in some validations except 'NOT_BLANK' ), this method returns true.
+
+ if ( $results->has_invalid ) {
+ ...
+ }
+
+=item has_error
+
+If there are missing or invalid values, this method returns true.
+
+ if ( $results->has_error ) {
+ ...
+ }
+
+=item success
+
+inverse of has_error
+
+ unless ( $resuls->success ) {
+ ...
+ }
+
+=back
+
+=head1 ANALYZING RESULTS
+
+=head2 missing
+
+=over 4
+
+=item no argument
+
+When you call this method with no argument, it returns keys failed 'NOT_BLANK' validation.
+
+ my $missings = $results->missing;
+ foreach my $missing_data ( @$missings ) {
+ print $missing_data, "\n";
+ }
+ # -- print out, for example --
+ # name
+ # email
+
+=item key
+
+When you call this method with key-name, it returnes true if the value of the key is missing.
+
+ if ( $results->missing('name') ) {
+ print "name is empty! \n";
+ }
+
+=back
+
+=head2 invalid
+
+=over 4
+
+=item no argument
+
+When you call this method with no argument, it returns keys that failed some validation except 'NOT_BLANK'.
+
+ my $invalids = $results->invalid;
+ foreach my $invalid_data ( @$invalids ) {
+ print $invalid_data, "\n";
+ }
+ # -- print out, for example --
+ # name
+ # email
+
+=item key
+
+When you call this method with key-name, it returns names of failed validation.
+
+ my $failed_validations = $results->invalid('name');
+ foreach my $validation ( @$failed_validations ) {
+ print $validation, "\n";
+ }
+ # -- print out, for example --
+ # ASCII
+ # LENGTH
+
+=item key and validation-name
+
+When you call this method with key-name, it returns false if the value has passed the validation.
+
+ if ( $results->invalid( name => 'LENGTH' ) ) {
+ print "name is wrong length! \n";
+ }
+
+=back
+
+=head2 error
+
+This doesn't distinguish 'missing' and 'invalid'. You can use this like 'invalid' method,
+but this consider 'NOT_BLANK' same as other validations.
+
+ my $error_keys = $results->error;
+
+ my $failed_validation = $resuls->error('name');
+ # this includes 'NOT_BLANK'
+
+ if ( $results->error( name => 'NOT_BLANK' ) ) {
+ print "name is missing! \n";
+ }
+
+ if ( $results->error( name => 'ASCII' ) ) {
+ print "name should be ascii code! \n";
+ }
+
+=head1 SEE ALSO
+
+L<FormValidator::Simple>
+
+=head1 AUTHOR
+
+Lyo Kato E<lt>lyo.kato at gmail.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+This library is free software.
+You can redistribute it and/or modify it under the same terms as perl itself.
+
+=cut
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Validator.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Validator.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple/Validator.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,296 @@
+package FormValidator::Simple::Validator;
+use strict;
+use base qw/Class::Data::Inheritable/;
+
+use FormValidator::Simple::Constants;
+use FormValidator::Simple::Exception;
+use Email::Valid;
+use Email::Valid::Loose;
+use Date::Calc;
+use UNIVERSAL::require;
+
+__PACKAGE__->mk_classdata( options => { } );
+
+sub SP {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ return $data =~ /\s/ ? TRUE : FALSE;
+}
+
+*SPACE = \&SP;
+
+sub INT {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ return $data =~ /^\-?[\d]+$/ ? TRUE : FALSE;
+}
+
+sub ASCII {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ return $data =~ /^[\x21-\x7E]+$/ ? TRUE : FALSE;
+}
+
+sub DUPLICATION {
+ my ($self, $params, $args) = @_;
+ my $data1 = $params->[0];
+ my $data2 = $params->[1];
+ unless (defined $data1 && defined $data2) {
+ FormValidator::Simple::Exception->throw(
+ qq/validation "DUPLICATION" needs two keys of data./
+ );
+ }
+ return $data1 eq $data2 ? TRUE : FALSE;
+}
+
+sub LENGTH {
+ my ($self, $params, $args) = @_;
+ unless ( scalar(@$args) > 0 ) {
+ FormValidator::Simple::Exception->throw(
+ qq/validation "LENGTH" needs one or two arguments./
+ );
+ }
+ my $data = $params->[0];
+ my $length = length $data;
+ my $min = $args->[0];
+ my $max = $args->[1] || $min;
+ $min += 0;
+ $max += 0;
+ return $min <= $length && $length <= $max ? TRUE : FALSE;
+}
+
+sub REGEX {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ my $regex = $args->[0];
+ return $data =~ /$regex/ ? TRUE : FALSE;
+}
+
+sub EMAIL {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ return FALSE unless $data;
+ return Email::Valid->address(-address => $data) ? TRUE : FALSE;
+}
+
+sub EMAIL_MX {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ return FALSE unless $data;
+ return Email::Valid->address(-address => $data, -mxcheck => 1) ? TRUE : FALSE;
+}
+
+sub EMAIL_LOOSE {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ return FALSE unless $data;
+ return Email::Valid::Loose->address($data) ? TRUE : FALSE;
+}
+
+sub EMAIL_LOOSE_MX {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ return FALSE unless $data;
+ return Email::Valid::Loose->address(-address => $data, -mxcheck => 1) ? TRUE : FALSE;
+}
+
+sub DATE {
+ my ($self, $params, $args) = @_;
+ my ($year, $month, $day ) = @$params;
+ my $result = Date::Calc::check_date($year, $month, $day) ? TRUE : FALSE;
+ my $data;
+ if ($result) {
+ my $class = $self->options->{datetime_class} || '';
+ if ($class eq 'DateTime') {
+ $class->require;
+ if ($@) {
+ FormValidator::Simple::Exception->throw(
+ qq/Validation DATE: failed to require $class. "$@"./
+ );
+ }
+ my %date = (
+ year => $year,
+ month => $month,
+ day => $day,
+ );
+ if ($self->options->{time_zone}) {
+ $date{time_zone} = $self->options->{time_zone};
+ }
+ $data = $class->new(%date);
+ }
+ elsif ($class eq 'Time::Piece') {
+ $data = sprintf "%04d-%02d-%02d 00:00:00", $year, $month, $day;
+ $class->require;
+ if ($@) {
+ FormValidator::Simple::Exception->throw(
+ qq/Validation DATE: failed to require $class. "$@"./
+ );
+ }
+ $data = $class->strptime($data, "%Y-%m-%d %H:%M:%S");
+ }
+ else {
+ $data = sprintf "%04d-%02d-%02d 00:00:00", $year, $month, $day;
+ }
+ }
+ return ($result, $data);
+}
+
+sub TIME {
+ my ($self, $params, $args) = @_;
+ my ($hour, $min, $sec ) = @$params;
+ $hour ||= 0;
+ $min ||= 0;
+ $sec ||= 0;
+ my $result = Date::Calc::check_time($hour, $min, $sec) ? TRUE : FALSE;
+ my $time = $result ? sprintf("%02d:%02d:%02d", $hour, $min, $sec) : undef;
+ return ($result, $time);
+}
+
+sub DATETIME {
+ my ($self, $params, $args) = @_;
+ my ($year, $month, $day, $hour, $min, $sec) = @$params;
+ $hour ||= 0;
+ $min ||= 0;
+ $sec ||= 0;
+ my $result = Date::Calc::check_date($year, $month, $day)
+ && Date::Calc::check_time($hour, $min, $sec) ? TRUE : FALSE;
+ my $data;
+ if ($result) {
+ my $class = $self->options->{datetime_class} || '';
+ if ($class eq 'DateTime') {
+ $class->require;
+ if ($@) {
+ FormValidator::Simple::Exception->throw(
+ qq/Validation DATETIME: failed to require $class. "$@"./
+ );
+ }
+ my %date = (
+ year => $year,
+ month => $month,
+ day => $day,
+ hour => $hour,
+ minute => $min,
+ second => $sec,
+ );
+ if ($self->options->{time_zone}) {
+ $date{time_zone} = $self->options->{time_zone};
+ }
+ $data = $class->new(%date);
+ }
+ elsif ($class eq 'Time::Piece') {
+ $data = sprintf "%04d-%02d-%02d %02d:%02d:%02d",
+ $year, $month, $day, $hour, $min, $sec;
+ $class->require;
+ if ($@) {
+ FormValidator::Simple::Exception->throw(
+ qq/Validation DATETIME: failed to require $class. "$@"./
+ );
+ }
+ $data = $class->strptime($data, "%Y-%m-%d %H:%M:%S");
+ }
+ else {
+ $data = sprintf "%04d-%02d-%02d %02d:%02d:%02d",
+ $year, $month, $day, $hour, $min, $sec;
+ }
+ }
+ return ($result, $data);
+}
+
+sub ANY {
+ my ($self, $params, $args) = @_;
+ foreach my $param ( @$params ) {
+ return TRUE if ( defined $param && $param ne '' );
+ }
+ return FALSE;
+}
+
+sub HTTP_URL {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ return $data =~ /^s?https?:\/\/[-_.!~*'()a-zA-Z0-9;\/?:\@&=+\$,%#]+$/ ? TRUE : FALSE;
+}
+
+sub SELECTED_AT_LEAST {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ my $selected = ref $data ? $data : [$data];
+ my $num = $args->[0] + 0;
+ return scalar(@$selected) >= $num ? TRUE : FALSE;
+}
+
+sub GREATER_THAN {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ my $target = $args->[0];
+ unless ( $target && $target =~ /^\d+$/ ) {
+ FormValidator::Simple::Exception->throw(
+ qq/Validation GREATER_THAN needs a numeric argument./
+ );
+ }
+ return FALSE unless $data =~ /^\d+$/;
+ return ( $data > $target ) ? TRUE : FALSE;
+}
+
+sub LESS_THAN {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ my $target = $args->[0];
+ unless ( $target && $target =~ /^\d+$/ ) {
+ FormValidator::Simple::Exception->throw(
+ qq/Validation LESS_THAN needs a numeric argument./
+ );
+ }
+ return FALSE unless $data =~ /^\d+$/;
+ return ( $data < $target ) ? TRUE : FALSE;
+}
+
+sub EQUAL_TO {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ my $target = $args->[0];
+ unless ( $target && $target =~ /^\d+$/ ) {
+ FormValidator::Simple::Exception->throw(
+ qq/Validation EQUAL_TO needs a numeric argument./
+ );
+ }
+ return FALSE unless $data =~ /^\d+$/;
+ return ( $data == $target ) ? TRUE : FALSE;
+}
+
+sub BETWEEN {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ my $start = $args->[0];
+ my $end = $args->[1];
+ unless ( $start && $start =~ /^\d+$/ && $end && $end =~ /^\d+$/ ) {
+ FormValidator::Simple::Exception->throw(
+ qq/Validation BETWEEN needs two numeric arguments./
+ );
+ }
+ return FALSE unless $data =~ /^\d+$/;
+ return ( $data >= $start && $data <= $end ) ? TRUE : FALSE;
+}
+
+sub DECIMAL {
+ my ($self, $params, $args) = @_;
+ my $data = $params->[0];
+ unless ( scalar(@$args) > 0 ) {
+ FormValidator::Simple::Exception->throw(
+ qq/Validation DECIMAL needs one or two numeric arguments./
+ );
+ }
+ my $digit1 = $args->[0];
+ my $digit2 = $args->[1] || 0;
+ unless ( $digit1 =~ /^\d+$/ && $digit2 =~ /^\d+$/ ) {
+ FormValidator::Simple::Exception->throw(
+ qq/Validation DECIMAL needs one or two numeric arguments./
+ );
+ }
+ return FALSE unless $data =~ /^\d+(\.\d+)?$/;
+ my $reg = qr/^\d{1,$digit1}(\.\d{0,$digit2})?$/;
+ return $data =~ /$reg/ ? TRUE : FALSE;
+}
+
+1;
+__END__
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/lib/FormValidator/Simple.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,599 @@
+package FormValidator::Simple;
+use strict;
+use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
+use Class::Inspector;
+use UNIVERSAL::require;
+use FormValidator::Simple::Results;
+use FormValidator::Simple::Exception;
+use FormValidator::Simple::Data;
+use FormValidator::Simple::Profile;
+use FormValidator::Simple::Validator;
+use FormValidator::Simple::Constants;
+use FormValidator::Simple::Messages;
+
+our $VERSION = '0.11';
+
+__PACKAGE__->mk_accessors(qw/data prof results/);
+
+__PACKAGE__->mk_classdata( messages => FormValidator::Simple::Messages->new );
+
+sub import {
+ my $class = shift;
+ foreach my $plugin (@_) {
+ my $plugin_class = "FormValidator::Simple::Plugin::".$plugin;
+ $class->load_plugin($plugin_class);
+ }
+}
+
+sub load_plugin {
+ my ($proto, $plugin) = @_;
+ my $class = ref $proto || $proto;
+ unless (Class::Inspector->installed($plugin)) {
+ FormValidator::Simple::Exception->throw(
+ qq/$plugin isn't installed./
+ );
+ }
+ $plugin->require;
+ if ($@) {
+ FormValidator::Simple::Exception->throw(
+ qq/Couldn't require "$plugin", "$@"./
+ );
+ }
+ {
+ no strict 'refs';
+ push @FormValidator::Simple::Validator::ISA, $plugin;
+ }
+}
+
+sub set_option {
+ my $class = shift;
+ while ( my ($key, $val) = splice @_, 0, 2 ) {
+ FormValidator::Simple::Validator->options->{$key} = $val;
+ }
+}
+
+sub set_messages {
+ my ($proto, $file) = @_;
+ my $class = ref $proto || $proto;
+ $class->messages->load($file);
+}
+
+sub new {
+ my $proto = shift;
+ my $class = ref $proto || $proto;
+ my $self = bless { }, $class;
+ $self->_init(@_);
+ return $self;
+}
+
+sub _init {
+ my ($self, @args) = @_;
+ my $class = ref $self;
+ $class->set_option(@args);
+ $self->results( FormValidator::Simple::Results->new(
+ messages => $class->messages,
+ ) );
+}
+
+sub set_invalid {
+ my ($self, $name, $type) = @_;
+ unless (ref $self) {
+ FormValidator::Simple::Exception->throw(
+ qq/set_invalid is instance method./
+ );
+ }
+ unless ($name && $type) {
+ FormValidator::Simple::Exception->throw(
+ qq/set_invalid needs two arguments./
+ );
+ }
+ $self->results->set_result($name, $type, FALSE);
+}
+
+sub check {
+ my ($proto, $input, $prof, $options) = @_;
+ $options ||= {};
+ my $self = ref $proto ? $proto : $proto->new(%$options);
+
+ my $data = FormValidator::Simple::Data->new($input);
+ my $prof_setting = FormValidator::Simple::Profile->new($prof);
+
+ my $profile_iterator = $prof_setting->iterator;
+
+ PROFILE:
+ while ( my $profile = $profile_iterator->next ) {
+
+ my $name = $profile->name;
+ my $keys = $profile->keys;
+ my $constraints = $profile->constraints;
+
+ my $params = $data->param($keys);
+
+ $self->results->register($name);
+
+ $self->results->record($name)->data( @$params == 1 ? $params->[0] : '');
+
+ my $constraint_iterator = $constraints->iterator;
+ if ( scalar @$params == 1 ) {
+ unless ( defined $params->[0] && $params->[0] ne '' ) {
+ if ( $constraints->needs_blank_check ) {
+ $self->results->record($name)->is_blank( TRUE );
+ }
+ next PROFILE;
+ }
+ }
+
+ CONSTRAINT:
+ while ( my $constraint = $constraint_iterator->next ) {
+
+ my ($result, $data) = $constraint->check($params);
+
+ $self->results->set_result($name, $constraint->name, $result);
+
+ $self->results->record($name)->data($data) if $data;
+ }
+
+ }
+ return $self->results;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FormValidator::Simple - validation with simple chains of constraints
+
+=head1 SYNOPSIS
+
+ my $query = CGI->new;
+ $query->param( param1 => 'ABCD' );
+ $query->param( param2 => 12345 );
+ $query->param( mail1 => 'lyo.kato at gmail.com' );
+ $query->param( mail2 => 'lyo.kato at gmail.com' );
+ $query->param( year => 2005 );
+ $query->param( month => 11 );
+ $query->param( day => 27 );
+
+ my $result = FormValidator::Simple->check( $query => [
+ param1 => ['NOT_BLANK', 'ASCII', ['LENGTH', 2, 5]],
+ param2 => ['NOT_BLANK', 'INT' ],
+ mail1 => ['NOT_BLANK', 'EMAIL_LOOSE'],
+ mail2 => ['NOT_BLANK', 'EMAIL_LOOSE'],
+ { mails => ['mail1', 'mail2' ] } => ['DUPLICATION'],
+ { date => ['year', 'month', 'day'] } => ['DATE'],
+ ] );
+
+ if ( $result->has_error ) {
+ my $tt = Template->new({ INCLUDE_PATH => './tmpl' });
+ $tt->process('template.html', { result => $result });
+ }
+
+template example
+
+ [% IF result.has_error %]
+ <p>Found Input Error</p>
+ <ul>
+
+ [% IF result.missing('param1') %]
+ <li>param1 is blank.</li>
+ [% END %]
+
+ [% IF result.invalid('param1') %]
+ <li>param1 is invalid.</li>
+ [% END %]
+
+ [% IF result.invalid('param1', 'ASCII') %]
+ <li>param1 needs ascii code.</li>
+ [% END %]
+
+ [% IF result.invalid('param1', 'LENGTH') %]
+ <li>input into param1 with characters that's length should be between two and five. </li>
+ [% END %]
+
+ </ul>
+ [% END %]
+
+example2
+
+ [% IF result.has_error %]
+ <ul>
+ [% FOREACH key IN result.error %]
+ [% FOREACH type IN result.error(key) %]
+ <li>invalid: [% key %] - [% type %]</li>
+ [% END %]
+ [% END %]
+ </ul>
+ [% END %]
+
+=head1 DESCRIPTION
+
+This module provides you a sweet way of form data validation with simple constraints chains.
+You can write constraints on single line for each input data.
+
+This idea is based on Sledge::Plugin::Validator, and most of validation code is borrowed from this plugin.
+
+(Sledge is a MVC web application framework: http://sl.edge.jp [Japanese] )
+
+The result object this module returns behaves like L<Data::FormValidator::Results>.
+
+=head1 HOW TO SET PROFILE
+
+ FormValidator::Simple->check( $q => [
+ #profile
+ ] );
+
+Use 'check' method.
+
+A hash reference includes input data, or an object of some class that has a method named 'param', for example L<CGI>, is needed as first argument.
+
+And set profile as array reference into second argument. Profile confists of some pairs of input data and constraints.
+
+ my $q = CGI->new;
+ $q->param( param1 => 'hoge' );
+
+ FormValidator::Simple->check( $q => [
+ param1 => [ ['NOT_BLANK'], ['LENGTH', 4, 10] ],
+ ] );
+
+In this case, param1 is the name of a form element. and the array ref "[ ['NOT_BLANK']... ]" is a constraints chain.
+
+Write constraints chain as arrayref, and you can set some constraints into it. In the last example, two constraints
+'NOT_BLANK', and 'LENGTH' are set. Each constraints is should be set as arrayref, but in case the constraint has no
+argument, it can be written as scalar text.
+
+ FormValidator::Simple->check( $q => [
+ param1 => [ 'NOT_BLANK', ['LENGTH', 4, 10] ],
+ ] );
+
+Now, in this sample 'NOT_BLANK' constraint is not an arrayref, but 'LENGTH' isn't. Because 'LENGTH' has two arguments, 4 and 10.
+
+=head2 MULTIPLE DATA VALIDATION
+
+When you want to check about multiple input data, do like this.
+
+ my $q = CGI->new;
+ $q->param( mail1 => 'lyo.kato at gmail.com' );
+ $q->param( mail2 => 'lyo.kato at gmail.com' );
+
+ my $result = FormValidator::Simple->check( $q => [
+ { mails => ['mail1', 'mail2'] } => [ 'DUPLICATION' ],
+ ] )
+
+ [% IF result.invalid('mails') %]
+ <p>mail1 and mail2 aren't same.</p>
+ [% END %]
+
+and here's an another example.
+
+ my $q = CGI->new;
+ $q->param( year => 2005 );
+ $q->param( month => 12 );
+ $q->param( day => 27 );
+
+ my $result = FormValidator::Simple->check( $q => [
+ { date => ['year', 'month', 'day'] } => [ 'DATE' ],
+ ] );
+
+ [% IF result.invalid('date') %]
+ <p>Set correct date.</p>
+ [% END %]
+
+=head2 FLEXIBLE VALIDATION
+
+ my $valid = FormValidator::Simple->new();
+
+ $valid->check( $q => [
+ param1 => [qw/NOT_BLANK ASCII/, [qw/LENGTH 4 10/] ],
+ ] );
+
+ $valid->check( $q => [
+ param2 => [qw/NOT_BLANK/],
+ ] );
+
+ my $results = $valid->results;
+
+ if ( found some error... ) {
+ $results->set_invalid('param3' => 'MY_ERROR');
+ }
+
+template example
+
+ [% IF results.invalid('param1') %]
+ ...
+ [% END %]
+ [% IF results.invalid('param2') %]
+ ...
+ [% END %]
+ [% IF results.invalid('param3', 'MY_ERROR') %]
+ ...
+ [% END %]
+
+=head1 HOW TO SET OPTIONS
+
+Option setting is needed by some validation, especially in plugins.
+
+You can set them in two ways.
+
+ FormValidator::Simple->set_option(
+ dbic_base_class => 'MyProj::Model::DBIC',
+ charset => 'euc',
+ );
+
+or
+
+ $valid = FormValidator::Simple->new(
+ dbic_base_class => 'MyProj::Model::DBIC',
+ charset => 'euc',
+ );
+
+ $valid->check(...)
+
+=head1 VALIDATION COMMANDS
+
+You can use follow variety validations.
+and each validations can be used as negative validation with 'NOT_' prefix.
+
+ FormValidator::Simple->check( $q => [
+ param1 => [ 'INT', ['LENGTH', 4, 10] ],
+ param2 => [ 'NOT_INT', ['NOT_LENGTH', 4, 10] ],
+ ] );
+
+=over 4
+
+=item SP
+
+check if the data has space or not.
+
+=item INT
+
+check if the data is integer or not.
+
+=item DECIMAL
+
+ $q->param( 'num1' => '123.45678' );
+
+ my $result = FormValidator::Simple->check( $q => [
+ num1 => [ ['DECIMAL', 3, 5] ],
+ ] );
+
+each numbers (3,5) mean maximum digits before/after '.'
+
+=item ASCII
+
+check is the data consists of only ascii code.
+
+=item LENGTH
+
+check the length of the data.
+
+ my $result = FormValidator::Simple->check( $q => [
+ param1 => [ ['LENGTH', 4] ],
+ ] );
+
+check if the length of the data is 4 or not.
+
+ my $result = FormValidator::Simple->check( $q => [
+ param1 => [ ['LENGTH', 4, 10] ],
+ ] );
+
+when you set two arguments, it checks if the length of data is in
+the range between 4 and 10.
+
+=item HTTP_URL
+
+verify it is a http(s)-url
+
+ my $result = FormValidator::Simple->check( $q => [
+ param1 => [ 'HTTP_URL' ],
+ ] );
+
+=item SELECTED_AT_LEAST
+
+verify the quantity of selected parameters is counted over allowed minimum.
+
+ <input type="checkbox" name="hobby" value="music" /> Music
+ <input type="checkbox" name="hobby" value="movie" /> Movie
+ <input type="checkbox" name="hobby" value="game" /> Game
+
+ my $result = FormValidator::Simple->check( $q => [
+ hobby => ['NOT_BLANK', ['SELECTED_AT_LEAST', 2] ],
+ ] );
+
+=item REGEX
+
+check with regular expression.
+
+ my $result = FormValidator::Simple->check( $q => [
+ param1 => [ ['REGEX', qr/^hoge$/ ] ],
+ ] );
+
+=item DUPLICATION
+
+check if the two data are same or not.
+
+ my $result = FormValidator::Simple->check( $q => [
+ { duplication_check => ['param1', 'param2'] } => [ 'DUPLICATION' ],
+ ] );
+
+=item EMAIL
+
+check with L<Email::Valid>.
+
+=item EMAIL_MX
+
+check with L<Email::Valid>, including mx check.
+
+=item EMAIL_LOOSE
+
+check with L<Email::Valid::Loose>.
+
+=item EMAIL_LOOSE_MX
+
+check with L<Email::Valid::Loose>, including mx check.
+
+=item DATE
+
+check with L<Date::Calc>
+
+ my $result = FormValidator::Simple->check( $q => [
+ { date => [qw/year month day/] } => [ 'DATE' ]
+ ] );
+
+=item TIME
+
+check with L<Date::Calc>
+
+ my $result = FormValidator::Simple->check( $q => [
+ { time => [qw/hour min sec/] } => ['TIME'],
+ ] );
+
+=item DATETIME
+
+check with L<Date::Calc>
+
+ my $result = FormValidator::Simple->check( $q => [
+ { datetime => [qw/year month day hour min sec/] } => ['DATETIME']
+ ] );
+
+=item GREATER_THAN
+
+numeric comparison
+
+ my $result = FormValidator::Simple->check( $q => [
+ age => [ ['GREATER_THAN', 25] ],
+ ] );
+
+=item LESS_THAN
+
+numeric comparison
+
+ my $result = FormValidator::Simple->check( $q => [
+ age => [ ['LESS_THAN', 25] ],
+ ] );
+
+=item EQUAL_TO
+
+numeric comparison
+
+ my $result = FormValidator::Simple->check( $q => [
+ age => [ ['EQUAL_TO', 25] ],
+ ] );
+
+=item BETWEEN
+
+numeric comparison
+
+ my $result = FormValidator::Simple->check( $q => [
+ age => [ ['BETWEEN', 20, 25] ],
+ ] );
+
+=item ANY
+
+check if there is not blank data in multiple data.
+
+ my $result = FormValidator::Simple->check( $q => [
+ { some_data => [qw/param1 param2 param3/] } => ['ANY']
+ ] );
+
+=back
+
+=head1 HOW TO LOAD PLUGINS
+
+ use FormValidator::Simple qw/Japanese CreditCard/;
+
+L<FormValidator::Simple::Plugin::Japanese>, L<FormValidator::Simple::Plugin::CreditCard> are loaded.
+
+or use 'load_plugin' method.
+
+ use FormValidator::Simple;
+ FormValidator::Simple->load_plugin('FormValidator::Simple::Plugin::CreditCard');
+
+=head1 MESSAGE HANDLING
+
+You can custom your own message with key and type.
+
+ [% IF result.has_error %]
+ [% FOREACH key IN result.error %]
+ [% FOREACH type IN result.error(key) %]
+ <p>error message:[% type %] - [% key %]</p>
+ [% END %]
+ [% END %]
+ [% END %]
+
+And you can also set messages configuration before.
+You can prepare configuration as hash reference.
+
+ FormValidator::Simple->set_messages( {
+ action1 => {
+ name => {
+ NOT_BLANK => 'input name!',
+ LENGTH => 'input name (length should be between 0 and 10)!',
+ },
+ email => {
+ DEFAULT => 'input correct email address!',
+ },
+ },
+ } );
+
+or a YAML file.
+
+ # messages.yml
+ action1:
+ name:
+ NOT_BLANK: input name!
+ LENGTH: input name(length should be between 0 and 10)!
+ email:
+ DEFAULT: input correct email address!
+
+ # in your perl-script, set the file's path.
+ FormValidator::Simple->set_messages('messages.yml');
+
+DEFAULT is a special type.
+If it can't find setting for indicated validation-type, it uses message set for DEFAULT.
+
+after setting, execute check(),
+
+ my $result = FormValidator::Simple->check( $q => [
+ name => [qw/NOT_BLANK/, [qw/LENGTH 0 10/] ],
+ email => [qw/NOT_BLANK EMAIL_LOOSE/, [qw/LENGTH 0 20/] ],
+ ] );
+
+ # matching result and messages for indicated action.
+ my $messages = $result->messages('action1');
+
+ foreach my $message ( @$messages ) {
+ print $message, "\n";
+ }
+
+If in template file,
+
+ [% IF result.has_error %]
+ [% FOREACH msg IN result.messages('action1') %]
+ <p>[% msg %]</p>
+ [% END %]
+ [% END %]
+
+=head1 RESULT HANDLING
+
+See L<FormValidator::Simple::Results>
+
+=head1 SEE ALSO
+
+L<Data::FormValidator>
+
+http://sl.edge.jp/ (Japanese)
+
+http://sourceforge.jp/projects/sledge
+
+=head1 AUTHOR
+
+Lyo Kato E<lt>lyo.kato at gmail.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+This library is free software.
+You can redistribute it and/or modify it under the same terms as perl itself.
+
+=cut
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/00_compile.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/00_compile.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/00_compile.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,6 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN{ use_ok("FormValidator::Simple") }
+
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/01_constraint.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/01_constraint.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/01_constraint.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,51 @@
+use strict;
+use Test::More tests => 23;
+
+BEGIN{ use_ok("FormValidator::Simple::Constraint") }
+
+my $c1 = FormValidator::Simple::Constraint->new( ['NOT_BLANK'] );
+
+is( $c1->name, 'NOT_BLANK' );
+is( $c1->command, 'BLANK' );
+ok( $c1->negative );
+
+my $c2 = FormValidator::Simple::Constraint->new( 'NOT_BLANK' );
+
+is( $c2->name, 'NOT_BLANK' );
+is( $c2->command, 'BLANK' );
+ok( $c2->negative );
+
+my $c3 = FormValidator::Simple::Constraint->new( ['INT'] );
+
+is( $c3->name, 'INT' );
+is( $c3->command, 'INT' );
+ok( !$c3->negative );
+
+my $c4 = FormValidator::Simple::Constraint->new( 'ASCII' );
+
+is( $c4->name, 'ASCII' );
+is( $c4->command, 'ASCII' );
+ok( !$c4->negative );
+
+my $c5 = FormValidator::Simple::Constraint->new( [qw/LENGTH 3 10/] );
+
+is( $c5->name, 'LENGTH' );
+is( $c5->command, 'LENGTH' );
+ok( !$c5->negative );
+
+my $args5 = $c5->args;
+
+is( $args5->[0], 3 );
+is( $args5->[1], 10 );
+
+my $c6 = FormValidator::Simple::Constraint->new( [qw/NOT_LENGTH 2 5/] );
+
+is( $c6->name, 'NOT_LENGTH' );
+is( $c6->command, 'LENGTH' );
+ok( $c6->negative );
+
+my $args6 = $c6->args;
+
+is( $args6->[0], 2 );
+is( $args6->[1], 5 );
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/02_constraints.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/02_constraints.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/02_constraints.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,45 @@
+use strict;
+use Test::More tests => 11;
+
+BEGIN{ use_ok("FormValidator::Simple::Constraints") }
+
+my $constraints = FormValidator::Simple::Constraints->new;
+
+ok( !$constraints->needs_blank_check );
+
+require FormValidator::Simple::Constraint;
+my $c1 = FormValidator::Simple::Constraint->new('INT');
+my $c2 = FormValidator::Simple::Constraint->new('ASCII');
+my $c3 = FormValidator::Simple::Constraint->new([qw/LENGTH 5 10/]);
+
+is( $constraints->records_count, 0 );
+
+$constraints->append($c1);
+$constraints->append($c2);
+$constraints->append($c3);
+
+is( $constraints->records_count, 3 );
+
+my $c4 = $constraints->get_record_at(1);
+
+is( $c4->name, 'ASCII' );
+
+my $ite = $constraints->iterator;
+
+isa_ok( $ite, "FormValidator::Simple::Constraint::Iterator" );
+
+my $c5 = $ite->next;
+my $c6 = $ite->next;
+my $c7 = $ite->next;
+my $c8 = $ite->next;
+
+is( $c5->name, 'INT' );
+is( $c6->name, 'ASCII' );
+is( $c7->name, 'LENGTH' );
+is( $c8, undef );
+
+$ite->reset;
+my $c9 = $ite->next;
+
+is( $c9->name, 'INT' );
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/03_profile.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/03_profile.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/03_profile.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,110 @@
+use strict;
+use Test::More tests => 42;
+
+BEGIN{ use_ok("FormValidator::Simple::Profile") }
+
+my $rec = FormValidator::Simple::Profile::Record->new;
+
+$rec->set_keys( { id => ['key'] } );
+
+is( $rec->name, 'id' );
+is( $rec->keys->[0], 'key' );
+
+$rec->set_keys( { 'id2' => 'key2' } );
+
+is( $rec->name, 'id2' );
+is( $rec->keys->[0], 'key2' );
+
+$rec->set_keys( { 'id3' => [qw/key3 key4 key5/] } );
+
+is( $rec->name, 'id3' );
+is( $rec->keys->[0], 'key3' );
+is( $rec->keys->[1], 'key4' );
+is( $rec->keys->[2], 'key5' );
+
+$rec->set_keys( 'id4' );
+
+is( $rec->name, 'id4' );
+is( $rec->keys->[0], 'id4' );
+
+isa_ok( $rec->constraints, "FormValidator::Simple::Constraints" );
+
+$rec->set_constraints( ['INT'] );
+
+my $c1 = $rec->constraints->get_record_at(0);
+
+is( $c1->name, 'INT' );
+
+$rec->set_constraints( [qw/ASCII INT/,[qw/LENGTH 4 10/]] );
+
+my $c2 = $rec->constraints->get_record_at(0);
+my $c3 = $rec->constraints->get_record_at(1);
+my $c4 = $rec->constraints->get_record_at(2);
+
+is( $rec->constraints->records_count, 3 );
+ok( !$rec->constraints->needs_blank_check );
+is( $c2->name, 'ASCII' );
+is( $c3->name, 'INT' );
+is( $c4->name, 'LENGTH' );
+is( $c4->args->[0], 4 );
+is( $c4->args->[1], 10 );
+
+$rec->set_constraints( [qw/NOT_BLANK ASCII INT/] );
+
+my $c5 = $rec->constraints->get_record_at(0);
+my $c6 = $rec->constraints->get_record_at(1);
+
+is( $rec->constraints->records_count, 2 );
+ok( $rec->constraints->needs_blank_check );
+is( $c5->name, 'ASCII' );
+is( $c6->name, 'INT' );
+
+$rec->set_constraints('INT');
+
+my $c7 = $rec->constraints->get_record_at(0);
+
+is( $c7->name, 'INT' );
+
+$rec->set_constraints( ['NOT_BLANK'] );
+
+is( $rec->constraints->records_count, 0 );
+ok( $rec->constraints->needs_blank_check );
+
+my $prof = FormValidator::Simple::Profile->new( [
+ id => [qw/NOT_BLANK/],
+ { name => [qw/name1 name2/] } => [qw/ANY/],
+ pass => [qw/NOT_BLANK ASCII/,['LENGTH', 4, 10]]
+] );
+
+my $prec1 = $prof->get_record_at(0);
+my $prec2 = $prof->get_record_at(1);
+my $prec3 = $prof->get_record_at(2);
+
+is( $prof->records_count, 3 );
+
+isa_ok( $prec1, "FormValidator::Simple::Profile::Record" );
+isa_ok( $prec2, "FormValidator::Simple::Profile::Record" );
+isa_ok( $prec3, "FormValidator::Simple::Profile::Record" );
+
+ok( $prec1->constraints->needs_blank_check );
+is( $prec1->constraints->records_count, 0 );
+ok( !$prec2->constraints->needs_blank_check );
+is( $prec2->constraints->records_count, 1 );
+ok( $prec3->constraints->needs_blank_check );
+is( $prec3->constraints->records_count, 2 );
+
+my $ite = $prof->iterator;
+
+isa_ok( $ite, "FormValidator::Simple::Profile::Iterator" );
+
+my $prec4 = $ite->next;
+my $prec5 = $ite->next;
+my $prec6 = $ite->next;
+my $prec7 = $ite->next;
+
+is( $prec7, undef );
+
+is( $prec4->name, 'id' );
+is( $prec5->name, 'name' );
+is( $prec6->name, 'pass' );
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/04_result.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/04_result.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/04_result.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,29 @@
+use strict;
+use Test::More tests => 13;
+
+BEGIN{ use_ok("FormValidator::Simple::Result") }
+
+my $r1 = FormValidator::Simple::Result->new('id1');
+
+is( $r1->name, 'id1' );
+ok( !$r1->is_blank );
+
+$r1->set('ASCII', 1 );
+
+ok( $r1->is_valid );
+ok( !$r1->is_invalid );
+
+$r1->set('INT', undef );
+$r1->set('LENGTH', undef );
+
+ok( !$r1->is_valid );
+ok( $r1->is_invalid );
+
+ok( $r1->is_valid_for('ASCII') );
+ok( !$r1->is_valid_for('INT') );
+ok( !$r1->is_valid_for('LENGTH') );
+
+ok( !$r1->is_invalid_for('ASCII') );
+ok( $r1->is_invalid_for('INT') );
+ok( $r1->is_invalid_for('LENGTH') );
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/05_results.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/05_results.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/05_results.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,57 @@
+use strict;
+use Test::More tests => 29;
+
+BEGIN{ use_ok("FormValidator::Simple::Results") }
+
+my $results = FormValidator::Simple::Results->new;
+
+$results->register('r1');
+$results->register('r2');
+$results->register('r3');
+
+my $valids = $results->valid;
+is( scalar(keys %$valids), 3 );
+ok( exists $valids->{r1});
+ok( exists $valids->{r2});
+ok( !$results->has_missing );
+ok( !$results->has_invalid );
+
+$results->record('r1')->is_blank(1);
+
+my $valids2 = $results->valid;
+is( scalar(keys %$valids2), 2 );
+ok( exists $valids2->{r2});
+ok( exists $valids2->{r3});
+ok( $results->has_error );
+ok( !$results->success );
+ok( $results->has_blank );
+ok( !$results->has_invalid );
+ok( $results->missing('r1') );
+
+my @missings = $results->missing;
+is( scalar(@missings), 1 );
+is( $missings[0], 'r1' );
+
+$results->record('r2')->set( 'ASCII' => 1 );
+$results->record('r2')->set( 'INT' => undef );
+
+ok( $results->has_error );
+ok( $results->has_invalid );
+ok( !$results->success );
+
+my @invalids = $results->invalid;
+is( scalar(@invalids), 1 );
+is( $invalids[0], 'r2' );
+ok( !$results->invalid('r1') );
+ok( $results->invalid('r2') );
+ok( !$results->invalid('r3') );
+ok( !$results->invalid('r2', 'ASCII') );
+ok( $results->invalid('r2', 'INT' ) );
+
+$results->record('r3')->data('data');
+my $valids3 = $results->valid;
+is( scalar(keys %$valids3), 1 );
+ok( exists $valids3->{r3});
+is( $results->valid('r3'), 'data' );
+
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/06_data.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/06_data.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/06_data.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,27 @@
+use strict;
+use Test::More tests => 9;
+
+BEGIN{ use_ok("FormValidator::Simple::Data") }
+
+use CGI;
+
+my $q = CGI->new;
+$q->param('key1' => 'val1');
+$q->param('key2' => 'val2');
+$q->param('key3' => 'val3_1', 'val3_2' );
+
+my $data = FormValidator::Simple::Data->new($q);
+isa_ok($data, "FormValidator::Simple::Data");
+
+my $val1 = $data->param(['key1']);
+is( scalar(@$val1), 1 );
+is( $val1->[0], 'val1' );
+
+my $val2 = $data->param(['key3']);
+is( $val2->[0][0], 'val3_1' );
+is( $val2->[0][1], 'val3_2' );
+
+my $val3 = $data->param(['key1','key2']);
+is( scalar(@$val3), 2 );
+is( $val3->[0], 'val1' );
+is( $val3->[1], 'val2' );
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/07_simple.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/07_simple.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/07_simple.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,66 @@
+use strict;
+use Test::More tests => 23;
+use CGI;
+
+BEGIN { use_ok("FormValidator::Simple"); }
+
+my $q = CGI->new;
+$q->param(text1 => 'HOGEHOGE' );
+$q->param(text2 => 'HOGEHOGEHOGE' );
+$q->param(int => 7 );
+$q->param(blank => "" );
+$q->param(email => 'lyo.kato at gmail.com' );
+
+my $results = FormValidator::Simple->check( $q, [
+ text1 => [qw/NOT_BLANK/],
+ text2 => [qw/NOT_BLANK/],
+ int => [qw/INT/],
+ blank => [qw/NOT_BLANK/],
+ email => [qw/EMAIL_LOOSE/],
+] );
+
+isa_ok( $results, "FormValidator::Simple::Results" );
+ok($results->missing('blank'));
+ok(!$results->valid('blank'));
+ok(!$results->invalid('blank'));
+ok($results->has_missing);
+ok(!$results->has_invalid);
+is($results->valid('text1'), 'HOGEHOGE' );
+is($results->valid('int'), 7 );
+is($results->valid('email'), 'lyo.kato at gmail.com');
+ok(!$results->invalid('text1'));
+ok(!$results->invalid('int'));
+ok(!$results->invalid('email'));
+ok(!$results->missing('text1'));
+ok(!$results->missing('int'));
+ok(!$results->missing('email'));
+
+my @missings = $results->missing;
+my @invalids = $results->invalid;
+my $valids = $results->valid;
+
+is(scalar(@missings), 1);
+is(scalar(@invalids), 0);
+is(scalar(keys %$valids), 4);
+
+my $valid = FormValidator::Simple->new;
+
+$valid->check( $q => [
+ text1 => [qw/NOT_BLANK ASCII/],
+] );
+
+$valid->check( $q => [
+ text2 => [qw/NOT_BLANK NOT_ASCII/],
+] );
+
+my $results2 = $valid->results;
+
+ok(!$results2->invalid('text1'));
+ok($results2->invalid('text2'));
+
+$valid->set_invalid( hoge => 'HOGE' );
+
+my $results3 = $valid->results;
+
+ok($results3->invalid('hoge'));
+ok($results3->invalid( hoge => 'HOGE' ));
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/08_length.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/08_length.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/08_length.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,46 @@
+use strict;
+use Test::More tests => 7;
+use CGI;
+
+BEGIN{ use_ok("FormValidator::Simple") }
+
+my $q = CGI->new;
+$q->param( text => 'text' );
+
+my $r = FormValidator::Simple->check( $q => [
+ text => [qw/NOT_BLANK/,[qw/LENGTH 4/]],
+] );
+
+ok(!$r->invalid('text'));
+
+my $r2 = FormValidator::Simple->check( $q => [
+ text => [qw/NOT_BLANK/,[qw/LENGTH 2 5/]],
+] );
+
+ok(!$r2->invalid('text'));
+
+my $r3 = FormValidator::Simple->check( $q => [
+ text => [qw/NOT_BLANK/,[qw/LENGTH 5 7/]],
+] );
+
+ok($r3->invalid('text'));
+
+my $r4 = FormValidator::Simple->check( $q => [
+ text => [qw/NOT_BLANK/, [qw/NOT_LENGTH 4/]],
+] );
+
+ok($r4->invalid('text'));
+
+my $r5 = FormValidator::Simple->check( $q => [
+ text => [qw/NOT_BLANK/,[qw/NOT_LENGTH 2 5/]],
+] );
+
+ok($r5->invalid('text'));
+
+my $r6 = FormValidator::Simple->check( $q => [
+ text => [qw/NOT_BLANK/,[qw/NOT_LENGTH 5 7/]],
+] );
+
+ok(!$r6->invalid('text'));
+
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/09_ascii.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/09_ascii.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/09_ascii.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,27 @@
+use strict;
+use Test::More tests => 5;
+use CGI;
+
+BEGIN{ use_ok("FormValidator::Simple") }
+
+my $q = CGI->new;
+$q->param( param1 => 'abcd' );
+$q->param( param2 => '日本語' );
+
+my $r = FormValidator::Simple->check( $q => [
+ param1 => [qw/ASCII/],
+ param2 => [qw/ASCII/],
+] );
+
+ok(!$r->invalid('param1'));
+ok($r->invalid('param2'));
+
+my $r2 = FormValidator::Simple->check( $q => [
+ param1 => [qw/NOT_ASCII/],
+ param2 => [qw/NOT_ASCII/],
+] );
+
+
+ok($r2->invalid('param1'));
+ok(!$r2->invalid('param2'));
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/10_int.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/10_int.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/10_int.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,25 @@
+use strict;
+use Test::More tests => 5;
+use CGI;
+
+BEGIN{ use_ok("FormValidator::Simple") }
+
+my $q = CGI->new;
+$q->param( text => 'text' );
+$q->param( int => 12345 );
+
+my $r = FormValidator::Simple->check( $q => [
+ text => [qw/NOT_BLANK INT/],
+ int => [qw/NOT_BLANK INT/],
+] );
+
+ok($r->invalid('text'));
+ok(!$r->invalid('int'));
+
+my $r2 = FormValidator::Simple->check( $q => [
+ text => [qw/NOT_BLANK NOT_INT/],
+ int => [qw/NOT_BLANK NOT_INT/],
+] );
+
+ok(!$r2->invalid('text'));
+ok($r2->invalid('int'));
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/11_space.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/11_space.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/11_space.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,25 @@
+use strict;
+use Test::More tests => 5;
+use CGI;
+
+BEGIN{ use_ok("FormValidator::Simple") }
+
+my $q = CGI->new;
+$q->param( param1 => 'text' );
+$q->param( param2 => ' ' );
+
+my $r = FormValidator::Simple->check( $q => [
+ param1 => [qw/NOT_BLANK SP/],
+ param2 => [qw/NOT_BLANK SP/],
+] );
+
+ok($r->invalid('param1'));
+ok(!$r->invalid('param2'));
+
+my $r2 = FormValidator::Simple->check( $q => [
+ param1 => [qw/NOT_BLANK NOT_SP/],
+ param2 => [qw/NOT_BLANK NOT_SP/],
+] );
+
+ok(!$r2->invalid('param1'));
+ok($r2->invalid('param2'));
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/12_duplication.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/12_duplication.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/12_duplication.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,37 @@
+use strict;
+use Test::More tests => 5;
+use CGI;
+
+BEGIN { use_ok("FormValidator::Simple") }
+
+my $q = CGI->new;
+$q->param( email1 => 'lyo.kato at gmail.com' );
+$q->param( email2 => 'lyo.kato at gmail.com' );
+
+my $r = FormValidator::Simple->check( $q => [
+ email1 => [qw/NOT_BLANK EMAIL_LOOSE/],
+ email2 => [qw/NOT_BLANK EMAIL_LOOSE/],
+ { email_dup => [qw/email1 email2/] } => [qw/DUPLICATION/],
+] );
+
+ok(!$r->invalid('email_dup'));
+
+my $r2 = FormValidator::Simple->check( $q => [
+ { email_dup => [qw/email1 email2/] } => [qw/NOT_DUPLICATION/],
+] );
+
+ok($r2->invalid('email_dup'));
+
+$q->param( email2 => 'lyokato at gmail.com' );
+
+my $r3 = FormValidator::Simple->check( $q => [
+ { email_dup => [qw/email1 email2/] } => [qw/DUPLICATION/],
+] );
+
+ok($r3->invalid('email_dup'));
+
+my $r4 = FormValidator::Simple->check( $q => [
+ { email_dup => [qw/email1 email2/] } => [qw/NOT_DUPLICATION/],
+] );
+
+ok(!$r4->invalid('email_dup'));
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/13_datetime.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/13_datetime.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/13_datetime.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,101 @@
+use strict;
+use Test::More tests => 13;
+use CGI;
+
+BEGIN{ use_ok("FormValidator::Simple") }
+
+my $q = CGI->new;
+$q->param( year => 2005 );
+$q->param( month => 11 );
+$q->param( day => 25 );
+$q->param( hour => 12 );
+$q->param( min => 40 );
+$q->param( sec => 5 );
+
+my $r = FormValidator::Simple->check( $q => [
+ { date => [qw/year month day/] } => [qw/DATE/],
+] );
+
+ok(!$r->invalid('date'));
+
+my $r2 = FormValidator::Simple->check( $q => [
+ { date => [qw/year month day/] } => [qw/NOT_DATE/],
+] );
+
+ok($r2->invalid('date'));
+
+$q->param( month => 2 );
+$q->param( day => 30 );
+
+my $r3 = FormValidator::Simple->check( $q => [
+ { date => [qw/year month day/] } => [qw/DATE/],
+] );
+
+ok($r3->invalid('date'));
+
+my $r4 = FormValidator::Simple->check( $q => [
+ { date => [qw/year month day/] } => [qw/NOT_DATE/],
+] );
+
+ok(!$r4->invalid('date'));
+
+my $r5 = FormValidator::Simple->check( $q => [
+ { time => [qw/hour min sec/] } => [qw/TIME/],
+] );
+
+ok(!$r5->invalid('time'));
+
+my $r6 = FormValidator::Simple->check( $q => [
+ { time => [qw/hour min sec/] } => [qw/NOT_TIME/],
+] );
+
+ok($r6->invalid('time'));
+
+$q->param( hour => 25 );
+
+my $r7 = FormValidator::Simple->check( $q => [
+ { time => [qw/hour min sec/] } => [qw/TIME/],
+] );
+
+ok($r7->invalid('time'));
+
+my $r8 = FormValidator::Simple->check( $q => [
+ { time => [qw/hour min sec/] } => [qw/NOT_TIME/]
+] );
+
+ok(!$r8->invalid('time'));
+
+my $q2 = CGI->new;
+$q2->param( year => 2005 );
+$q2->param( month => 12 );
+$q2->param( day => 29 );
+$q2->param( hour => 5 );
+$q2->param( min => 22 );
+$q2->param( sec => 30 );
+
+my $r9 = FormValidator::Simple->check( $q2 => [
+ { datetime => [qw/year month day hour min sec/] } => [qw/DATETIME/]
+] );
+
+ok(!$r9->invalid('datetime'));
+
+my $r10 = FormValidator::Simple->check( $q2 => [
+ { datetime => [qw/year month day hour min sec/] } => [qw/NOT_DATETIME/]
+] );
+
+ok($r10->invalid('datetime'));
+
+$q2->param( month => 2 );
+$q2->param( day => 30 );
+
+my $r11 = FormValidator::Simple->check( $q2 => [
+ { datetime => [qw/year month day hour min sec/] } => [qw/DATETIME/]
+] );
+
+ok($r11->invalid('datetime'));
+
+my $r12 = FormValidator::Simple->check( $q2 => [
+ { datetime => [qw/year month day hour min sec/] } => [qw/NOT_DATETIME/],
+] );
+
+ok(!$r12->invalid('datetime'));
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/14_regex.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/14_regex.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/14_regex.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,27 @@
+use strict;
+use Test::More tests => 4;
+use CGI;
+
+BEGIN{ use_ok("FormValidator::Simple") }
+
+my $q = CGI->new;
+
+$q->param( hoge => 'hogefoo' );
+
+my $r = FormValidator::Simple->check( $q => [
+ hoge => [ ['REGEX', qr/^hoge/] ],
+] );
+
+ok(!$r->invalid('hoge'));
+
+my $r2 = FormValidator::Simple->check( $q => [
+ hoge => [ ['NOT_REGEX', qr/^hoge/] ],
+] );
+
+ok($r2->invalid('hoge'));
+
+my $r3 = FormValidator::Simple->check( $q => [
+ hoge => [ ['REGEX', qr/^foo/] ],
+] );
+
+ok($r3->invalid('hoge'));
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/15_any.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/15_any.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/15_any.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,36 @@
+use strict;
+use Test::More tests => 5;
+use CGI;
+
+BEGIN{ use_ok("FormValidator::Simple") }
+
+my $q = CGI->new;
+$q->param( hoge => 1 );
+$q->param( foo => '' );
+$q->param( bar => '' );
+
+my $r = FormValidator::Simple->check( $q => [
+ { any => [qw/hoge foo bar/] } => [qw/ANY/],
+] );
+
+ok(!$r->invalid('any'));
+
+my $r2 = FormValidator::Simple->check( $q => [
+ { any => [qw/hoge foo bar/] } => [qw/NOT_ANY/],
+] );
+
+ok($r2->invalid('any'));
+
+$q->param( hoge => '' );
+
+my $r3 = FormValidator::Simple->check( $q => [
+ { any => [qw/hoge foo bar/] } => [qw/ANY/]
+] );
+
+ok($r3->invalid('any'));
+
+my $r4 = FormValidator::Simple->check( $q => [
+ { any => [qw/hoge foo bar/] } => [qw/NOT_ANY/]
+] );
+
+ok(!$r4->invalid('any'));
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/16_plugin.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/16_plugin.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/16_plugin.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,22 @@
+use strict;
+use Test::More tests => 3;
+use CGI;
+
+use lib 't/lib';
+
+BEGIN { require_ok("FormValidator::Simple") }
+
+FormValidator::Simple->import('Sample');
+
+my $q = CGI->new;
+$q->param( sample1 => 'hogehoge' );
+$q->param( sample2 => 'sample' );
+
+my $r = FormValidator::Simple->check( $q => [
+ sample1 => [qw/SAMPLE/],
+ sample2 => [qw/SAMPLE/],
+] );
+
+ok($r->invalid('sample1'));
+ok(!$r->invalid('sample2'));
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/17_pod.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/17_pod.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/17_pod.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,7 @@
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => 'Test::Pod 1.14 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_files_ok();
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/18_invalids.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/18_invalids.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/18_invalids.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,45 @@
+use strict;
+use Test::More tests => 16;
+use CGI;
+
+BEGIN{ use_ok("FormValidator::Simple") }
+
+my $q = CGI->new;
+
+$q->param( hoge => 'test' );
+$q->param( hoge2 => 'test' );
+$q->param( hoge3 => '' );
+
+my $r = FormValidator::Simple->check( $q => [
+ hoge => [ [qw/LENGTH 10/], [qw/INT/], [qw/NOT_ASCII/] ],
+ hoge2 => [ [qw/LENGTH 10/] ],
+ hoge3 => [ 'NOT_BLANK' ],
+] );
+
+my $invalids = $r->invalid('hoge');
+is(scalar(@$invalids), 3);
+is($invalids->[0], 'LENGTH');
+is($invalids->[1], 'INT');
+is($invalids->[2], 'NOT_ASCII');
+
+my @errors = $r->error;
+is($errors[0], 'hoge');
+is($errors[1], 'hoge2');
+is($errors[2], 'hoge3');
+
+my @inv = $r->invalid;
+is($inv[0], 'hoge');
+is($inv[1], 'hoge2');
+my @mis = $r->missing;
+is($mis[0], 'hoge3');
+
+
+my $hoge_errors = $r->error('hoge');
+is($hoge_errors->[0], 'LENGTH');
+is($hoge_errors->[1], 'INT');
+is($hoge_errors->[2], 'NOT_ASCII');
+
+my $hoge_errors2 = $r->error('hoge3');
+is($hoge_errors2->[0], 'NOT_BLANK');
+
+ok($r->error( hoge3 => 'NOT_BLANK'));
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/19_url.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/19_url.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/19_url.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,19 @@
+use strict;
+use Test::More tests => 3;
+use CGI;
+
+BEGIN{ use_ok("FormValidator::Simple") }
+
+my $q = CGI->new;
+
+$q->param( hoge => 'http://www.lost-season.jp/mt/' );
+$q->param( foo => 'lyo.kato at gmail.com' );
+
+my $r = FormValidator::Simple->check( $q => [
+ hoge => [ 'HTTP_URL' ],
+ foo => [ 'HTTP_URL' ],
+] );
+
+ok(!$r->invalid('hoge'));
+
+ok($r->invalid('foo'));
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/20_numeric_cmp.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/20_numeric_cmp.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/20_numeric_cmp.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,37 @@
+use strict;
+use Test::More tests => 9;
+use CGI;
+
+BEGIN{ use_ok("FormValidator::Simple") }
+
+my $q = CGI->new;
+
+$q->param( age1 => 25 );
+$q->param( age2 => 25 );
+$q->param( age3 => 25 );
+$q->param( age4 => 25 );
+
+my $r = FormValidator::Simple->check( $q => [
+ age1 => [ 'INT', [qw/GREATER_THAN 20/] ],
+ age2 => [ 'INT', [qw/LESS_THAN 30/] ],
+ age3 => [ 'INT', [qw/EQUAL_TO 25/] ],
+ age4 => [ 'INT', [qw/BETWEEN 20 30/] ],
+] );
+
+ok(!$r->invalid('age1'));
+ok(!$r->invalid('age2'));
+ok(!$r->invalid('age3'));
+ok(!$r->invalid('age4'));
+
+my $r2 = FormValidator::Simple->check( $q => [
+ age1 => [ 'INT', [qw/GREATER_THAN 30/] ],
+ age2 => [ 'INT', [qw/LESS_THAN 20/] ],
+ age3 => [ 'INT', [qw/EQUAL_TO 22/] ],
+ age4 => [ 'INT', [qw/BETWEEN 20 22/] ],
+] );
+
+ok($r2->invalid('age1'));
+ok($r2->invalid('age2'));
+ok($r2->invalid('age3'));
+ok($r2->invalid('age4'));
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/21_decimal.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/21_decimal.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/21_decimal.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,23 @@
+use strict;
+use Test::More tests => 5;
+BEGIN{ use_ok("FormValidator::Simple") }
+use CGI;
+
+my $q = CGI->new;
+$q->param( num1 => '123.456' );
+$q->param( num2 => '123' );
+$q->param( num3 => '1234' );
+$q->param( num4 => '123.4567' );
+
+my $r = FormValidator::Simple->check( $q => [
+ num1 => [ [qw/DECIMAL 3 3/] ],
+ num2 => [ [qw/DECIMAL 3 3/] ],
+ num3 => [ [qw/DECIMAL 3 3/] ],
+ num4 => [ [qw/DECIMAL 3 3/] ],
+] );
+
+ok(!$r->invalid('num1'));
+ok(!$r->invalid('num2'));
+ok($r->invalid('num3'));
+ok($r->invalid('num4'));
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/22_messages.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/22_messages.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/22_messages.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,38 @@
+use strict;
+use Test::More tests => 5;
+BEGIN{ use_ok("FormValidator::Simple") }
+use CGI;
+
+FormValidator::Simple->set_messages( {
+ test => {
+ data1 => {
+ NOT_BLANK => 'input data1',
+ INT => 'input integer for data1',
+ LENGTH => 'data1 has wrong length',
+ },
+ data2 => {
+ DEFAULT => 'default error for data2',
+ },
+ data3 => {
+ NOT_BLANK => 'input data3',
+ },
+ },
+} );
+
+my $q = CGI->new;
+$q->param( data1 => 'hoge' );
+$q->param( data2 => '123' );
+$q->param( data3 => '' );
+
+my $r = FormValidator::Simple->check( $q => [
+ data1 => [qw/NOT_BLANK INT/, [qw/LENGTH 0 3/] ],
+ data2 => [qw/NOT_BLANK ASCII/, [qw/LENGTH 5/]],
+ data3 => [qw/NOT_BLANK/],
+] );
+
+my $messages = $r->messages('test');
+is($messages->[0], 'input integer for data1');
+is($messages->[1], 'data1 has wrong length');
+is($messages->[2], 'default error for data2');
+is($messages->[3], 'input data3');
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/23_messages_yaml.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/23_messages_yaml.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/23_messages_yaml.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,24 @@
+use strict;
+use Test::More tests => 5;
+BEGIN{ use_ok("FormValidator::Simple") }
+use CGI;
+my $conf_file = "t/conf/messages.yml";
+FormValidator::Simple->set_messages($conf_file);
+
+my $q = CGI->new;
+$q->param( data1 => 'hoge' );
+$q->param( data2 => '123' );
+$q->param( data3 => '' );
+
+my $r = FormValidator::Simple->check( $q => [
+ data1 => [qw/NOT_BLANK INT/, [qw/LENGTH 0 3/] ],
+ data2 => [qw/NOT_BLANK ASCII/, [qw/LENGTH 5/]],
+ data3 => [qw/NOT_BLANK/],
+] );
+
+my $messages = $r->messages('test');
+is($messages->[0], 'input integer for data1');
+is($messages->[1], 'data1 has wrong length');
+is($messages->[2], 'default error for data2');
+is($messages->[3], 'input data3');
+
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/24_options.t
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/24_options.t 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/24_options.t 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,17 @@
+use strict;
+use Test::More tests => 5;
+BEGIN{ use_ok("FormValidator::Simple") }
+BEGIN{ use_ok("FormValidator::Simple::Validator") }
+FormValidator::Simple->set_option(
+ foo => 'oof',
+ bar => 'rab',
+);
+
+my $o = FormValidator::Simple::Validator->options;
+is($o->{foo}, 'oof');
+is($o->{bar}, 'rab');
+
+FormValidator::Simple->new( buz => 'zub' );
+
+my $o2 = FormValidator::Simple::Validator->options;
+is($o2->{buz}, 'zub');
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/conf/messages.yml
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/conf/messages.yml 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/conf/messages.yml 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,10 @@
+test:
+ data1:
+ DEFAULT: default message for data1
+ NOT_BLANK: not blank message for data1
+ INT: input integer for data1
+ LENGTH: data1 has wrong length
+ data2:
+ DEFAULT: default error for data2
+ data3:
+ NOT_BLANK: input data3
Added: packages/libformvalidator-simple-perl/branches/upstream/current/t/lib/FormValidator/Simple/Plugin/Sample.pm
===================================================================
--- packages/libformvalidator-simple-perl/branches/upstream/current/t/lib/FormValidator/Simple/Plugin/Sample.pm 2005-12-21 18:37:08 UTC (rev 1730)
+++ packages/libformvalidator-simple-perl/branches/upstream/current/t/lib/FormValidator/Simple/Plugin/Sample.pm 2005-12-23 22:08:15 UTC (rev 1731)
@@ -0,0 +1,11 @@
+package FormValidator::Simple::Plugin::Sample;
+use strict;
+use FormValidator::Simple::Constants;
+
+sub SAMPLE {
+ my ($class, $params, $args) = @_;
+ my $data = $params->[0];
+ return $data =~ /sample/ ? TRUE : FALSE;
+}
+
+1;
More information about the Pkg-perl-cvs-commits
mailing list