r8434 - in /trunk/libdata-formvalidator-perl: ./ debian/ lib/Data/ lib/Data/FormValidator/ lib/Data/FormValidator/Constraints/ t/
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Mon Oct 22 06:03:44 UTC 2007
Author: dmn
Date: Mon Oct 22 06:03:44 2007
New Revision: 8434
URL: http://svn.debian.org/wsvn/?sc=1&rev=8434
Log:
* New upstream bugfix release
Modified:
trunk/libdata-formvalidator-perl/Changes
trunk/libdata-formvalidator-perl/META.yml
trunk/libdata-formvalidator-perl/README
trunk/libdata-formvalidator-perl/debian/changelog
trunk/libdata-formvalidator-perl/lib/Data/FormValidator.pm
trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Constraints.pm
trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Constraints/Upload.pm
trunk/libdata-formvalidator-perl/lib/Data/FormValidator/ConstraintsFactory.pm
trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Results.pm
trunk/libdata-formvalidator-perl/t/missing_optional.t
trunk/libdata-formvalidator-perl/t/upload.t
trunk/libdata-formvalidator-perl/t/upload_closure.t
Modified: trunk/libdata-formvalidator-perl/Changes
URL: http://svn.debian.org/wsvn/trunk/libdata-formvalidator-perl/Changes?rev=8434&op=diff
==============================================================================
--- trunk/libdata-formvalidator-perl/Changes (original)
+++ trunk/libdata-formvalidator-perl/Changes Mon Oct 22 06:03:44 2007
@@ -1,3 +1,23 @@
+
+4.55 Sun Oct 21 11:41:41 EDT 2007
+ [BUG FIXES]
+ - Constraints in Upload.pm now apply to filtered data, not raw data.
+ (Graham TerMarsch, Mark Stosberg, RT#24702)
+
+4.54 Sun Oct 21 09:27:07 EDT 2007
+ [INTERNALS]
+ - It looks like 4.53 got uploaded wrong, appearing as the code for 4.50.
+
+4.53 Sat Oct 20 15:57:56 EDT 2007
+ [BUG FIXES]
+ - Invalid fields should still be invalid, even when missing_optional_valid is true.
+ Patch thanks to Robert Juliano. [RT#28860]
+
+ [INTERNALS]
+ - Improve documentation link, thanks to Robert Stockdale [RT#29510]
+ - Give a plug to Data::FormValidator::Constraints::MethodsFactory. Recommended!
+ - s/foreach /for /g throughout the code, per Perl Best Practices
+
4.52 Fri Oct 19 15:39:14 EDT 2007
No code changes.
Modified: trunk/libdata-formvalidator-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libdata-formvalidator-perl/META.yml?rev=8434&op=diff
==============================================================================
--- trunk/libdata-formvalidator-perl/META.yml (original)
+++ trunk/libdata-formvalidator-perl/META.yml Mon Oct 22 06:03:44 2007
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Data-FormValidator
-version: 4.52
+version: 4.55
author:
- Mark Stosberg <mark at summersault.com>
abstract: |-
@@ -20,7 +20,7 @@
provides:
Data::FormValidator:
file: lib/Data/FormValidator.pm
- version: 4.52
+ version: 4.55
Data::FormValidator::Constraints:
file: lib/Data/FormValidator/Constraints.pm
version: 4.51
@@ -29,17 +29,17 @@
version: 1.01
Data::FormValidator::Constraints::RegexpCommon:
file: lib/Data/FormValidator/Results.pm
- version: 4.51
+ version: 4.55
Data::FormValidator::Constraints::Upload:
file: lib/Data/FormValidator/Constraints/Upload.pm
- version: 1.22
+ version: 4.55
Data::FormValidator::ConstraintsFactory:
file: lib/Data/FormValidator/ConstraintsFactory.pm
- version: 1.4
+ version: 1.6
Data::FormValidator::Filters:
file: lib/Data/FormValidator/Filters.pm
version: 4.1
Data::FormValidator::Results:
file: lib/Data/FormValidator/Results.pm
- version: 4.51
+ version: 4.55
generated_by: Module::Build version 0.2611
Modified: trunk/libdata-formvalidator-perl/README
URL: http://svn.debian.org/wsvn/trunk/libdata-formvalidator-perl/README?rev=8434&op=diff
==============================================================================
--- trunk/libdata-formvalidator-perl/README (original)
+++ trunk/libdata-formvalidator-perl/README Mon Oct 22 06:03:44 2007
@@ -431,7 +431,7 @@
Untainting is based on the pattern match used by the constraint. Note
that some constraint routines may not provide untainting.
- See "WRITING YOUR OWN CONSTRAINT ROUTINES" in the
+ See Writing your own constraint routines in the
Data::FormValidator::Constraints documentation for more information.
This is overridden by "untaint_constraint_fields" and
Modified: trunk/libdata-formvalidator-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libdata-formvalidator-perl/debian/changelog?rev=8434&op=diff
==============================================================================
--- trunk/libdata-formvalidator-perl/debian/changelog (original)
+++ trunk/libdata-formvalidator-perl/debian/changelog Mon Oct 22 06:03:44 2007
@@ -1,3 +1,9 @@
+libdata-formvalidator-perl (4.55-1) UNRELEASED; urgency=low
+
+ * New upstream bugfix release
+
+ -- Damyan Ivanov <dmn at debian.org> Mon, 22 Oct 2007 09:03:17 +0300
+
libdata-formvalidator-perl (4.52-1) unstable; urgency=low
* New upstream release.
Modified: trunk/libdata-formvalidator-perl/lib/Data/FormValidator.pm
URL: http://svn.debian.org/wsvn/trunk/libdata-formvalidator-perl/lib/Data/FormValidator.pm?rev=8434&op=diff
==============================================================================
--- trunk/libdata-formvalidator-perl/lib/Data/FormValidator.pm (original)
+++ trunk/libdata-formvalidator-perl/lib/Data/FormValidator.pm Mon Oct 22 06:03:44 2007
@@ -33,7 +33,7 @@
use vars qw( $VERSION $AUTOLOAD @ISA @EXPORT_OK %EXPORT_TAGS );
-$VERSION = '4.52';
+$VERSION = '4.55';
require Exporter;
@ISA = qw(Exporter);
@@ -654,7 +654,7 @@
the pattern match used by the constraint. Note that some constraint routines
may not provide untainting.
-See L<WRITING YOUR OWN CONSTRAINT ROUTINES> in the Data::FormValidator::Constraints
+See L<Writing your own constraint routines|Data::FormValidator::Constraints/"WRITING YOUR OWN CONSTRAINT ROUTINES"> in the Data::FormValidator::Constraints
documentation for more information.
This is overridden by C<untaint_constraint_fields> and C<untaint_regexp_map>.
Modified: trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Constraints.pm
URL: http://svn.debian.org/wsvn/trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Constraints.pm?rev=8434&op=diff
==============================================================================
--- trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Constraints.pm (original)
+++ trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Constraints.pm Mon Oct 22 06:03:44 2007
@@ -953,6 +953,9 @@
=item L<Data::FormValidator::Constraints::Japanese> - Japan-specific constraints
+=item L<Data::FormValidator::Constraints::MethodsFactory> - a useful collection of tools generate more complex constraints. Recommended!
+
+
=back
=head2 Related modules in this package
@@ -962,6 +965,7 @@
=item L<Data::FormValidator::Filters> - transform data before constraints are applied
=item L<Data::FormValidator::ConstraintsFactory> - This is a historical collection of constraints that suffer from cumbersome names. They are worth reviewing though-- C<make_and_constraint> will allow to validate against a list of constraints and shortcircuit if the first one fails. That's perfect if the second constraint depends on the first one having passed.
+For a modern version of this toolkit, see L<Data::FormValidator::Constraints::MethodsFactory>.
=item L<Data::FormValidator>
Modified: trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Constraints/Upload.pm
URL: http://svn.debian.org/wsvn/trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Constraints/Upload.pm?rev=8434&op=diff
==============================================================================
--- trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Constraints/Upload.pm (original)
+++ trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Constraints/Upload.pm Mon Oct 22 06:03:44 2007
@@ -28,7 +28,7 @@
image_min_dimensions
);
-$VERSION = 1.22;
+$VERSION = 4.55;
sub file_format {
my %params = @_;
@@ -78,11 +78,7 @@
# included 'params => []' in your constraint definition, even if there
# are no additional arguments";
# }
-
- my $q = $self->get_input_data;
-
- $q->can('param') ||
- die 'file_format: data object missing param() method';
+ my $q = $self->get_filtered_data;
my $field = $self->get_current_constraint_field;
my $fh = _get_upload_fh($self);
@@ -125,7 +121,7 @@
my @mt_exts = $t ? $t->extensions : ();
## setup filename to retrieve extension
- my $fn = $q->param($field);
+ my $fn = $self->get_input_data->param($field);
my ($uploaded_ext) = ($fn =~ m/\.([\w\d]*)?$/);
my $ext;
@@ -178,7 +174,7 @@
($max_width > 0) || die 'image_max_dimensions: maximum width must be > 0';
($max_height > 0) || die 'image_max_dimensions: maximum height must be > 0';
- my $q = $self->get_input_data;
+ my $q = $self->get_filtered_data;
my $field = $self->get_current_constraint_field;
my ($width,$height) = _get_img_size($self);
@@ -211,9 +207,7 @@
$max_bytes = 1024*1024; # default to 1 Meg
}
- my $q = $self->get_input_data;
- $q->can('param') ||
- die 'file_max_bytes: object missing param() method';
+ my $q = $self->get_filtered_data;
my $field = $self->get_current_constraint_field;
@@ -247,7 +241,7 @@
($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 $q = $self->get_filtered_data;
my $field = $self->get_current_constraint_field;
my ($width, $height) = _get_img_size($self);
@@ -267,23 +261,23 @@
sub _get_img_size
{
my $self = shift;
- my $q = $self->get_input_data;
+ my $q = $self->get_filtered_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; }
+ if (not $fh) {
+ warn "Unable to load filehandle";
+ return undef;
+ }
require Image::Size;
import Image::Size;
@@ -304,58 +298,29 @@
sub _get_upload_fh
{
my $self = shift;
- my $q = $self->get_input_data;
- my $field = $self->get_current_constraint_field;
-
- ## CGI::Simple object processing (slightly 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 in case for weird 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;
+ my $q = $self->get_filtered_data;
+ my $field = $self->get_current_constraint_field;
+
+ # convert the FH for the filtered data into a -seekable- handle;
+ # depending on whether we're using CGI::Simple, CGI, or Apache::Request
+ # we might not have something -seekable-.
+ use IO::File;
+
+ # If we we already have an IO::File object, return it, otherwise create one.
+ require Scalar::Util;
+
+ if ( Scalar::Util::blessed($q->{$field}) && $q->{$field}->isa('IO::File') ) {
+ return $q->{$field};
+ }
+ else {
+ return IO::File->new_from_fd(fileno($q->{$field}), 'r');
+ }
+
}
## returns mime type if included as part of the send
+##
+## NOTE: retrieves from original uploaded, -UNFILTERED- data
sub _get_upload_mime_type
{
my $self = shift;
@@ -454,6 +419,11 @@
give up. The extension we return is based on the MIME type we found, rather
than trusting the one that was uploaded.
+B<NOTE:> if we have to fall back to using the MIME type provided by the
+browser, we access it from the original I<input> data and not the
+I<filtered> data. This should only cause issue when you have used a filter
+to alter the type of file that was uploaded (e.g. image conversion).
+
=item file_max_bytes
This function checks the maximum size of an uploaded file. By default,
Modified: trunk/libdata-formvalidator-perl/lib/Data/FormValidator/ConstraintsFactory.pm
URL: http://svn.debian.org/wsvn/trunk/libdata-formvalidator-perl/lib/Data/FormValidator/ConstraintsFactory.pm?rev=8434&op=diff
==============================================================================
--- trunk/libdata-formvalidator-perl/lib/Data/FormValidator/ConstraintsFactory.pm (original)
+++ trunk/libdata-formvalidator-perl/lib/Data/FormValidator/ConstraintsFactory.pm Mon Oct 22 06:03:44 2007
@@ -20,6 +20,13 @@
=head1 NAME
Data::FormValidator::ConstraintsFactory - Module to create constraints for HTML::FormValidator.
+
+=head1 DESCRIPTION
+
+This module contains functions to help generate complex constraints.
+
+If you are writing new code, take a look at L<Data::FormValidator::Constraints::MethodsFactory>
+instead. It's a modern alternative to what's here, offering improved names and syntax.
=head1 SYNOPSIS
@@ -34,11 +41,6 @@
bid => make_range_constraint( 1, 1, 10 ),
}
-=head1 DESCRIPTION
-
-This module contains several functions which returns closures that can
-be used for constraints.
-
=cut
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );
@@ -46,7 +48,7 @@
BEGIN {
require Exporter;
- $VERSION = 1.4;
+ $VERSION = 1.6;
@ISA = qw( Exporter );
@@ -101,7 +103,7 @@
# Closure
return sub {
my $res;
- foreach my $c ( @c ) {
+ for my $c ( @c ) {
$res = $c->( @_ );
return $res if $res;
}
@@ -123,7 +125,7 @@
# Closure
return sub {
my $res;
- foreach my $c ( @c ) {
+ for my $c ( @c ) {
$res = $c->( @_ );
return $res if ! $res;
@@ -155,7 +157,7 @@
# Closure
return sub {
my $v = $_[0];
- foreach my $t ( @values ) {
+ for my $t ( @values ) {
return $res if $t eq $v;
}
return ! $res;
@@ -178,7 +180,7 @@
# Closure
return sub {
my $v = $_[0];
- foreach my $t ( @values ) {
+ for my $t ( @values ) {
return $res if $t == $v;
}
return ! $res;
@@ -223,7 +225,7 @@
# Closure
return sub {
my $v = $_[0];
- foreach my $t ( @values ) {
+ for my $t ( @values ) {
return $res if $cmp->($v, $t );
}
return ! $res;
Modified: trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Results.pm
URL: http://svn.debian.org/wsvn/trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Results.pm?rev=8434&op=diff
==============================================================================
--- trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Results.pm (original)
+++ trunk/libdata-formvalidator-perl/lib/Data/FormValidator/Results.pm Mon Oct 22 06:03:44 2007
@@ -24,7 +24,7 @@
'bool' => \&_bool_overload_based_on_success,
fallback => 1;
-$VERSION = 4.51;
+$VERSION = 4.55;
=pod
@@ -38,27 +38,27 @@
# Print the name of missing fields
if ( $results->has_missing ) {
- foreach my $f ( $results->missing ) {
+ for my $f ( $results->missing ) {
print $f, " is missing\n";
}
}
# Print the name of invalid fields
if ( $results->has_invalid ) {
- foreach my $f ( $results->invalid ) {
+ for my $f ( $results->invalid ) {
print $f, " is invalid: ", $results->invalid( $f ), "\n";
}
}
# Print unknown fields
if ( $results->has_unknown ) {
- foreach my $f ( $results->unknown ) {
+ for my $f ( $results->unknown ) {
print $f, " is unknown\n";
}
}
# Print valid fields
- foreach my $f ( $results->valid() ) {
+ for my $f ( $results->valid() ) {
print $f, " = ", $results->valid( $f ), "\n";
}
@@ -97,7 +97,7 @@
my %imported_validators;
# import valid_* subs from requested packages
- foreach my $package (_arrayify($profile->{validator_packages})) {
+ for my $package (_arrayify($profile->{validator_packages})) {
if ( !exists $imported_validators{$package} ) {
local $SIG{__DIE__} = \&confess;
eval "require $package";
@@ -110,7 +110,7 @@
my $package_ref = qualify_to_ref("${package}::");
my @subs = grep(/^(valid_|match_|filter_)/,
keys(%{*{$package_ref}}));
- foreach my $sub (@subs) {
+ for my $sub (@subs) {
# is it a sub? (i.e. make sure it's not a scalar, hash, etc.)
my $subref = *{qualify_to_ref("${package}::$sub")}{CODE};
if (defined $subref) {
@@ -122,12 +122,12 @@
}
# Apply unconditional filters
- foreach my $filter (_arrayify($profile->{filters})) {
+ for my $filter (_arrayify($profile->{filters})) {
if (defined $filter) {
# Qualify symbolic references
$filter = (ref $filter eq 'CODE' ? $filter : *{qualify_to_ref("filter_$filter")}{CODE}) ||
die "No filter found named: '$filter'";
- foreach my $field ( keys %valid ) {
+ for my $field ( keys %valid ) {
# apply filter, modifying %valid by reference, skipping undefined values
_filter_apply(\%valid,$field,$filter);
}
@@ -136,7 +136,7 @@
# Apply specific filters
while ( my ($field,$filters) = each %{$profile->{field_filters} }) {
- foreach my $filter ( _arrayify($filters)) {
+ for my $filter ( _arrayify($filters)) {
if (defined $filter) {
# Qualify symbolic references
$filter = (ref $filter eq 'CODE' ? $filter : *{qualify_to_ref("filter_$filter")}{CODE}) ||
@@ -152,7 +152,7 @@
while ( my ($re,$filters) = each %{$profile->{field_filter_regexp_map} }) {
my $sub = _create_sub_from_RE($re);
- foreach my $filter ( _arrayify($filters)) {
+ for my $filter ( _arrayify($filters)) {
if (defined $filter) {
# Qualify symbolic references
$filter = (ref $filter eq 'CODE' ? $filter : *{qualify_to_ref("filter_$filter")}{CODE}) ||
@@ -179,7 +179,7 @@
my $required_re = _create_sub_from_RE($profile->{required_regexp});
my $optional_re = _create_sub_from_RE($profile->{optional_regexp});
- foreach my $k (keys %valid) {
+ for my $k (keys %valid) {
if ($required_re && $required_re->($k)) {
$required{$k} = 1;
}
@@ -192,14 +192,14 @@
# handle "require_some"
my %require_some;
while ( my ( $field, $deps) = each %{$profile->{require_some}} ) {
- foreach my $dep (_arrayify($deps)){
+ for my $dep (_arrayify($deps)){
$require_some{$dep} = 1;
}
}
# Remove all empty fields
- foreach my $field (keys %valid) {
+ for my $field (keys %valid) {
if (ref $valid{$field}) {
if ( ref $valid{$field} eq 'ARRAY' ) {
for (my $i = 0; $i < scalar @{ $valid{$field} }; $i++) {
@@ -219,7 +219,7 @@
while ( my ( $field, $deps) = each %{$profile->{dependencies}} ) {
if (defined $valid{$field}) {
if (ref($deps) eq 'HASH') {
- foreach my $key (keys %$deps) {
+ for my $key (keys %$deps) {
# Handle case of a key with a single value given as an arrayref
# There is probably a better, more general solution to this problem.
my $val_to_compare;
@@ -231,14 +231,14 @@
}
if($val_to_compare eq $key){
- foreach my $dep (_arrayify($deps->{$key})){
+ for my $dep (_arrayify($deps->{$key})){
$required{$dep} = 1;
}
}
}
}
else {
- foreach my $dep (_arrayify($deps)){
+ for my $dep (_arrayify($deps)){
$required{$dep} = 1;
}
}
@@ -247,9 +247,9 @@
# check dependency groups
# the presence of any member makes them all required
- foreach my $group (values %{ $profile->{dependency_groups} }) {
+ for my $group (values %{ $profile->{dependency_groups} }) {
my $require_all = 0;
- foreach my $field (_arrayify($group)) {
+ for my $field (_arrayify($group)) {
$require_all = 1 if $valid{$field};
}
if ($require_all) {
@@ -261,7 +261,7 @@
@unknown =
grep { not (exists $optional{$_} or exists $required{$_} or exists $require_some{$_} ) } keys %valid;
# and remove them from the list
- foreach my $field ( @unknown ) {
+ for my $field ( @unknown ) {
delete $valid{$field};
}
@@ -291,7 +291,7 @@
}
# Check for required fields
- foreach my $field ( keys %required ) {
+ for my $field ( keys %required ) {
push @missings, $field unless exists $valid{$field};
}
@@ -301,7 +301,7 @@
my @deps = _arrayify($deps);
# num fields to require is first element in array if looks like a digit, 1 otherwise.
my $num_fields_to_require = ($deps[0] =~ m/^\d+$/) ? $deps[0] : 1;
- foreach my $dep (@deps){
+ for my $dep (@deps){
$enough_required_fields++ if exists $valid{$dep};
}
push @missings, $field unless ($enough_required_fields >= $num_fields_to_require);
@@ -326,7 +326,7 @@
# 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}}) {
+ for my $field (@{$profile->{untaint_constraint_fields}}) {
$untaint_hash{$field} = 1;
}
}
@@ -345,9 +345,9 @@
push(@untaint_regexes, $profile->{untaint_regexp_map});
}
- foreach my $regex (@untaint_regexes) {
+ for my $regex (@untaint_regexes) {
# look at both constraints and constraint_methods
- foreach my $field (keys %$private_constraints, keys %$private_constraint_methods) {
+ for my $field (keys %$private_constraints, keys %$private_constraint_methods) {
next if($untaint_hash{$field});
$untaint_hash{$field} = 1 if( $field =~ $regex );
}
@@ -364,17 +364,17 @@
my $force_method_p = 1;
$self->_check_constraints($private_constraint_methods,\%valid,$untaint_all,\%untaint_hash, $force_method_p);
- # all invalid fields are removed from valid hash
- foreach my $field (keys %{ $self->{invalid} }) {
- delete $valid{$field};
- }
-
# add back in missing optional fields from the data hash if we need to
- foreach my $field ( keys %data ) {
+ for my $field ( keys %data ) {
if ($profile->{missing_optional_valid} and $optional{$field} and (not exists $valid{$field})) {
$valid{$field} = undef;
}
}
+
+ # all invalid fields are removed from valid hash
+ for my $field (keys %{ $self->{invalid} }) {
+ delete $valid{$field};
+ }
my ($missing,$invalid);
@@ -979,7 +979,7 @@
my @params;
if (defined $c->{params}) {
- foreach my $fname (_arrayify($c->{params})) {
+ for my $fname (_arrayify($c->{params})) {
# If the value is passed by reference, we treat it literally
push @params, (ref $fname) ? $fname : $data->{$fname}
}
@@ -1047,9 +1047,23 @@
# This checks whether we have an object that supports param
if ( Scalar::Util::blessed($data) && $data->can('param') ) {
my %return;
- foreach my $k ($data->param()){
+ for my $k ($data->param()){
# we expect param to return an array if there are multiple values
- my @v = $data->param($k);
+ my @v;
+
+ # CGI::Simple requires us to call 'upload()' to get upload data,
+ # while CGI/Apache::Request return it on calling 'param()'.
+ #
+ # This seems quirky, but there isn't a way for us to easily check if
+ # "this field contains a file upload" or not.
+ if ($data->isa('CGI::Simple')) {
+ @v = $data->upload($k) || $data->param($k);
+ }
+ else {
+ @v = $data->param($k);
+ }
+
+ # we expect param to return an array if there are multiple values
$return{$k} = scalar(@v)>1 ? \@v : $v[0];
}
return %return;
@@ -1113,7 +1127,7 @@
my $map_name = $name.'_regexp_map';
my %result = ();
- foreach my $re (keys %{ $profile->{$map_name} }) {
+ for my $re (keys %{ $profile->{$map_name} }) {
my $sub = _create_sub_from_RE($re);
# find all the keys that match this RE and add a constraint for them
@@ -1179,7 +1193,7 @@
my @invalid_list;
# used to insure we only bother recording each failed constraint once
my %constraints_seen;
- foreach my $constraint_spec (_arrayify($constraint_list)) {
+ for my $constraint_spec (_arrayify($constraint_list)) {
# set current constraint field for use by get_current_constraint_field
$self->{__CURRENT_CONSTRAINT_FIELD} = $field;
@@ -1194,7 +1208,7 @@
my $is_value_list = 1 if (ref $valid->{$field} eq 'ARRAY');
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++) {
+ for (my $i = 0; $i < scalar @{ $valid->{$field}} ; $i++) {
if( !exists $constraints_seen{\$c} ) {
my @params = $self->_constraint_input_build($c,$valid->{$field}->[$i],\%param_data);
Modified: trunk/libdata-formvalidator-perl/t/missing_optional.t
URL: http://svn.debian.org/wsvn/trunk/libdata-formvalidator-perl/t/missing_optional.t?rev=8434&op=diff
==============================================================================
--- trunk/libdata-formvalidator-perl/t/missing_optional.t (original)
+++ trunk/libdata-formvalidator-perl/t/missing_optional.t Mon Oct 22 06:03:44 2007
@@ -1,5 +1,5 @@
# Tests for missing_optional_valid
-use Test::More qw/no_plan/;
+use Test::More 'no_plan';
use strict;
$^W = 1;
@@ -76,5 +76,22 @@
is(join(',',sort $res->valid()),'a,b', "optional fields have to at least exist to be valid" );
}
-__END__
+{
+ my $data = {
+ optional_invalid => 'invalid'
+ };
+ my $profile = {
+ optional => [qw/optional_invalid/],
+ constraints => {
+ optional_invalid => qr/^valid$/
+ },
+ missing_optional_valid => 1
+ };
+
+ my $results = Data::FormValidator->check($data, $profile);
+ my $valid = $results->valid();
+ my $invalid = $results->invalid();
+ ok( exists $invalid->{'optional_invalid'}, 'optional_invalid is invalid');
+ ok( !exists $valid->{'optional_invalid'}, 'optional_invalid is not valid');
+}
Modified: trunk/libdata-formvalidator-perl/t/upload.t
URL: http://svn.debian.org/wsvn/trunk/libdata-formvalidator-perl/t/upload.t?rev=8434&op=diff
==============================================================================
--- trunk/libdata-formvalidator-perl/t/upload.t (original)
+++ trunk/libdata-formvalidator-perl/t/upload.t Mon Oct 22 06:03:44 2007
@@ -1,6 +1,6 @@
#########################
-use Test::More;
+use Test::More 'no_plan';
use strict;
BEGIN {
@@ -8,9 +8,6 @@
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 {
@@ -22,11 +19,8 @@
}
else {
diag "Adding CGI::Simple tests";
- $suite_count++;
$cgi_simple_test = 1;
}
-
-plan tests => ($single_suite_tests * $suite_count) + $all_suite_tests;
#########################
@@ -116,16 +110,14 @@
};
## same set of tests with each one (does this work?)
-foreach my $q ($cgi_pm_q, $cgi_simple_q) {
+for 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 $@;
+ my $results;
+ eval { $results = $dfv->check($q, 'default'); };
+ is($@,'','survived eval');
my $valid = $results->valid;
my $invalid = $results->invalid; # as hash ref
@@ -139,8 +131,10 @@
# 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");
+ ok(
+ (exists $valid->{'100x100_gif'}, "valid")
+ , 'Make sure 100x100 passes because it is the right type and size'
+ );
my $meta = $results->meta('100x100_gif');
is(ref $meta, 'HASH', 'meta() returns hash ref');
@@ -148,10 +142,10 @@
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');
-
- ok($results->meta('100x100_gif')->{bytes}>0, 'setting bytes meta data');
+ ok((grep {m/300x300/} @invalids)
+ , '300x300 should fail because it exceeds max_bytes');
+
+ ok(($results->meta('100x100_gif')->{bytes} > 0), (ref $q).': setting bytes meta data') ;
# Revalidate to usefully re-use the same fields
@@ -285,9 +279,8 @@
eval {
$results = $dfv->check($q, 'profile_6');
};
-
- ok(not $@) or diag $@;
-
+ is($@,'','survived eval');
+
$valid = $results->valid;
$invalid = $results->invalid; # as hash ref
@invalids = $results->invalid;
@@ -298,6 +291,6 @@
}
-} ## end of foreach loop
+} ## end of for loop
## end of tests
Modified: trunk/libdata-formvalidator-perl/t/upload_closure.t
URL: http://svn.debian.org/wsvn/trunk/libdata-formvalidator-perl/t/upload_closure.t?rev=8434&op=diff
==============================================================================
--- trunk/libdata-formvalidator-perl/t/upload_closure.t (original)
+++ trunk/libdata-formvalidator-perl/t/upload_closure.t Mon Oct 22 06:03:44 2007
@@ -1,6 +1,6 @@
#########################
-use Test::More tests => 18;
+use Test::More 'no_plan';
use strict;
BEGIN {
use_ok('CGI');
More information about the Pkg-perl-cvs-commits
mailing list