r5936 - in /packages/libdata-formvalidator-perl/branches/upstream/current: ./ lib/Data/ lib/Data/FormValidator/ lib/Data/FormValidator/Constraints/ t/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Fri Jul 20 14:47:57 UTC 2007
Author: eloy
Date: Fri Jul 20 14:47:56 2007
New Revision: 5936
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=5936
Log:
[svn-upgrade] Integrating new upstream version, libdata-formvalidator-perl (4.51)
Modified:
packages/libdata-formvalidator-perl/branches/upstream/current/Build.PL
packages/libdata-formvalidator-perl/branches/upstream/current/Changes
packages/libdata-formvalidator-perl/branches/upstream/current/META.yml
packages/libdata-formvalidator-perl/branches/upstream/current/Makefile.PL
packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator.pm
packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Constraints.pm
packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Constraints/Upload.pm
packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Results.pm
packages/libdata-formvalidator-perl/branches/upstream/current/t/04_arrayify_undef.t
Modified: packages/libdata-formvalidator-perl/branches/upstream/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-formvalidator-perl/branches/upstream/current/Build.PL?rev=5936&op=diff
==============================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/Build.PL (original)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/Build.PL Fri Jul 20 14:47:56 2007
@@ -34,13 +34,15 @@
module_name => 'Data::FormValidator',
license => 'perl',
requires => {
- 'Image::Size' => 0,
- 'Test::More' => 0,
- 'Date::Calc' => 5.0,
- 'File::MMagic' => 1.17,
- 'MIME::Types' => 1.005,
- 'Regexp::Common' => 0,
- 'overload' => 0,
+ 'Image::Size' => 0,
+ 'Test::More' => 0,
+ 'Date::Calc' => 5.0,
+ 'File::MMagic' => 1.17,
+ 'MIME::Types' => 1.005,
+ 'Regexp::Common' => 0,
+ 'overload' => 0,
+ 'Perl6::Junction' => 1.10,
+ 'Scalar::Util' => 0,
},
)->create_build_script;
Modified: packages/libdata-formvalidator-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-formvalidator-perl/branches/upstream/current/Changes?rev=5936&op=diff
==============================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/Changes (original)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/Changes Fri Jul 20 14:47:56 2007
@@ -1,3 +1,30 @@
+4.51 Fri Jul 13 23:31:43 EDT 2007
+ [BUG FIXES]
+ - Quit assuming that because the first element of an array is undef, the
+ the whole thing is undef. (RT#24703, GTERMARS, Paul Blair)
+
+ - For the "file_format" file upload constraint, File::MMagic sometimes
+ wrongly returns the generic "application/octet-stream" MIME type instead
+ of the correct MIME type. We now this return value as meaning "I don't
+ know" and try the MIME type sent by the browser if this happens.
+ (Mark Stosberg)
+
+ - for the "file_format" file upload constraint, we now do a
+ case-insensitive comparison of the MIME type provided by the browser,
+ following the MIME standard. This bug was masked because we check the
+ returned MIME type by File::MMagic first. Because it generally works
+ and returns a lower-case result, it didn't matter. However, it some cases
+ File::MMagic misbehaves under mod_perl, causing the the issue to matter.
+ (Matt Christian, Mark Stosberg)
+
+ [INTERNALS]
+ - Start requiring and using Scalar::Util, which prevents UNIVERSAL::can() form generating warnings.
+ (RT#25873, Dave O'Neill)
+
+ - Start requiring Perl6::Junction, which we had previously copy/pasted a bit
+ of into DFV. (Unlike some of the other Perl6 namespace modules, this one
+ does /not/ use a source filter, and is addictively simple and useful.
+
4.50 Mon Dec 4 21:28:09 EST 2006
[ENHANCEMENTS]
Modified: packages/libdata-formvalidator-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-formvalidator-perl/branches/upstream/current/META.yml?rev=5936&op=diff
==============================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/META.yml (original)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/META.yml Fri Jul 20 14:47:56 2007
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Data-FormValidator
-version: 4.50
+version: 4.51
author:
- Mark Stosberg <mark at summersault.com>
abstract: |-
@@ -12,38 +12,34 @@
File::MMagic: 1.17
Image::Size: 0
MIME::Types: 1.005
+ Perl6::Junction: 1.1
Regexp::Common: 0
+ Scalar::Util: 0
Test::More: 0
overload: 0
provides:
Data::FormValidator:
file: lib/Data/FormValidator.pm
- version: 4.50
- Data::FormValidator::Any:
- file: lib/Data/FormValidator.pm
- version: 4.50
+ version: 4.51
Data::FormValidator::Constraints:
file: lib/Data/FormValidator/Constraints.pm
- version: 4.5
+ version: 4.51
Data::FormValidator::Constraints::Dates:
file: lib/Data/FormValidator/Constraints/Dates.pm
version: 1.01
Data::FormValidator::Constraints::RegexpCommon:
file: lib/Data/FormValidator/Results.pm
- version: 4.5
+ version: 4.51
Data::FormValidator::Constraints::Upload:
file: lib/Data/FormValidator/Constraints/Upload.pm
- version: 1.2
+ version: 1.22
Data::FormValidator::ConstraintsFactory:
file: lib/Data/FormValidator/ConstraintsFactory.pm
version: 1.4
Data::FormValidator::Filters:
file: lib/Data/FormValidator/Filters.pm
version: 4.1
- Data::FormValidator::None:
- file: lib/Data/FormValidator.pm
- version: 4.50
Data::FormValidator::Results:
file: lib/Data/FormValidator/Results.pm
- version: 4.5
+ version: 4.51
generated_by: Module::Build version 0.2611
Modified: packages/libdata-formvalidator-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-formvalidator-perl/branches/upstream/current/Makefile.PL?rev=5936&op=diff
==============================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/Makefile.PL (original)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/Makefile.PL Fri Jul 20 14:47:56 2007
@@ -9,7 +9,9 @@
'File::MMagic' => '1.17',
'Image::Size' => '0',
'MIME::Types' => '1.005',
+ 'Perl6::Junction' => '1.1',
'Regexp::Common' => '0',
+ 'Scalar::Util' => '0',
'Test::More' => '0',
'overload' => '0'
},
Modified: packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator.pm?rev=5936&op=diff
==============================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator.pm (original)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator.pm Fri Jul 20 14:47:56 2007
@@ -25,6 +25,7 @@
use 5.005; # for "qr" support, which isn't strictly required.
+use Perl6::Junction qw(any none);
use Data::FormValidator::Results;
*_arrayify = \&Data::FormValidator::Results::_arrayify;
use Data::FormValidator::Filters ':filters';
@@ -32,7 +33,7 @@
use vars qw( $VERSION $AUTOLOAD @ISA @EXPORT_OK %EXPORT_TAGS );
-$VERSION = '4.50';
+$VERSION = '4.51';
require Exporter;
@ISA = qw(Exporter);
@@ -1019,53 +1020,6 @@
}
-sub any { return Data::FormValidator::Any->any(@_) }
-sub none { return Data::FormValidator::None->none(@_) }
-
-1;
-
-# Just what we need from Perl6::Junction::Any;
-# See Perl6::Junction for docs, details, tests, etc.
-package Data::FormValidator::Any;
- use overload(
- 'eq' => \&str_eq,
- );
- sub any {
- my ($proto, @param) = @_;
- return bless \@param, $proto;
- }
-
- sub str_eq {
- my ($self, $test) = @_;
- for (@$self) {
- return 1 if $_ eq $test;
- }
- return;
- }
-
-package Data::FormValidator::None;
- use overload(
- 'eq' => \&str_eq,
- );
-
- sub none {
- my ($class, @param) = @_;
- return bless \@param, $class;
- }
-
- sub str_eq {
- my ($self, $test) = @_;
-
- for (@$self) {
- return if $_ eq $test;
- }
-
- return 1;
-}
-
-
-
-
1;
@@ -1320,3 +1274,4 @@
=cut
+
Modified: packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Constraints.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Constraints.pm?rev=5936&op=diff
==============================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Constraints.pm (original)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Constraints.pm Fri Jul 20 14:47:56 2007
@@ -23,7 +23,7 @@
use strict;
use vars qw/$AUTOLOAD @ISA @EXPORT_OK %EXPORT_TAGS $VERSION/;
-$VERSION = 4.50;
+$VERSION = 4.51;
require Exporter;
@ISA = qw(Exporter);
@@ -58,9 +58,9 @@
sub $func {
return sub {
my \$dfv = shift;
- use UNIVERSAL qw( can ) ;
- can(\$dfv, "name_this")
- || die "first arg to $func was not an object. Must be called as a constraint_method.";
+ use Scalar::Util ();
+ die "first arg to $func was not an object. Must be called as a constraint_method."
+ unless ( Scalar::Util::blessed(\$dfv) && \$dfv->can('name_this') );
\$dfv->name_this('$func');
no strict 'refs';
Modified: packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Constraints/Upload.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Constraints/Upload.pm?rev=5936&op=diff
==============================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Constraints/Upload.pm (original)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Constraints/Upload.pm Fri Jul 20 14:47:56 2007
@@ -28,7 +28,7 @@
image_min_dimensions
);
-$VERSION = 1.2;
+$VERSION = 1.22;
sub file_format {
my %params = @_;
@@ -103,13 +103,17 @@
# Work around a bug in File::MMagic (RT#12074)
seek($fh,0,0);
+ # File::MMagic returns 'application/octet-stream" as a punt
+ # for "I don't know, here's a generic binary MIME type.
+ # In some cases that is has indicated a bug in File::MMagic,
+ # but it's a generally worthless response for identifying the file type.
+ # so, we throw away the response in that case. The uploaded MIME type
+ # will be used instead later, if present
+ $fm_mt = undef if ($fm_mt eq 'application/octet-stream');
+
+
## fetch mime type universally (or close)
my $uploaded_mt = _get_upload_mime_type($self);
-
- # 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!];
- my %allowed_types = map { $_ => 1 } @{ $params->{mime_types} };
# try the File::MMagic, then the uploaded field, then return undef we find neither
my $mt = ($fm_mt || $uploaded_mt) or return undef;
@@ -146,8 +150,22 @@
$info = { %$info, mime_type => $mt, extension => ".$ext" };
$self->meta($field,$info);
- return $allowed_types{$mt};
-}
+ return _is_allowed_type($mt, $params);
+}
+
+## Returns true if the passed-in mime-type matches our allowed types
+sub _is_allowed_type {
+ my $mt = shift;
+ my $params = shift;
+
+ # 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!];
+ my %allowed_types = map { $_ => 1 } @{ $params->{mime_types} };
+
+ return $allowed_types{lc $mt};
+}
+
sub valid_image_max_dimensions {
my $self = shift;
Modified: packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Results.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Results.pm?rev=5936&op=diff
==============================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Results.pm (original)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/lib/Data/FormValidator/Results.pm Fri Jul 20 14:47:56 2007
@@ -14,7 +14,7 @@
use strict;
package Data::FormValidator::Results;
-
+use Perl6::Junction 'any';
use Carp;
use Symbol;
use Data::FormValidator::Filters ':filters';
@@ -24,7 +24,7 @@
'bool' => \&_bool_overload_based_on_success,
fallback => 1;
-$VERSION = 4.50;
+$VERSION = 4.51;
=pod
@@ -842,13 +842,14 @@
my $val = shift;
defined $val or return ();
+ # if it's a reference, return an array unless it points to an empty array. -mls
if ( ref $val eq 'ARRAY' ) {
- # if it's a reference, return an array unless it points an empty array. -mls
- return (defined $val->[0]) ? @$val : ();
+ $^W = 0; # turn off warnings about undef
+ return ( any(@$val) ne undef ) ? @$val : ();
}
+ # if it's a string, return an array unless the string is missing or empty. -mls
else {
- # if it's a string, return an array unless the string is missing or empty. -mls
- return (length $val) ? ($val) : ();
+ return (length $val) ? ($val) : ();
}
}
@@ -1040,10 +1041,11 @@
sub _get_input_as_hash {
my ($self,$data) = @_;
$self->{__INPUT_DATA} = $data;
- require UNIVERSAL;
-
- # This checks whether we have an object that supports param
- if (UNIVERSAL::can($data,'param') ) {
+
+ require Scalar::Util;
+
+ # 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()){
# we expect param to return an array if there are multiple values
Modified: packages/libdata-formvalidator-perl/branches/upstream/current/t/04_arrayify_undef.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-formvalidator-perl/branches/upstream/current/t/04_arrayify_undef.t?rev=5936&op=diff
==============================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/t/04_arrayify_undef.t (original)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/t/04_arrayify_undef.t Fri Jul 20 14:47:56 2007
@@ -1,27 +1,34 @@
-# checks for correct behavior when $input_profile->{'required'}
-# is not specified; fails if _arrayify() does not return an empty list
-
use strict;
-
$^W = 1;
-use Test::More tests => 2;
+use Test::More tests => 4;
-use Data::FormValidator;
+{
+ my $test_name =
+ "checks for correct behavior when 'required'
+ is not specified; fails if _arrayify() does not return an empty list";
-my $input_profile = {
- optional => [ qw( email ) ],
- };
+ use Data::FormValidator;
+ my $input_profile = { optional => [ qw( email ) ] };
+ my $validator = Data::FormValidator->new({default => $input_profile});
-my $validator = new Data::FormValidator({default => $input_profile});
+ my $input_hashref = {email => 'bob at example.com' };
-my $input_hashref = {email => 'bob at example.com',
- };
+ my ($valids, $missings, $invalids, $unknowns);
+ eval{ ($valids, $missings, $invalids, $unknowns) = $validator->validate($input_hashref, 'default') };
+ is($@, '', $test_name);
+ is(@$missings, 0, $test_name);
+}
-my ($valids, $missings, $invalids, $unknowns);
+{
+ my $test_name = "arrayref with first element undef";
+ use Data::FormValidator::Results;
-eval{
- ($valids, $missings, $invalids, $unknowns) = $validator->validate($input_hashref, 'default');
-};
-ok(not $@);
-is(@$missings, 0);
+ my $inputs = [ undef, 1, 2, 3, "Echo", "Foxtrot" ];
+ my $retval = Data::FormValidator::Results::_arrayify($inputs);
+ my @retval = Data::FormValidator::Results::_arrayify($inputs);
+
+ is($retval, 6, "$test_name... in scalar context");
+ is_deeply(\@retval, $inputs, "$test_name..in list context");
+
+}
More information about the Pkg-perl-cvs-commits
mailing list