In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/233a40691b70c42ca9024717a12a721a2b30073c?hp=ef0f35a3bbd8050732ecbd53267e83e7e7de7844>
- Log ----------------------------------------------------------------- commit 233a40691b70c42ca9024717a12a721a2b30073c Author: James E Keenan <[email protected]> Date: Sat Aug 16 15:00:01 2014 -0400 Check validity of keys in hash passed as first argument. Prevent processing of misspelled options in hash passed to find() or finddepth(). Add perldelta entry for File::Find. For: RT #122547 ----------------------------------------------------------------------- Summary of changes: ext/File-Find/lib/File/Find.pm | 43 +++++++++++++++++++++++++++++++----------- ext/File-Find/t/find.t | 42 ++++++++++++++++++++++++++++++++++++++++- pod/perldelta.pod | 6 ++++++ t/porting/dual-life.t | 2 +- 4 files changed, 80 insertions(+), 13 deletions(-) diff --git a/ext/File-Find/lib/File/Find.pm b/ext/File-Find/lib/File/Find.pm index 6cfdb59..61eb3da 100644 --- a/ext/File-Find/lib/File/Find.pm +++ b/ext/File-Find/lib/File/Find.pm @@ -3,7 +3,7 @@ use 5.006; use strict; use warnings; use warnings::register; -our $VERSION = '1.27'; +our $VERSION = '1.28'; require Exporter; require Cwd; @@ -1055,21 +1055,42 @@ sub _find_dir_symlnk($$$) { sub wrap_wanted { my $wanted = shift; if ( ref($wanted) eq 'HASH' ) { + # RT #122547 + my %valid_options = map {$_ => 1} qw( + wanted + bydepth + preprocess + postprocess + follow + follow_fast + follow_skip + dangling_symlinks + no_chdir + untaint + untaint_pattern + untaint_skip + ); + my @invalid_options = (); + for my $v (keys %{$wanted}) { + push @invalid_options, $v unless exists $valid_options{$v}; + } + warn "Invalid option(s): @invalid_options" if @invalid_options; + unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) { die 'no &wanted subroutine given'; } - if ( $wanted->{follow} || $wanted->{follow_fast}) { - $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip}; - } - if ( $wanted->{untaint} ) { - $wanted->{untaint_pattern} = $File::Find::untaint_pattern - unless defined $wanted->{untaint_pattern}; - $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip}; - } - return $wanted; + if ( $wanted->{follow} || $wanted->{follow_fast}) { + $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip}; + } + if ( $wanted->{untaint} ) { + $wanted->{untaint_pattern} = $File::Find::untaint_pattern + unless defined $wanted->{untaint_pattern}; + $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip}; + } + return $wanted; } elsif( ref( $wanted ) eq 'CODE' ) { - return { wanted => $wanted }; + return { wanted => $wanted }; } else { die 'no &wanted subroutine given'; diff --git a/ext/File-Find/t/find.t b/ext/File-Find/t/find.t index 4b52f1e..390f39d 100644 --- a/ext/File-Find/t/find.t +++ b/ext/File-Find/t/find.t @@ -24,7 +24,7 @@ BEGIN { } my $symlink_exists = eval { symlink("",""); 1 }; -my $test_count = 102; +my $test_count = 109; $test_count += 127 if $symlink_exists; $test_count += 26 if $^O eq 'MSWin32'; $test_count += 2 if $^O eq 'MSWin32' and $symlink_exists; @@ -80,6 +80,46 @@ finddepth({wanted => sub { ++$::count_taint if $_ eq 'taint.t'; } }, File::Spec->curdir); is($::count_taint, 1, "'finddepth' found exactly 1 file named 'taint.t'"); +##### RT #122547 ##### +# Do find() and finddepth() correctly warn on invalid options? +{ + my $bad_option = 'foobar'; + my $second_bad_option = 'really_foobar'; + + $::count_taint = 0; + local $SIG{__WARN__} = sub { $warn_msg = $_[0]; }; + { + find( + { + wanted => sub { ++$::count_taint if $_ eq 'taint.t'; }, + $bad_option => undef, + }, + File::Spec->curdir + ); + }; + like($warn_msg, qr/Invalid option/s, "Got warning for invalid option"); + like($warn_msg, qr/$bad_option/s, "Got warning for $bad_option"); + is($::count_taint, 1, "count_taint incremented"); + undef $warn_msg; + + $::count_taint = 0; + { + finddepth( + { + wanted => sub { ++$::count_taint if $_ eq 'taint.t'; }, + $bad_option => undef, + $second_bad_option => undef, + }, + File::Spec->curdir + ); + }; + like($warn_msg, qr/Invalid option/s, "Got warning for invalid option"); + like($warn_msg, qr/$bad_option/s, "Got warning for $bad_option"); + like($warn_msg, qr/$second_bad_option/s, "Got warning for $second_bad_option"); + is($::count_taint, 1, "count_taint incremented"); + undef $warn_msg; +} + my $FastFileTests_OK = 0; sub cleanup { diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 7af6a92..6777118 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -121,6 +121,12 @@ XXX L<XXX> has been upgraded from version A.xx to B.yy. +=item * + +L<File::Find> has been upgraded from version 1.27 to 1.28. +C<find()> and C<finddepth()> will now warn if passed inappropriate or +misspelled options. + =back =head2 Removed Modules and Pragmata diff --git a/t/porting/dual-life.t b/t/porting/dual-life.t index 8d9f070..27daf46 100644 --- a/t/porting/dual-life.t +++ b/t/porting/dual-life.t @@ -43,7 +43,7 @@ $dist_dir_exe{'pod2html.pl'} = '../ext/Pod-Html'; my @programs; find( - { no_chidr => 1, wanted => sub { + { no_chdir => 1, wanted => sub { my $name = $File::Find::name; return if $name =~ /blib/; return unless $name =~ m{/(?:bin|scripts?)/\S+\z} && $name !~ m{/t/}; -- Perl5 Master Repository
