From: David Landgren <david@landgren.net>
Date: Wed, 6 Jun 2007 23:57:34 +0000 (+0200)
Subject: Re: [PATCH] Update File-Path to 2.00
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3376a30ff58c3873904ed75bb471f95c5ecf3651;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH] Update File-Path to 2.00
Message-ID: <46672DCE.2080508@landgren.net>

p4raw-id: //depot/perl@31345
---

diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index a993510..fa13d3f 100644
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -6,8 +6,8 @@ File::Path - Create or remove directory trees
 
 =head1 VERSION
 
-This document describes version 2.00_01 of File::Path, released
-2007-xx-xx.
+This document describes version 2.00_02 of File::Path, released
+2007-06-06.
 
 =head1 SYNOPSIS
 
@@ -371,7 +371,7 @@ BEGIN {
 
 use Exporter ();
 use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '2.00_01';
+$VERSION = '2.00_02';
 @ISA     = qw(Exporter);
 @EXPORT  = qw(mkpath rmtree);
 
@@ -395,7 +395,7 @@ sub _croak {
 
 sub mkpath {
     my $new_style = (
-        ref($_[0]) eq 'ARRAY'
+        UNIVERSAL::isa($_[0],'ARRAY')
         or (@_ == 2 and $_[1] =~ /\A\d+\z/)
         or (@_ == 3 and $_[1] =~ /\A\d+\z/ and $_[2] =~ /\A\d+\z/)
     ) ? 0 : 1;
@@ -404,7 +404,7 @@ sub mkpath {
     my $paths;
 
     if ($new_style) {
-        if (ref $_[-1] eq 'HASH') {
+        if (@_ > 0 and UNIVERSAL::isa($_[-1], 'HASH')) {
             $arg = pop @_;
             exists $arg->{mask} and $arg->{mode} = delete $arg->{mask};
             $arg->{mode} = 0777 unless exists $arg->{mode};
@@ -418,7 +418,7 @@ sub mkpath {
     else {
         my ($verbose, $mode);
         ($paths, $verbose, $mode) = @_;
-        $paths = [$paths] unless ref($paths) eq 'ARRAY';
+        $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY');
         $arg->{verbose} = defined $verbose ? $verbose : 0;
         $arg->{mode}    = defined $mode    ? $mode    : 0777;
     }
@@ -469,7 +469,7 @@ sub _mkpath {
 
 sub rmtree {
     my $new_style = (
-        ref($_[0]) eq 'ARRAY'
+        UNIVERSAL::isa($_[0],'ARRAY')
         or (@_ == 2 and $_[1] =~ /\A\d+\z/)
         or (@_ == 3 and $_[1] =~ /\A\d+\z/ and $_[2] =~ /\A\d+\z/)
     ) ? 0 : 1;
@@ -478,7 +478,7 @@ sub rmtree {
     my $paths;
 
     if ($new_style) {
-        if (ref $_[-1] eq 'HASH') {
+        if (@_ > 0 and UNIVERSAL::isa($_[-1],'HASH')) {
             $arg = pop @_;
             ${$arg->{error}}  = [] if exists $arg->{error};
             ${$arg->{result}} = [] if exists $arg->{result};
@@ -492,20 +492,22 @@ sub rmtree {
     else {
         my ($verbose, $safe);
         ($paths, $verbose, $safe) = @_;
-        $paths = [$paths] unless ref($paths) eq 'ARRAY';
         $arg->{verbose} = defined $verbose ? $verbose : 0;
         $arg->{safe}    = defined $safe    ? $safe    : 0;
-    }
 
-    if (@$paths < 1) {
+        if (defined($paths) and length($paths)) {
+            $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY');
+        }
+        else {
         if ($arg->{error}) {
             push @{${$arg->{error}}}, {'' => "No root path(s) specified"};
     }
     else {
-            $arg->{verbose} and _carp ("No root path(s) specified\n");
+                _carp ("No root path(s) specified\n");
         }
       return 0;
     }
+    }
     return _rmtree($arg, $paths);
 }
 
diff --git a/lib/File/Path.t b/lib/File/Path.t
index 055fc46..427ef25 100755
--- a/lib/File/Path.t
+++ b/lib/File/Path.t
@@ -2,7 +2,7 @@
 
 use strict;
 
-use Test::More tests => 72;
+use Test::More tests => 71;
 
 BEGIN {
     use_ok('File::Path');
@@ -74,11 +74,7 @@ SKIP: {
 
 my $count = rmtree({error => \$error});
 is( $count, 0, 'rmtree of nothing, count of zero' );
-is( scalar(@$error), 1, 'one diagnostic captureed' );
-eval { ($file, $message) = each %{$error->[0]} }; # too early to die, just in case
-is( $@, '', 'decoded diagnostic' );
-is( $file, '', 'general diagnostic' );
-is( $message, 'No root path(s) specified', 'expected diagnostic received' );
+is( scalar(@$error), 0, 'no diagnostic captured' );
 
 @created = mkpath($tmp_base, 0);
 is(scalar(@created), 0, "skipped making existing directories (old style 1)")
@@ -220,10 +216,21 @@ SKIP: {
     is( $file, $dir, 'symlink reported in error' );
 }
 
+{
+    $dir = catdir($tmp_base, 'Z');
+    @created = mkpath($dir);
+    is(scalar(@created), 1, "create a Z directory");
+
+    local @ARGV = ($dir);
+    rmtree( [grep -e $_, @ARGV], 0, 0 );
+    ok(!-e $dir, "blow it away via \@ARGV");
+}
+
 SKIP: {
     skip 'Test::Output not available', 10
         unless $has_Test_Output;
 
+
     SKIP: {
         $dir = catdir('EXTRA', '3');
         skip "extra scenarios not set up, see eg/setup-extra-tests", 2
@@ -252,7 +259,7 @@ and can't restore permissions to \d+
     $dir2 = catdir($base,'B');
 
     stderr_like(
-        sub { rmtree( [], 1 ) },
+        sub { rmtree( undef, 1 ) },
         qr/\ANo root path\(s\) specified\b/,
         "rmtree of nothing carps sensibly"
     );