r1951 - in packages/libdata-formvalidator-perl/trunk: . debian
lib/Data lib/Data/FormValidator lib/Data/FormValidator/Constraints t
Russ Allbery
rra at costa.debian.org
Mon Jan 16 23:59:12 UTC 2006
Author: rra
Date: 2006-01-16 23:58:45 +0000 (Mon, 16 Jan 2006)
New Revision: 1951
Added:
packages/libdata-formvalidator-perl/trunk/t/any_errors.t
packages/libdata-formvalidator-perl/trunk/t/constraints_invalid_once_only.t
Modified:
packages/libdata-formvalidator-perl/trunk/Build.PL
packages/libdata-formvalidator-perl/trunk/Changes
packages/libdata-formvalidator-perl/trunk/MANIFEST
packages/libdata-formvalidator-perl/trunk/META.yml
packages/libdata-formvalidator-perl/trunk/Makefile.PL
packages/libdata-formvalidator-perl/trunk/README
packages/libdata-formvalidator-perl/trunk/debian/changelog
packages/libdata-formvalidator-perl/trunk/debian/control
packages/libdata-formvalidator-perl/trunk/debian/docs
packages/libdata-formvalidator-perl/trunk/lib/Data/FormValidator.pm
packages/libdata-formvalidator-perl/trunk/lib/Data/FormValidator/Constraints/Upload.pm
packages/libdata-formvalidator-perl/trunk/lib/Data/FormValidator/Results.pm
packages/libdata-formvalidator-perl/trunk/t/03_dependency.t
packages/libdata-formvalidator-perl/trunk/t/msgs.t
packages/libdata-formvalidator-perl/trunk/t/untaint.pl
packages/libdata-formvalidator-perl/trunk/t/upload.t
Log:
* New upstream release.
* Install RELEASE_NOTES in the doc directory.
Modified: packages/libdata-formvalidator-perl/trunk/Build.PL
===================================================================
--- packages/libdata-formvalidator-perl/trunk/Build.PL 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/Build.PL 2006-01-16 23:58:45 UTC (rev 1951)
@@ -1,5 +1,4 @@
shift(@ARGV) if $ARGV[0] eq 'Build'; # accomodate with CPAN autoinstall
-#arch-tag: Mark_Stosberg_<mark at summersault.com>--2004-03-20_18:34:25
use Module::Build;
my $class = Module::Build->subclass(
@@ -37,7 +36,7 @@
requires => {
'Image::Size' => 0,
'Test::More' => 0,
- 'Date::Calc' => 0,
+ 'Date::Calc' => 5.0,
'File::MMagic' => 1.17,
'MIME::Types' => 1.005,
'Regexp::Common' => 0,
Modified: packages/libdata-formvalidator-perl/trunk/Changes
===================================================================
--- packages/libdata-formvalidator-perl/trunk/Changes 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/Changes 2006-01-16 23:58:45 UTC (rev 1951)
@@ -1,3 +1,39 @@
+
+4.12 Thu Jan 5 21:07:50 EST 2006
+ [INTERNALS]
+ - Fix test suite to pass when CGI::Simple is not installed
+ (Lee Carmichael, Davide Dente)
+
+4.11 Tue Jan 3 18:38:23 EST 2006
+ [ENHANCEMENTS]
+ - A new constraint for minimum image dimensions was added in
+ Data::FormValidator::Constraints::Upload (Lee Carmichael)
+
+ [INTERNALS]
+ - refactoring of Upload.pm and t/upload.t (Lee Carmichael)
+
+4.10 Thu Dec 22 19:55:34 EST 2005
+
+ [ENHANCEMENTS]
+ - The msgs key can now take a callback, allow users to override how error
+ message generation is done. Some alternative message generate routines
+ will hopefully be published soon. (Cees Hek, Chris Laco and others)
+
+ - New profile key: untaint_regexp_map (Michael Peters)
+
+ [BUG FIXES]
+ - bug was fixed for dependent fields that had false values, but were valid
+ (Emanuele Zeppieri)
+
+ - Failed constraints for multiple fields with the same name no longer return duplicate
+ error messages (Will Hawes)
+
+ - value of any_errors was wrongly added to msgs even when there are no errors
+ (RT#14942, report and test script by Michael Graham)
+
+ [INTERNALS]
+ - bump Date::Calc requirement (RT#15715)
+
4.02 Wed Aug 31 21:22:58 EST 2005
[ENHANCEMENTS]
Modified: packages/libdata-formvalidator-perl/trunk/MANIFEST
===================================================================
--- packages/libdata-formvalidator-perl/trunk/MANIFEST 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/MANIFEST 2006-01-16 23:58:45 UTC (rev 1951)
@@ -36,12 +36,14 @@
t/30_filter_definedness.t
t/ValidatorPackagesTest1.pm
t/ValidatorPackagesTest2.pm
+t/any_errors.t
t/check_profile_syntax.t
t/constraint_method.t
t/constraint_regexp_map_profile_reuse.t
t/constraints_builtin.t
t/constraints_builtin_closure.t
t/constraints_factory.t
+t/constraints_invalid_once_only.t
t/constraints_reuse.t
t/dates.t
t/dates_closure.t
Modified: packages/libdata-formvalidator-perl/trunk/META.yml
===================================================================
--- packages/libdata-formvalidator-perl/trunk/META.yml 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/META.yml 2006-01-16 23:58:45 UTC (rev 1951)
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Data-FormValidator
-version: 4.02
+version: 4.12
author:
- Mark Stosberg <mark at summersault.com>
abstract: |-
@@ -8,7 +8,7 @@
on input profile.
license: perl
requires:
- Date::Calc: 0
+ Date::Calc: 5
File::MMagic: 1.17
Image::Size: 0
MIME::Types: 1.005
@@ -18,7 +18,7 @@
provides:
Data::FormValidator:
file: lib/Data/FormValidator.pm
- version: 4.02
+ version: 4.12
Data::FormValidator::Constraints:
file: lib/Data/FormValidator/Constraints.pm
version: 4.02
@@ -27,10 +27,10 @@
version: 1.01
Data::FormValidator::Constraints::RegexpCommon:
file: lib/Data/FormValidator/Results.pm
- version: 4.02
+ version: 4.1
Data::FormValidator::Constraints::Upload:
file: lib/Data/FormValidator/Constraints/Upload.pm
- version: 1.01
+ version: 1.1
Data::FormValidator::ConstraintsFactory:
file: lib/Data/FormValidator/ConstraintsFactory.pm
version: 1.4
@@ -39,5 +39,5 @@
version: 4
Data::FormValidator::Results:
file: lib/Data/FormValidator/Results.pm
- version: 4.02
+ version: 4.1
generated_by: Module::Build version 0.2611
Modified: packages/libdata-formvalidator-perl/trunk/Makefile.PL
===================================================================
--- packages/libdata-formvalidator-perl/trunk/Makefile.PL 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/Makefile.PL 2006-01-16 23:58:45 UTC (rev 1951)
@@ -5,7 +5,7 @@
'NAME' => 'Data::FormValidator',
'VERSION_FROM' => 'lib/Data/FormValidator.pm',
'PREREQ_PM' => {
- 'Date::Calc' => '0',
+ 'Date::Calc' => '5',
'File::MMagic' => '1.17',
'Image::Size' => '0',
'MIME::Types' => '1.005',
Modified: packages/libdata-formvalidator-perl/trunk/README
===================================================================
--- packages/libdata-formvalidator-perl/trunk/README 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/README 2006-01-16 23:58:45 UTC (rev 1951)
@@ -347,12 +347,12 @@
my_zipcode_field => qr/^\d{5}$/, # match exactly 5 digits
- If this field is named in the "untaint_constraint_fields", or
- "untaint_all_constraints" is effective, be aware of the following:
- If you write your own regular expressions and only match part of the
- string then you'll only get part of the string in the valid hash. It
- is a good idea to write you own constraints like /^regex$/. That way
- you match the whole string.
+ If this field is named in "untaint_constraint_fields" or
+ "untaint_regexp_map", or "untaint_all_constraints" is effective, be
+ aware of the following: If you write your own regular expressions
+ and only match part of the string then you'll only get part of the
+ string in the valid hash. It is a good idea to write you own
+ constraints like /^regex$/. That way you match the whole string.
o a subroutine reference, to supply custom code
@@ -416,7 +416,8 @@
See "WRITING YOUR OWN CONSTRAINT ROUTINES" in the
Data::FormValidator::Constraints documention for more information.
- This is overridden by "untaint_constraint_fields"
+ This is overridden by "untaint_constraint_fields" and
+ "untaint_regexp_map".
untaint_constraint_fields
untaint_constraint_fields => [qw(zipcode state)],
@@ -428,6 +429,19 @@
This overrides the untaint_all_constraints flag.
+ untaint_regexp_map
+ untaint_regexp_map => [qr/some_field_\d/],
+
+ Specifies that certain fields will be untained if they pass their
+ constraints and match one of the regular expressions supplied. This can
+ be set to a single regex, or an array reference of regexes. The
+ untainted data will be returned in the valid hash.
+
+ The above example would untaint the fields named "some_field_1", and
+ "some_field_2" but not "some_field".
+
+ This overrides the untaint_all_constraints flag.
+
missing_optional_valid
missing_optional_valid => 1
@@ -515,6 +529,23 @@
The hash that's prepared can be retrieved through the "msgs" method
described in the Data::FormValidator::Results documentation.
+ msgs - callback
+ *This is a new feature. While it expected to be forward-compatible, it
+ hasn't yet received the testing the rest of the API has.*
+
+ If the built-in message generation doesn't suit you, it is also possible
+ to provide your own by specifying a code reference:
+
+ msgs => \&my_msgs_callback
+
+ This will be called as a Data::FormValidator::Results method. It may
+ receive as arguments an additional hash reference of control parameters,
+ corresponding to the key names in the usually used in the "msgs" area of
+ the profile. You can ignore this information if you'd like.
+
+ If you have an alternative error message handler you'd like to share,
+ stick in the "Data::FormValidator::ErrMsgs" and upload it to CPAN.
+
debug
This method is used to print details about what is going on to STDERR.
@@ -549,7 +580,7 @@
You can pass more than one value into a constraint routine. For that,
the value of the constraint should be a hash reference. If you are
creating your own routines, be sure to read the section labeled "WRITING
- YOUR OWN VALIDATION ROUTINES", in the Data::FormValidator::Constraints
+ YOUR OWN CONSTRAINT ROUTINES", in the Data::FormValidator::Constraints
documentation. It describes a newer and more flexible syntax.
Using the original syntax, one key should be named "constraint" and
Modified: packages/libdata-formvalidator-perl/trunk/debian/changelog
===================================================================
--- packages/libdata-formvalidator-perl/trunk/debian/changelog 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/debian/changelog 2006-01-16 23:58:45 UTC (rev 1951)
@@ -1,3 +1,10 @@
+libdata-formvalidator-perl (4.12-1) unstable; urgency=low
+
+ * New upstream release.
+ * Install RELEASE_NOTES in the doc directory.
+
+ -- Russ Allbery <rra at debian.org> Mon, 16 Jan 2006 15:57:55 -0800
+
libdata-formvalidator-perl (4.02-1) unstable; urgency=low
* New upstream release
Modified: packages/libdata-formvalidator-perl/trunk/debian/control
===================================================================
--- packages/libdata-formvalidator-perl/trunk/debian/control 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/debian/control 2006-01-16 23:58:45 UTC (rev 1951)
@@ -2,7 +2,7 @@
Section: perl
Priority: optional
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Allard Hoeve <allard at byte.nl>, Gunnar Wolf <gwolf at debian.org>, Joachim Breitner <nomeata at debian.org>
+Uploaders: Allard Hoeve <allard at byte.nl>, Gunnar Wolf <gwolf at debian.org>, Joachim Breitner <nomeata at debian.org>, Russ Allbery <rra at debian.org>
Build-Depends-Indep: debhelper (>> 4.0.0), libmodule-build-perl, libregexp-common-perl, libimage-size-perl, libfile-mmagic-perl, libdate-calc-perl, libmime-types-perl, perl-modules
Standards-Version: 3.6.2
Modified: packages/libdata-formvalidator-perl/trunk/debian/docs
===================================================================
--- packages/libdata-formvalidator-perl/trunk/debian/docs 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/debian/docs 2006-01-16 23:58:45 UTC (rev 1951)
@@ -1 +1,2 @@
README
+RELEASE_NOTES
Modified: packages/libdata-formvalidator-perl/trunk/lib/Data/FormValidator/Constraints/Upload.pm
===================================================================
--- packages/libdata-formvalidator-perl/trunk/lib/Data/FormValidator/Constraints/Upload.pm 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/lib/Data/FormValidator/Constraints/Upload.pm 2006-01-16 23:58:45 UTC (rev 1951)
@@ -18,15 +18,17 @@
valid_file_format
valid_image_max_dimensions
valid_file_max_bytes
+ valid_image_min_dimensions
);
@EXPORT_OK = qw(
file_format
image_max_dimensions
file_max_bytes
+ image_min_dimensions
);
-$VERSION = 1.01;
+$VERSION = 1.1;
sub file_format {
my %params = @_;
@@ -56,6 +58,16 @@
}
}
+sub image_min_dimensions {
+ my $w = shift || die 'image_min_dimensions: missing minimum width value';
+ my $h = shift || die 'image_min_dimensions: missing minimum height value';
+ return sub {
+ my $self = shift;
+ $self->set_current_constraint_name('image_min_dimensions');
+ valid_image_min_dimensions($self,\$w,\$h);
+ }
+}
+
sub valid_file_format {
my $self = shift;
$self->isa('Data::FormValidator::Results') ||
@@ -69,39 +81,29 @@
my $q = $self->get_input_data;
- require UNIVERSAL;
- $q->UNIVERSAL::can('param')||
+ $q->can('param') ||
die 'file_format: data object missing param() method';
my $field = $self->get_current_constraint_field;
+ my $fh = _get_upload_fh($self);
- my $img = $q->upload($field);
- if (!$img && $q->cgi_error) {
- warn $q->cgi_error && return undef;
+ ## load filehandle
+ if (!$fh) {
+ warn "$0: can't get filehandle for field named $field" and return undef;
}
+ ## load file magic stuff
require File::MMagic;
my $mm = File::MMagic->new;
my $fm_mt;
- # If a CGI::Simple obj was passed in it won't have the
- # "tmpFileName" method available, so in that case we use
- # the file handle that Simple provides instead.
- if ( $q->isa("CGI::Simple") ) {
- my $fh = $q->upload( $q->param($field) ) ||
- (warn "$0: can't get filehandle for field named $field" and return undef);
+ ## only use filehandle bits for magic data
$fm_mt = $mm->checktype_filehandle($fh) ||
(warn "$0: can't get filehandle for field named $field" and return undef);
- } else {
- my $tmp_file = $q->tmpFileName($q->param($field)) ||
- (warn "$0: can't find tmp file for field named $field" and return undef);
- $fm_mt = $mm->checktype_filename($tmp_file);
- }
+ ## fetch mime type universally (or close)
+ my $uploaded_mt = _get_upload_mime_type($self);
- my $uploaded_mt = '';
- $uploaded_mt = $q->uploadInfo($img)->{'Content-Type'} if $q->uploadInfo($img);
-
# XXX perhaps this should be in a global variable so it's easier
# for other apps to change the defaults;
$params->{mime_types} ||= [qw!image/jpeg image/pjpeg image/gif image/png!];
@@ -111,15 +113,16 @@
my $mt = ($fm_mt || $uploaded_mt) or return undef;
# figure out an extension
-
use MIME::Types;
my $mimetypes = MIME::Types->new;
my MIME::Type $t = $mimetypes->type($mt);
my @mt_exts = $t ? $t->extensions : ();
- my ($uploaded_ext) = ($img =~ m/\.([\w\d]*)?$/);
-
+ ## setup filename to retrieve extension
+ my $fn = $q->param($field);
+ my ($uploaded_ext) = ($fn =~ m/\.([\w\d]*)?$/);
my $ext;
+
if (scalar @mt_exts) {
# If the upload extension is one recognized by MIME::Type, use it.
if (grep {/^$uploaded_ext$/} @mt_exts) {
@@ -136,7 +139,6 @@
$ext = $uploaded_ext;
}
-
# Add the mime_type and extension to the valid data set
my $info = $self->meta($field) || {};
$info = { %$info, mime_type => $mt, extension => ".$ext" };
@@ -157,30 +159,14 @@
($max_height > 0) || die 'image_max_dimensions: maximum height must be > 0';
my $q = $self->get_input_data;
- require UNIVERSAL;
- $q->UNIVERSAL::can('param')||
- die 'image_max_dimensions: data object missing param() method';
-
my $field = $self->get_current_constraint_field;
+ my ($width,$height) = _get_img_size($self);
- my $img = $q->upload($field);
- if (!$img && $q->cgi_error) {
- warn $q->cgi_error && return undef;
- }
-
- require Image::Size;
- import Image::Size;
-
- my $tmp_file = $q->tmpFileName($q->param($field)) ||
- (warn "$0: can't find tmp file for field named $field" and return undef);
-
- my ($width,$height,$err) = imgsize($tmp_file);
unless ($width) {
- warn "$0: imgsize test failed: $err";
+ warn "$0: imgsize test failed";
return undef;
}
-
# Add the dimensions to the valid hash
my $info = $self->meta($field) || {};
$info = { %$info, width => $width, height => $height };
@@ -194,9 +180,10 @@
$self->isa('Data::FormValidator::Results') ||
die "first argument is not a Data::FormValidator::Results object.";
+
my $max_bytes_ref = shift;
-
my $max_bytes;
+
if ((ref $max_bytes_ref) and defined $$max_bytes_ref) {
$max_bytes = $$max_bytes_ref;
}
@@ -205,18 +192,17 @@
}
my $q = $self->get_input_data;
- require UNIVERSAL;
- $q->UNIVERSAL::can('param') ||
+ $q->can('param') ||
die 'file_max_bytes: object missing param() method';
my $field = $self->get_current_constraint_field;
- my $img = $q->upload($field);
- if (!$img && $q->cgi_error) {
- warn $q->cgi_error && return undef;
- }
+ ## retrieve upload fh for field
+ my $fh = _get_upload_fh($self);
+ if (!$fh) { warn "Failed to load filehandle for $field" && return undef; }
- my $file_size = (stat ($img))[7];
+ ## retrieve size
+ my $file_size = (stat ($fh))[7];
# Add the size to the valid hash
my $info = $self->meta($field) || {};
@@ -226,8 +212,161 @@
return ($file_size <= $max_bytes);
}
+sub valid_image_min_dimensions {
+ my $self = shift;
+ $self->isa('Data::FormValidator::Results') ||
+ die "image_min_dimensions: first argument is not a Data::FormValidator::Results object. ";
+ my $min_width_ref = shift ||
+ die 'image_min_dimensions: missing minimum width value';
+ my $min_height_ref = shift ||
+ die 'image_min_dimensions: missing minimum height value';
+ my $min_width = $$min_width_ref;
+ my $min_height = $$min_height_ref;
+ ## do these matter?
+ ($min_width > 0) || die 'image_min_dimensions: minimum width must be > 0';
+ ($min_height > 0) || die 'image_min_dimensions: minimum height must be > 0';
+ my $q = $self->get_input_data;
+ my $field = $self->get_current_constraint_field;
+ my ($width, $height) = _get_img_size($self);
+
+ unless ($width) {
+ warn "image failed processing";
+ return undef;
+ }
+
+ # Add the dimensions to the valid hash
+ my $info = $self->meta($field) || {};
+ $info = { %$info, width => $width, height => $height };
+ $self->meta($field,$info);
+
+ return (($width >= $min_width) and ($height >= $min_height));
+}
+
+sub _get_img_size
+{
+ my $self = shift;
+ my $q = $self->get_input_data;
+
+ ## setup caller to make can errors more useful
+ my $caller = (caller(1))[3];
+ my $pkg = __PACKAGE__ . "::";
+ $caller =~ s/$pkg//g;
+
+ $q->can('param') || die "$caller: data object missing param() method";
+ $q->can('upload') || die "$caller: data object missing upload() method";
+
+ my $field = $self->get_current_constraint_field;
+
+ ## retrieve filehandle from query object.
+ my $fh = _get_upload_fh($self);
+
+ ## check error
+ if (!$fh) { warn "Unable to load filehandle" && return undef; }
+
+ require Image::Size;
+ import Image::Size;
+
+ ## check size
+ my ($width, $height, $err) = imgsize($fh);
+
+ unless ($width) {
+ warn "$caller: imgsize test failed: $err";
+ return undef;
+ }
+
+ return ($width, $height);
+}
+
+## fetch filehandle for use with various file type checking
+## call it with (_get_upload_fh($self)) since kind of mock object
+sub _get_upload_fh
+{
+ my $self = shift;
+ my $q = $self->get_input_data;
+ my $field = $self->get_current_constraint_field;
+
+ ## CGI::Simple object processing (slighly different from others)
+ if ($q->isa('CGI::Simple')) {
+ ## get filename
+ my $fn = $q->param($field);
+ if (!$fn) {
+ warn sprintf("Failed to locate filename '%s'", $q->cgi_error);
+ return undef;
+ }
+
+ ## return filename
+ return $q->upload($fn);
+ }
+
+ ## NOTE: Both Apache::Upload and CGI filehandles are not seekable
+ ## this causes issues with File::MMagic...
+
+ ## Apache::Request object processing
+ if ($q->isa('Apache::Request')) {
+ use IO::File;
+ my $upload = $q->upload($field); ## return Apache::Upload
+
+ ## error checking
+ warn "Failed to locate upload object" && return undef unless $upload;
+
+ ## return filehandle
+ return IO::File->new_from_fd(fileno($upload->fh), "r");
+ }
+
+
+ ## only CGI.pm just incase for wierd subclasses
+ ## generic data object (or CGI), CGi.pm has incomplete fh's nice huh
+ if ($q->isa('CGI')) {
+ use IO::File;
+ my $fh = $q->upload($field);
+
+ warn "Failed to load fh for $field" && return undef unless $fh;
+
+ #my $tmpfile = $q->tmpFileName($q->param($field)) || return undef;
+ #return FileHandle->new($tmpfile);
+
+ ## convert into seekable handle
+ return IO::File->new_from_fd(fileno($fh), "r");
+ }
+
+ ## not going to figure it out
+ return undef;
+}
+
+## returns mime type if included as part of the send
+sub _get_upload_mime_type
+{
+ my $self = shift;
+ my $q = $self->get_input_data;
+ my $field = $self->get_current_constraint_field;
+
+ if ($q->isa('CGI')) {
+ my $fn = $q->param($field);
+
+ ## nicely check for info
+ if ($q->uploadInfo($fn)) {
+ return $q->uploadInfo($fn)->{'Content-Type'}
+ }
+
+ return undef;
+ }
+
+ if ($q->isa('CGI::Simple')) {
+ my $fn = $q->param($field);
+ return $q->upload_info($fn, 'mime');
+ }
+
+ if ($q->isa('Apache::Request')) {
+ my $upload = $q->upload($field);
+ return $upload->info('Content-type');
+ }
+
+ return undef;
+}
+
+
1;
__END__
@@ -245,6 +384,7 @@
file_format
file_max_bytes
image_max_dimensions
+ image_min_dimensions
);
my $dfv = Data::FormValidator->check($q,$my_profile);
@@ -254,6 +394,7 @@
file_format(),
file_max_bytes(10),
image_max_dimensions(200,200),
+ image_min_dimensions(100,100),
],
}
@@ -320,6 +461,20 @@
the C<meta()> method of the Data::FormValidator::Results object.
The meta data added is C<width> and C<height>.
+=item image_min_dimensions
+
+This function checks to make sure an uploaded image is longer than
+some minimum dimensions. The params are:
+
+ reference to min pixel width
+ reference to min pixel height
+
+ image_min_dimensions(100,100),
+
+Calling this function sets some meta data which can be retrieved through
+the C<meta()> method of the Data::FormValidator::Results object.
+The meta data added is C<width> and C<height>.
+
=back
=head2 BACKWARDS COMPATIBILITY
Modified: packages/libdata-formvalidator-perl/trunk/lib/Data/FormValidator/Results.pm
===================================================================
--- packages/libdata-formvalidator-perl/trunk/lib/Data/FormValidator/Results.pm 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/lib/Data/FormValidator/Results.pm 2006-01-16 23:58:45 UTC (rev 1951)
@@ -23,7 +23,7 @@
use overload
'bool' => \&_bool_overload_based_on_success;
-$VERSION = 4.02;
+$VERSION = 4.10;
=pod
@@ -45,7 +45,7 @@
# Print the name of invalid fields
if ( $results->has_invalid ) {
foreach my $f ( $results->invalid ) {
- print $f, " is invalid: ", $results->invalid( $f ) \n";
+ print $f, " is invalid: ", $results->invalid( $f ), "\n";
}
}
@@ -58,7 +58,7 @@
# Print valid fields
foreach my $f ( $results->valid() ) {
- print $f, " = ", $result->valid( $f ), "\n";
+ print $f, " = ", $results->valid( $f ), "\n";
}
=head1 DESCRIPTION
@@ -213,7 +213,7 @@
# Check if the presence of some fields makes other optional fields required.
while ( my ( $field, $deps) = each %{$profile->{dependencies}} ) {
- if ($valid{$field}) {
+ if (defined $valid{$field}) {
if (ref($deps) eq 'HASH') {
foreach my $key (keys %$deps) {
# Handle case of a key with a single value given as an arrayref
@@ -289,23 +289,6 @@
push @missings, $field unless ($enough_required_fields >= $num_fields_to_require);
}
- #Decide which fields to untaint
- my ($untaint_all, %untaint_hash);
- if (defined($profile->{untaint_constraint_fields})) {
- if (ref $profile->{untaint_constraint_fields} eq "ARRAY") {
- foreach my $field (@{$profile->{untaint_constraint_fields}}) {
- $untaint_hash{$field} = 1;
- }
- }
- elsif ($valid{$profile->{untaint_constraint_fields}}) {
- $untaint_hash{$profile->{untaint_constraint_fields}} = 1;
- }
- }
- elsif ((defined($profile->{untaint_all_constraints}))
- && ($profile->{untaint_all_constraints} == 1)) {
- $untaint_all = 1;
- }
-
# add in the constraints from the regexp maps
# We don't want to modify the profile, so we use a new variable.
$profile->{constraints} ||= {};
@@ -319,6 +302,45 @@
_add_constraints_from_map($profile,'constraint_method',\%valid),
};
+ #Decide which fields to untaint
+ my ($untaint_all, %untaint_hash);
+ if (defined $profile->{untaint_regexp_map} or defined $profile->{untaint_constraint_fields} ) {
+ # first deal with untaint_constraint_fields
+ if (defined($profile->{untaint_constraint_fields})) {
+ if (ref $profile->{untaint_constraint_fields} eq "ARRAY") {
+ foreach my $field (@{$profile->{untaint_constraint_fields}}) {
+ $untaint_hash{$field} = 1;
+ }
+ }
+ elsif ($valid{$profile->{untaint_constraint_fields}}) {
+ $untaint_hash{$profile->{untaint_constraint_fields}} = 1;
+ }
+ }
+
+ # now look at untaint_regexp_map
+ if(defined($profile->{untaint_regexp_map})) {
+ my @untaint_regexes;
+ if(ref $profile->{untaint_regexp_map} eq "ARRAY") {
+ @untaint_regexes = @{$profile->{untaint_regexp_map}};
+ }
+ else {
+ push(@untaint_regexes, $profile->{untaint_regexp_map});
+ }
+
+ foreach my $regex (@untaint_regexes) {
+ # look at both constraints and constraint_methods
+ foreach my $field (keys %$private_constraints, keys %$private_constraint_methods) {
+ next if($untaint_hash{$field});
+ $untaint_hash{$field} = 1 if( $field =~ $regex );
+ }
+ }
+ }
+ }
+ elsif ((defined($profile->{untaint_all_constraints}))
+ && ($profile->{untaint_all_constraints} == 1)) {
+ $untaint_all = 1;
+ }
+
$self->_check_constraints($private_constraints,\%valid,$untaint_all,\%untaint_hash);
my $force_method_p = 1;
@@ -519,12 +541,18 @@
is determined by parameters in the C<msgs> area of the validation profile,
described in the L<Data::FormValidator> documentation.
-This method takes one possible parameter, a hash reference containing the same
-options that you can define in the validation profile. This allows you to separate
-the controls for message display from the rest of the profile. While validation profiles
-may be different for every form, you may wish to format messages the same way
-across many projects.
+B<NOTE:> the C<msgs> parameter in the profile can take a code reference as a
+value, allowing complete control of how messages are generated. If such a code
+reference was provided there, it will be called here instead of the usual
+processing, described below. It will receive as arguments the L<Data::FormValidator::Results>
+object and a hash reference of control parameters.
+The hashref passed in should contain the same options that you can define in
+the validation profile. This allows you to separate the controls for message
+display from the rest of the profile. While validation profiles may be
+different for every form, you may wish to format messages the same way across
+many projects.
+
Controls passed into the <msgs> method will be applied first, followed by ones
applied in the profile. This allows you to keep the controls you pass to
C<msgs> as "global" and override them in a specific profile if needed.
@@ -532,6 +560,17 @@
=cut
sub msgs {
+ my $self = shift;
+ my $msgs = $self->{profile}{msgs} || {};
+ if ((ref $msgs eq 'CODE')) {
+ return $msgs->($self, at _);
+ } else {
+ return $self->_generate_msgs(@_);
+ }
+}
+
+
+sub _generate_msgs {
my $self = shift;
my $controls = shift || {};
if (defined $controls and ref $controls ne 'HASH') {
@@ -590,7 +629,9 @@
my $msgs_ref = prefix_hash($profile{prefix},\%msgs);
- $msgs_ref->{ $profile{any_errors} } = 1 if defined $profile{any_errors};
+ if (! $self->success) {
+ $msgs_ref->{ $profile{any_errors} } = 1 if defined $profile{any_errors};
+ }
return $msgs_ref;
@@ -753,7 +794,7 @@
}
-sub _error_msg_fmt ($$) {
+sub _error_msg_fmt {
my ($fmt,$msg) = @_;
$fmt ||=
'<span style="color:red;font-weight:bold"><span class="dfv_errors">* %s</span></span>';
@@ -1089,9 +1130,11 @@
next unless exists $valid->{$field};
my $is_constraint_list = 1 if (ref $constraint_list eq 'ARRAY');
- my $untaint_this = ($untaint_all || $untaint_href->{$field} || 0);
+ my $untaint_this = ($untaint_all || $untaint_href->{$field} || 0);
my @invalid_list;
+ # used to insure we only bother recording each failed constraint once
+ my %constraints_seen;
foreach my $constraint_spec (_arrayify($constraint_list)) {
# set current constraint field for use by get_current_constraint_field
@@ -1108,18 +1151,22 @@
my %param_data = ( $self->_get_input_as_hash($self->get_input_data) , %$valid );
if ($is_value_list) {
foreach (my $i = 0; $i < scalar @{ $valid->{$field}} ; $i++) {
- my @params = $self->_constraint_input_build($c,$valid->{$field}->[$i],\%param_data);
+ if( !exists $constraints_seen{\$c} ) {
- # set current constraint field for use by get_current_constraint_value
- $self->{__CURRENT_CONSTRAINT_VALUE} = $valid->{$field}->[$i];
+ my @params = $self->_constraint_input_build($c,$valid->{$field}->[$i],\%param_data);
- my ($match,$failed) = $self->_constraint_check_match($c,\@params,$untaint_this);
- if ($failed->{failed}) {
- push @invalid_list, $failed;
- }
- else {
- $valid->{$field}->[$i] = $match if $untaint_this;
- }
+ # set current constraint field for use by get_current_constraint_value
+ $self->{__CURRENT_CONSTRAINT_VALUE} = $valid->{$field}->[$i];
+
+ my ($match,$failed) = $self->_constraint_check_match($c,\@params,$untaint_this);
+ if ($failed->{failed}) {
+ push @invalid_list, $failed;
+ $constraints_seen{\$c} = 1;
+ }
+ else {
+ $valid->{$field}->[$i] = $match if $untaint_this;
+ }
+ }
}
}
else {
Modified: packages/libdata-formvalidator-perl/trunk/lib/Data/FormValidator.pm
===================================================================
--- packages/libdata-formvalidator-perl/trunk/lib/Data/FormValidator.pm 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/lib/Data/FormValidator.pm 2006-01-16 23:58:45 UTC (rev 1951)
@@ -9,7 +9,7 @@
# Copyright (C) 1999 Francis J. Lacoste, iNsu Innovations
# Parts Copyright 1996-1999 by Michael J. Heins
# Parts Copyright 1996-1999 by Bruce Albrecht
-# Parts Copyright 2001-2003 by Mark Stosberg
+# Parts Copyright 2001-2005 by Mark Stosberg
#
# Parts of this module are based on work by
# Bruce Albrecht, contributed to
@@ -31,7 +31,7 @@
use vars qw( $VERSION $AUTOLOAD @ISA @EXPORT_OK %EXPORT_TAGS );
-$VERSION = '4.02';
+$VERSION = '4.12';
require Exporter;
@ISA = qw(Exporter);
@@ -563,8 +563,8 @@
my_zipcode_field => qr/^\d{5}$/, # match exactly 5 digits
-If this field is named in the C<untaint_constraint_fields>, or
-C<untaint_all_constraints> is effective, be aware of the following: If you
+If this field is named in C<untaint_constraint_fields> or C<untaint_regexp_map>,
+or C<untaint_all_constraints> is effective, be aware of the following: If you
write your own regular expressions and only match part of the string then
you'll only get part of the string in the valid hash. It is a good idea to
write you own constraints like /^regex$/. That way you match the whole string.
@@ -576,8 +576,8 @@
This will check the input and return true or false depending on the input's validity.
By default, the constraint function recieves a L<Data::FormValidator::Results>
object as its first argument, and the value to be validated as the second. To
-validate a field based more inputs than just the field itself, see C<VALIDATING
-INPUT BASED ON MULTIPLE FIELDS>.
+validate a field based more inputs than just the field itself, see
+L<VALIDATING INPUT BASED ON MULTIPLE FIELDS>.
B<Examples>:
@@ -637,7 +637,7 @@
See L<WRITING YOUR OWN CONSTRAINT ROUTINES> in the Data::FormValidator::Constraints
documention for more information.
-This is overridden by C<untaint_constraint_fields>
+This is overridden by C<untaint_constraint_fields> and C<untaint_regexp_map>.
=head2 untaint_constraint_fields
@@ -649,6 +649,20 @@
This overrides the untaint_all_constraints flag.
+=head2 untaint_regexp_map
+
+ untaint_regexp_map => [qr/some_field_\d/],
+
+Specifies that certain fields will be untained if they pass their constraints
+and match one of the regular expressions supplied. This can be set to a single
+regex, or an array reference of regexes. The untainted data will be returned
+in the valid hash.
+
+The above example would untaint the fields named C<some_field_1>, and C<some_field_2>
+but not C<some_field>.
+
+This overrides the untaint_all_constraints flag.
+
=head2 missing_optional_valid
missing_optional_valid => 1
@@ -735,6 +749,24 @@
The hash that's prepared can be retrieved through the C<msgs> method
described in the L<Data::FormValidator::Results> documentation.
+=head2 msgs - callback
+
+I<This is a new feature. While it expected to be forward-compatible, it hasn't
+yet received the testing the rest of the API has.>
+
+If the built-in message generation doesn't suit you, it is also possible to
+provide your own by specifying a code reference:
+
+ msgs => \&my_msgs_callback
+
+This will be called as a L<Data::FormValidator::Results> method. It may
+receive as arguments an additional hash reference of control parameters,
+corresponding to the key names in the usually used in the C<msgs> area of the
+profile. You can ignore this information if you'd like.
+
+If you have an alternative error message handler you'd like to share,
+stick in the C<Data::FormValidator::ErrMsgs> and upload it to CPAN.
+
=head2 debug
This method is used to print details about what is going on to STDERR.
@@ -771,8 +803,9 @@
You can pass more than one value into a constraint routine. For that, the
value of the constraint should be a hash reference. If you are creating your
-own routines, be sure to read the section labeled L<WRITING YOUR OWN VALIDATION
-ROUTINES>, in the Data::FormValidator::Constraints documentation. It describes
+own routines, be sure to read the section labeled
+L<WRITING YOUR OWN CONSTRAINT ROUTINES>,
+in the Data::FormValidator::Constraints documentation. It describes
a newer and more flexible syntax.
Using the original syntax, one key should be named C<constraint> and should
@@ -870,6 +903,7 @@
untaint_all_constraints=> undef,
validator_packages=> undef,
untaint_constraint_fields=> undef,
+ untaint_regexp_map => undef,
debug=> undef,
);
Modified: packages/libdata-formvalidator-perl/trunk/t/03_dependency.t
===================================================================
--- packages/libdata-formvalidator-perl/trunk/t/03_dependency.t 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/t/03_dependency.t 2006-01-16 23:58:45 UTC (rev 1951)
@@ -10,11 +10,12 @@
dependencies => {
pay_type => {
Check => [qw( cc_num )],
- Visa => [qw( cc_num cc_exp cc_name )],
+ # Value of Zero is used for test for a specific bug
+ 0 => [qw( cc_num cc_exp cc_name )],
},
},
};
-my $input_hashref = {pay_type=>'Visa'};
+my $input_hashref = {pay_type=>'0'};
##
@@ -92,7 +93,7 @@
## Now, some tests using a CGI.pm object as input
use CGI;
-my $q = CGI->new('pay_type=Visa');
+my $q = CGI->new('pay_type=0');
my $results;
eval {
$results = $validator->check($q, 'default');
Copied: packages/libdata-formvalidator-perl/trunk/t/any_errors.t (from rev 1950, packages/libdata-formvalidator-perl/branches/upstream/current/t/any_errors.t)
Copied: packages/libdata-formvalidator-perl/trunk/t/constraints_invalid_once_only.t (from rev 1950, packages/libdata-formvalidator-perl/branches/upstream/current/t/constraints_invalid_once_only.t)
Modified: packages/libdata-formvalidator-perl/trunk/t/msgs.t
===================================================================
--- packages/libdata-formvalidator-perl/trunk/t/msgs.t 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/t/msgs.t 2006-01-16 23:58:45 UTC (rev 1951)
@@ -1,4 +1,4 @@
-use Test::More tests => 15;
+use Test::More qw/no_plan/;
use strict;
use Data::FormValidator;
@@ -199,7 +199,28 @@
like($msgs->{field},qr/##/,$test_name);
}
+###
+{
+ my $test_name = 'A callback can be used for msgs';
+ my $results = Data::FormValidator->check(
+ {
+ field => 'value',
+ },
+ {
+ required => [qw/field/],
+ constraints => {
+ field => ['email','province'],
+ },
+ msgs => sub { { field => 'callback!' } },
+ }
+ );
+ my $msgs = $results->msgs;
+ like($msgs->{field},qr/callback/,$test_name);
+}
+
+
+
Modified: packages/libdata-formvalidator-perl/trunk/t/untaint.pl
===================================================================
--- packages/libdata-formvalidator-perl/trunk/t/untaint.pl 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/t/untaint.pl 2006-01-16 23:58:45 UTC (rev 1951)
@@ -2,7 +2,7 @@
use strict;
-use Test::More qw/no_plan/;
+use Test::More (tests => 45);
use Data::FormValidator;
use Data::FormValidator::Constraints qw/:closures/;
@@ -40,7 +40,26 @@
zip_field2 => [$ARGV[7],$ARGV[8]], #12345 , oops
};
+my $data5 = {
+ zip_field1 => [$ARGV[7],$ARGV[7]], #12345 , 12345
+ zip_field2 => [$ARGV[7],$ARGV[7]], #12345 , oops
+};
+my $data6 = {
+ zip_field1 => [$ARGV[7],$ARGV[7]], #12345 , 12345
+ zip_field2 => [$ARGV[7],$ARGV[7]], #12345 , oops
+ email1 => $ARGV[2], #jim at foo.bar
+ email2 => $ARGV[3], #james at bar.foo
+};
+
+my $data7 = {
+ zip_field1 => [$ARGV[7],$ARGV[7]], #12345 , 12345
+ zip_field2 => [$ARGV[7],$ARGV[7]], #12345 , oops
+ email1 => $ARGV[2], #jim at foo.bar
+ email2 => $ARGV[3], #james at bar.foo
+};
+
+
my $profile =
{
rules1 => {
@@ -85,6 +104,34 @@
zip_field1=>'zip',
},
},
+ rules5 => {
+ untaint_regexp_map => qr/^zip_field\d/,
+ required_regexp => qr/^zip_field\d/,
+ constraint_method_regexp_map => {
+ qr/^zip_field\d/ => 'zip',
+ },
+ },
+ rules6 => {
+ untaint_regexp_map => [qr/^zip_field\d/, qr/^email\d/],
+ required_regexp => qr/^(zip_field|email)\d/,
+ constraint_method_regexp_map => {
+ qr/^zip_field\d/ => 'zip',
+ qr/^email\d/ => 'email',
+ },
+ },
+ rules7 => {
+ required_regexp => qr/^zip_field\d/,
+ required => [qw(email1 email2)],
+ untaint_regexp_map => [qr/^zip_field\d/, qr/^email\d/],
+ untaint_constraint_fields => [qw(email1 email2)],
+ constraint_method_regexp_map => {
+ qr/^zip_field\d/ => 'zip',
+ },
+ constraints => {
+ email1 => 'email',
+ email2 => 'email',
+ },
+ },
};
my $validator = new Data::FormValidator($profile);
@@ -175,3 +222,25 @@
is($results->valid('qr_re_no_parens'),0,'qr RE without parens in untainted');
is($results->valid('qr_re_parens') ,0,'qr RE with parens in untainted');
+
+# Rules #5
+eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data5, "rules5"); };
+ok(!$@, 'avoided eval error');
+ok(!is_tainted($valid->{zip_field1}->[0]), 'zip_field1 should be untainted');
+ok(!is_tainted($valid->{zip_field2}->[0]), 'zip_field2 should be untainted');
+
+# Rules #6
+eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data6, "rules6"); };
+ok(!$@, 'avoided eval error');
+ok(!is_tainted($valid->{zip_field1}->[0]), 'zip_field1 should be untainted');
+ok(!is_tainted($valid->{zip_field2}->[0]), 'zip_field2 should be untainted');
+ok(!is_tainted($valid->{email1}->[0]), 'email1 should be untainted');
+ok(!is_tainted($valid->{email2}->[0]), 'email2 should be untainted');
+
+# Rules #7
+eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data7, "rules7"); };
+ok(!$@, 'avoided eval error');
+ok(!is_tainted($valid->{zip_field1}->[0]), 'zip_field1 should be untainted');
+ok(!is_tainted($valid->{zip_field2}->[0]), 'zip_field2 should be untainted');
+ok(!is_tainted($valid->{email1}), 'email1 should be untainted');
+ok(!is_tainted($valid->{email2}), 'email2 should be untainted');
Modified: packages/libdata-formvalidator-perl/trunk/t/upload.t
===================================================================
--- packages/libdata-formvalidator-perl/trunk/t/upload.t 2006-01-16 23:48:03 UTC (rev 1950)
+++ packages/libdata-formvalidator-perl/trunk/t/upload.t 2006-01-16 23:58:45 UTC (rev 1951)
@@ -1,12 +1,33 @@
#########################
-use Test::More tests => 18;
+use Test::More;
use strict;
+
BEGIN {
use_ok('CGI');
use_ok('Data::FormValidator::Constraints::Upload')
};
+my $all_suite_tests = 0; ## use_ok tests seem to not be counted
+my $single_suite_tests = 25;
+my $suite_count = 1;
+my $cgi_simple_test = 0;
+
+eval {
+ require CGI::Simple;
+};
+
+if ($@) {
+ diag "Skipping CGI::Simple Tests";
+}
+else {
+ diag "Adding CGI::Simple tests";
+ $suite_count++;
+ $cgi_simple_test = 1;
+}
+
+plan tests => ($single_suite_tests * $suite_count) + $all_suite_tests;
+
#########################
%ENV = (
@@ -37,13 +58,33 @@
);
diag "testing with CGI.pm version: $CGI::VERSION";
+diag "testing with CGI::Simple version: $CGI::Simple::VERSION" if $cgi_simple_test;
+## testing vars
+my $cgi_pm_q;
+my $cgi_simple_q;
+
+## setup input (need cleaner way)
open(IN,'<t/upload_post_text.txt') || die 'missing test file';
binmode(IN);
*STDIN = *IN;
-my $q = new CGI;
+$cgi_pm_q = new CGI;
+close(IN);
+## setup CGI::Simple testing
+if ($cgi_simple_test) {
+ open(IN,'<t/upload_post_text.txt') || die 'missing test file';
+ binmode(IN);
+ *STDIN = *IN;
+ ## annoying context
+ $CGI::Simple::DISABLE_UPLOADS = 0;
+ # Repeat to avoid warning..
+ $CGI::Simple::DISABLE_UPLOADS = 0;
+ $cgi_simple_q = CGI::Simple->new();
+ close(IN);
+}
+
use Data::FormValidator;
my $default = {
required=>[qw/hello_world does_not_exist_gif 100x100_gif 300x300_gif/],
@@ -74,43 +115,47 @@
},
};
-my $dfv = Data::FormValidator->new({ default => $default});
-my ($results);
-eval {
+## same set of tests with each one (does this work?)
+foreach my $q ($cgi_pm_q, $cgi_simple_q) {
+ next unless $q;
+ diag "Running tests with ", ref $q;
+
+ my $dfv = Data::FormValidator->new({ default => $default });
+ my ($results);
+ eval {
$results = $dfv->check($q, 'default');
-};
-ok(not $@) or diag $@;
+ };
+ ok(not $@) or diag $@;
-my $valid = $results->valid;
-my $invalid = $results->invalid; # as hash ref
-my @invalids = $results->invalid;
-my $missing = $results->missing;
+ my $valid = $results->valid;
+ my $invalid = $results->invalid; # as hash ref
+ my @invalids = $results->invalid;
+ my $missing = $results->missing;
-# Test to make sure hello world fails because it is the wrong type
-ok((grep {m/hello_world/} @invalids), 'expect format failure');
+ # Test to make sure hello world fails because it is the wrong type
+ ok((grep {m/hello_world/} @invalids), 'expect format failure');
-# should fail on empty/missing source file data
-ok((grep {m/does_not_exist_gif/} @invalids), 'expect non-existent failure');
+ # should fail on empty/missing source file data
+ ok((grep {m/does_not_exist_gif/} @invalids), 'expect non-existent failure');
+ # Make sure 100x100 passes because it is the right type and size
+ ok(exists $valid->{'100x100_gif'}, "valid");
-# Make sure 100x100 passes because it is the right type and size
-ok(exists $valid->{'100x100_gif'});
+ my $meta = $results->meta('100x100_gif');
+ is(ref $meta, 'HASH', 'meta() returns hash ref');
-my $meta = $results->meta('100x100_gif');
-is(ref $meta, 'HASH', 'meta() returns hash ref');
+ ok($meta->{extension}, 'setting extension meta data');
+ ok($meta->{mime_type}, 'setting mime_type meta data');
-ok($meta->{extension}, 'setting extension meta data');
-ok($meta->{mime_type}, 'setting mime_type meta data');
+ # 300x300 should fail because it is too big
+ ok((grep {m/300x300/} @invalids), 'max_bytes');
-# 300x300 should fail because it is too big
-ok((grep {m/300x300/} @invalids), 'max_bytes');
+ ok($results->meta('100x100_gif')->{bytes}>0, 'setting bytes meta data');
-ok($results->meta('100x100_gif')->{bytes}>0, 'setting bytes meta data');
-
-# Revalidate to usefully re-use the same fields
-my $profile_2 = {
+ # Revalidate to usefully re-use the same fields
+ my $profile_2 = {
required=>[qw/hello_world 100x100_gif 300x300_gif/],
validator_packages=> 'Data::FormValidator::Constraints::Upload',
constraints => {
@@ -123,27 +168,27 @@
params => [\200,\200],
},
},
-};
+ };
-$dfv = Data::FormValidator->new({ profile_2 => $profile_2});
-eval {
+ $dfv = Data::FormValidator->new({ profile_2 => $profile_2});
+ eval {
$results = $dfv->check($q, 'profile_2');
-};
-ok(not $@) or diag $@;
+ };
+ ok(not $@) or diag $@;
-$valid = $results->valid;
-$invalid = $results->invalid; # as hash ref
- at invalids = $results->invalid;
-$missing = $results->missing;
+ $valid = $results->valid;
+ $invalid = $results->invalid; # as hash ref
+ @invalids = $results->invalid;
+ $missing = $results->missing;
-ok(exists $valid->{'100x100_gif'}, 'expecting success with max_dimensions');
-ok((grep /300x300/, @invalids), 'expecting failure with max_dimensions');
+ ok(exists $valid->{'100x100_gif'}, 'expecting success with max_dimensions');
+ ok((grep /300x300/, @invalids), 'expecting failure with max_dimensions');
-ok( $results->meta('100x100_gif')->{width} > 0, 'setting width as meta data');
-ok( $results->meta('100x100_gif')->{width} > 0, 'setting height as meta data');
+ ok( $results->meta('100x100_gif')->{width} > 0, 'setting width as meta data');
+ ok( $results->meta('100x100_gif')->{width} > 0, 'setting height as meta data');
-# Now test trying constraint_regxep_map
-my $profile_3 = {
+ # Now test trying constraint_regxep_map
+ my $profile_3 = {
required=>[qw/hello_world 100x100_gif 300x300_gif/],
validator_packages=> 'Data::FormValidator::Constraints::Upload',
constraint_regexp_map => {
@@ -152,12 +197,107 @@
params => [\200,\200],
}
}
-};
+ };
-$dfv = Data::FormValidator->new({ profile_3 => $profile_3});
-($valid,$missing,$invalid) = $dfv->validate($q, 'profile_3');
+ $dfv = Data::FormValidator->new({ profile_3 => $profile_3});
+ ($valid,$missing,$invalid) = $dfv->validate($q, 'profile_3');
+
+ ok(exists $valid->{'100x100_gif'}, 'expecting success with max_dimensions using constraint_regexp_map');
+ ok((grep {m/300x300/} @$invalid), 'expecting failure with max_dimensions using constraint_regexp_map');
-ok(exists $valid->{'100x100_gif'}, 'expecting success with max_dimensions using constraint_regexp_map');
-ok((grep {m/300x300/} @$invalid), 'expecting failure with max_dimensions using constraint_regexp_map');
+ ## min test
+ my $profile_4 = {
+ required=>[qw/hello_world 100x100_gif 300x300_gif/],
+ validator_packages=> 'Data::FormValidator::Constraints::Upload',
+ constraints => {
+ '100x100_gif' => {
+ constraint_method => 'image_min_dimensions',
+ params => [\200,\200],
+ },
+ '300x300_gif' => {
+ constraint_method => 'image_min_dimensions',
+ params => [\200,\200],
+ },
+ },
+ };
+ $dfv = Data::FormValidator->new({ profile_4 => $profile_4});
+ eval {
+ $results = $dfv->check($q, 'profile_4');
+ };
+ ok(not $@) or diag $@;
+
+ $valid = $results->valid;
+ $invalid = $results->invalid; # as hash ref
+ @invalids = $results->invalid;
+ $missing = $results->missing;
+
+ ok(exists $valid->{'300x300_gif'}, 'expecting success with min_dimensions');
+ ok((grep /100x100/, @invalids), 'expecting failure with min_dimensions');
+ ## file type tests
+ ## with new interface
+ {
+ use Data::FormValidator::Constraints::Upload qw(file_format);
+
+ my $profile_5 = {
+ required=> [qw/hello_world 100x100_gif 300x300_gif/],
+ constraint_methods => {
+ '100x100_gif' => [ file_format( mime_types => [ qw(image/gif) ] ) ],
+ '300x300_gif' => [ file_format( mime_types => [ qw(image/png) ] ) ]
+ }
+ };
+
+ $dfv = Data::FormValidator->new({ profile_5 => $profile_5});
+ eval {
+ $results = $dfv->check($q, 'profile_5');
+ };
+
+ ok(not $@) or diag $@;
+
+ $valid = $results->valid;
+ $invalid = $results->invalid; # as hash ref
+ @invalids = $results->invalid;
+ $missing = $results->missing;
+
+ ok(exists $valid->{'100x100_gif'}, 'expecting success with mime_type');
+ ok((grep /300x300/, @invalids), 'expecting failure with mime_type');
+ }
+
+ ## range checks with new format
+ {
+ use Data::FormValidator::Constraints::Upload qw(image_max_dimensions image_min_dimensions);
+ my $profile_6 = {
+ required => [ qw/hello_world 100x100_gif 300x300_gif/ ],
+ constraint_methods => {
+ '100x100_gif' => [
+ image_max_dimensions(200, 200),
+ image_min_dimensions(110, 100)
+ ],
+ '300x300_gif' => [
+ image_max_dimensions(400, 400),
+ image_min_dimensions(245, 100)
+ ]
+ }
+ };
+
+ $dfv = Data::FormValidator->new({ profile_6 => $profile_6});
+ eval {
+ $results = $dfv->check($q, 'profile_6');
+ };
+
+ ok(not $@) or diag $@;
+
+ $valid = $results->valid;
+ $invalid = $results->invalid; # as hash ref
+ @invalids = $results->invalid;
+ $missing = $results->missing;
+
+ ok((grep /100x100/, @invalids), 'expecting failure with size range');
+ ok(exists $valid->{'300x300_gif'}, 'expecting success with size range');
+
+ }
+
+} ## end of foreach loop
+
+## end of tests
More information about the Pkg-perl-cvs-commits
mailing list