r71156 - in /branches/upstream/libfile-remove-perl/current: Changes MANIFEST META.yml lib/File/Remove.pm t/02_directories.t t/03_deep_readonly.t t/04_can_delete.t t/05_links.t t/07_cwd.t t/08_spaces.t xt/pmv.t
ansgar at users.alioth.debian.org
ansgar at users.alioth.debian.org
Fri Mar 11 13:24:47 UTC 2011
Author: ansgar
Date: Fri Mar 11 13:24:15 2011
New Revision: 71156
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=71156
Log:
[svn-upgrade] new version libfile-remove-perl (1.48)
Added:
branches/upstream/libfile-remove-perl/current/t/08_spaces.t
Modified:
branches/upstream/libfile-remove-perl/current/Changes
branches/upstream/libfile-remove-perl/current/MANIFEST
branches/upstream/libfile-remove-perl/current/META.yml
branches/upstream/libfile-remove-perl/current/lib/File/Remove.pm
branches/upstream/libfile-remove-perl/current/t/02_directories.t
branches/upstream/libfile-remove-perl/current/t/03_deep_readonly.t
branches/upstream/libfile-remove-perl/current/t/04_can_delete.t
branches/upstream/libfile-remove-perl/current/t/05_links.t
branches/upstream/libfile-remove-perl/current/t/07_cwd.t
branches/upstream/libfile-remove-perl/current/xt/pmv.t
Modified: branches/upstream/libfile-remove-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-remove-perl/current/Changes?rev=71156&op=diff
==============================================================================
--- branches/upstream/libfile-remove-perl/current/Changes (original)
+++ branches/upstream/libfile-remove-perl/current/Changes Fri Mar 11 13:24:15 2011
@@ -1,4 +1,13 @@
Revision history for Perl extension File-Remove
+
+1.48 Fri 11 Mar 2011 - Adam Kennedy
+ - Promoting dev code to production version
+ - Fixed a major bug in the 1.46 logic that works out what to change the
+ cwd to when deleting while inside a directory.
+
+1.47_01 Fri 18 Feb 2011 - Adam Kennedy
+ - Add test counts to all test scripts
+ - Added a test for space-safe globs
1.46 Fri 18 Feb 2011 - Adam Kennedy
- No changes from 1.45_01
Modified: branches/upstream/libfile-remove-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-remove-perl/current/MANIFEST?rev=71156&op=diff
==============================================================================
--- branches/upstream/libfile-remove-perl/current/MANIFEST (original)
+++ branches/upstream/libfile-remove-perl/current/MANIFEST Fri Mar 11 13:24:15 2011
@@ -21,6 +21,7 @@
t/05_links.t
t/06_curly.t
t/07_cwd.t
+t/08_spaces.t
xt/meta.t
xt/pmv.t
xt/pod.t
Modified: branches/upstream/libfile-remove-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-remove-perl/current/META.yml?rev=71156&op=diff
==============================================================================
--- branches/upstream/libfile-remove-perl/current/META.yml (original)
+++ branches/upstream/libfile-remove-perl/current/META.yml Fri Mar 11 13:24:15 2011
@@ -28,4 +28,4 @@
ChangeLog: http://fisheye2.atlassian.com/changelog/cpan/trunk/File-Remove
license: http://dev.perl.org/licenses/
repository: http://svn.ali.as/cpan/trunk/File-Remove
-version: 1.46
+version: 1.48
Modified: branches/upstream/libfile-remove-perl/current/lib/File/Remove.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-remove-perl/current/lib/File/Remove.pm?rev=71156&op=diff
==============================================================================
--- branches/upstream/libfile-remove-perl/current/lib/File/Remove.pm (original)
+++ branches/upstream/libfile-remove-perl/current/lib/File/Remove.pm Fri Mar 11 13:24:15 2011
@@ -6,7 +6,8 @@
use vars qw{ $VERSION @ISA @EXPORT_OK };
use vars qw{ $DEBUG $unlink $rmdir };
BEGIN {
- $VERSION = '1.46';
+ $VERSION = '1.48';
+ # $VERSION = eval $VERSION;
@ISA = qw{ Exporter };
@EXPORT_OK = qw{ remove rm clear trash };
}
@@ -225,9 +226,12 @@
# Do we need to move to a different directory to delete a directory,
# and if so which.
sub _moveto {
+ my $remove = File::Spec->rel2abs(shift);
+ my $cwd = @_ ? shift : Cwd::cwd();
+
# Do everything in absolute terms
- my $cwd = Cwd::abs_path( Cwd::cwd() );
- my $remove = Cwd::abs_path( File::Spec->rel2abs(shift) );
+ $remove = Cwd::abs_path( $remove );
+ $cwd = Cwd::abs_path( $cwd );
# If we are on a different volume we don't need to move
my ( $cv, $cd ) = File::Spec->splitpath( $cwd, 1 );
@@ -237,10 +241,9 @@
# If we have to move, it's to one level above the deletion
my @cd = File::Spec->splitdir($cd);
my @rd = File::Spec->splitdir($rd);
- pop @rd;
-
- # Is the current directory inside of the moveto directory?
- unless ( @cd > @rd ) {
+
+ # Is the current directory the same as or inside the remove directory?
+ unless ( @cd >= @rd ) {
return '';
}
foreach ( 0 .. $#rd ) {
@@ -248,6 +251,7 @@
}
# Confirmed, the current working dir is in the removal dir
+ pop @rd;
return File::Spec->catpath(
$rv,
File::Spec->catdir(@rd),
Modified: branches/upstream/libfile-remove-perl/current/t/02_directories.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-remove-perl/current/t/02_directories.t?rev=71156&op=diff
==============================================================================
--- branches/upstream/libfile-remove-perl/current/t/02_directories.t (original)
+++ branches/upstream/libfile-remove-perl/current/t/02_directories.t Fri Mar 11 13:24:15 2011
@@ -6,7 +6,7 @@
$^W = 1;
}
-use Test::More qw(no_plan); # tests => 2;
+use Test::More tests => 152;
use File::Remove qw{ remove trash };
@@ -147,5 +147,3 @@
UNDELETE: 1;
}
-
-1;
Modified: branches/upstream/libfile-remove-perl/current/t/03_deep_readonly.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-remove-perl/current/t/03_deep_readonly.t?rev=71156&op=diff
==============================================================================
--- branches/upstream/libfile-remove-perl/current/t/03_deep_readonly.t (original)
+++ branches/upstream/libfile-remove-perl/current/t/03_deep_readonly.t Fri Mar 11 13:24:15 2011
@@ -8,7 +8,7 @@
$^W = 1;
}
-use Test::More qw(no_plan);
+use Test::More tests => 12;
use File::Spec::Functions ':ALL';
use File::Copy ();
use File::Remove ();
Modified: branches/upstream/libfile-remove-perl/current/t/04_can_delete.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-remove-perl/current/t/04_can_delete.t?rev=71156&op=diff
==============================================================================
--- branches/upstream/libfile-remove-perl/current/t/04_can_delete.t (original)
+++ branches/upstream/libfile-remove-perl/current/t/04_can_delete.t Fri Mar 11 13:24:15 2011
@@ -8,7 +8,7 @@
$^W = 1;
}
-use Test::More qw(no_plan);
+use Test::More tests => 12;
use File::Spec::Functions ':ALL';
use File::Copy ();
use File::Remove ();
@@ -40,12 +40,12 @@
chmod( 0400, $f3 );
ok( -f $f3, "Created $f3 ok" );
ok( -r $f3, "Created $f3 -r" );
- SKIP: {
- if ( $^O ne 'MSWin32' and $< == 0 ) {
- skip("This test doesn't work as root", 1);
- }
- ok( ! -w $f3, "Created $f3 ! -w" );
- };
+ SKIP: {
+ if ( $^O ne 'MSWin32' and $< == 0 ) {
+ skip("This test doesn't work as root", 1);
+ }
+ ok( ! -w $f3, "Created $f3 ! -w" );
+ };
}
sub clear_directory {
Modified: branches/upstream/libfile-remove-perl/current/t/05_links.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-remove-perl/current/t/05_links.t?rev=71156&op=diff
==============================================================================
--- branches/upstream/libfile-remove-perl/current/t/05_links.t (original)
+++ branches/upstream/libfile-remove-perl/current/t/05_links.t Fri Mar 11 13:24:15 2011
@@ -62,5 +62,3 @@
ok( File::Remove::remove(\1, $testdir), "remove \\1: $testdir" );
ok( ! -e $testdir, "!-e: $testdir" );
-
-1;
Modified: branches/upstream/libfile-remove-perl/current/t/07_cwd.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-remove-perl/current/t/07_cwd.t?rev=71156&op=diff
==============================================================================
--- branches/upstream/libfile-remove-perl/current/t/07_cwd.t (original)
+++ branches/upstream/libfile-remove-perl/current/t/07_cwd.t Fri Mar 11 13:24:15 2011
@@ -6,7 +6,7 @@
$^W = 1;
}
-use Test::More tests => 9;
+use Test::More tests => 13;
use File::Spec::Functions ':ALL';
use File::Remove ();
use Cwd ();
@@ -25,6 +25,46 @@
ok( -d $cwd, "$cwd directory exists" );
ok( -d $foo, "$foo directory exists" );
ok( -f $file, "$file file exists" );
+
+# Test that _moveto behaves as expected
+SCOPE: {
+ is(
+ File::Remove::_moveto(
+ File::Spec->catdir($base, 't'), # remove
+ File::Spec->catdir($base), # cwd
+ ),
+ '',
+ '_moveto returns correct for normal case',
+ );
+
+ my $moveto1 = File::Remove::_moveto(
+ File::Spec->catdir($base, 't'), # remove
+ File::Spec->catdir($base, 't'), # cwd
+ );
+ $moveto1 =~ s/\\/\//g;
+ is( $moveto1, $base, '_moveto returns correct for normal case' );
+
+ my $moveto2 = File::Remove::_moveto(
+ File::Spec->catdir($base, 't'), # remove
+ File::Spec->catdir($base, 't', 'cwd'), # cwd
+ );
+ $moveto2 =~ s/\\/\//g;
+ is( $moveto2, $base, '_moveto returns correct for normal case' );
+
+ # Regression: _moveto generates false positives
+ # cwd: /tmp/cpan2/PITA-Image/PITA-Image-0.50
+ # remove: /tmp/eBtQxTPGHC
+ # moveto: /tmp
+ # expected: ''
+ is(
+ File::Remove::_moveto(
+ File::Spec->catdir($base, 't'), # remove
+ File::Spec->catdir($base, 'lib', 'File'), # cwd
+ ),
+ '',
+ '_moveto returns null as expected',
+ );
+}
# Change the current working directory into the first
# test directory and store the absolute path.
Added: branches/upstream/libfile-remove-perl/current/t/08_spaces.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-remove-perl/current/t/08_spaces.t?rev=71156&op=file
==============================================================================
--- branches/upstream/libfile-remove-perl/current/t/08_spaces.t (added)
+++ branches/upstream/libfile-remove-perl/current/t/08_spaces.t Fri Mar 11 13:24:15 2011
@@ -1,0 +1,87 @@
+#!/usr/bin/perl
+
+# Test that File::Remove (with or without globbing) supports the use of
+# spaces in the path to delete.
+
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
+use Test::More qw(no_plan);
+use File::Spec::Functions ':ALL';
+use File::Copy ();
+use File::Remove ();
+
+
+
+
+
+#####################################################################
+# Set up for the test
+
+my $t = catdir( curdir(), 't' );
+my $s = catdir( $t, 'spaced path' );
+my $f1 = catfile( $s, 'foo1.txt' );
+my $f2 = catfile( $s, 'foo2.txt' );
+my $f3 = catfile( $s, 'bar.txt' );
+
+sub create_directory {
+ mkdir($s,0777) or die "Failed to create $s";
+ ok( -d $s, "Created $s ok" );
+ ok( -r $s, "Created $s -r" );
+ ok( -w $s, "Created $s -w" );
+ open( FILE, ">$f1" ) or die "Failed to create $f1";
+ print FILE "Test\n";
+ close FILE;
+ open( FILE, ">$f2" ) or die "Failed to create $f2";
+ print FILE "Test\n";
+ close FILE;
+ open( FILE, ">$f3" ) or die "Failed to create $f3";
+ print FILE "Test\n";
+ close FILE;
+}
+
+sub clear_directory {
+ if ( -e $f1 ) {
+ unlink( $f1 ) or die "unlink: $f1 failed";
+ ! -e $f1 or die "unlink didn't work";
+ }
+ if ( -e $f2 ) {
+ unlink( $f2 ) or die "unlink: $f2 failed";
+ ! -e $f2 or die "unlink didn't work";
+ }
+ if ( -e $f3 ) {
+ unlink( $f3 ) or die "unlink: $f3 failed";
+ ! -e $f3 or die "unlink didn't work";
+ }
+ if ( -e $s ) {
+ rmdir( $s ) or die "rmdir: $s failed";
+ ! -e $s or die "rmdir didn't work";
+ }
+}
+
+# Make sure there is no directory from a previous run
+clear_directory();
+
+# Create the directory
+create_directory();
+
+# Schedule cleanup
+END {
+ clear_directory();
+}
+
+
+
+
+
+#####################################################################
+# Main Testing
+
+# Expand a glob that should match the foo files
+my @match = File::Remove::expand('t/spaced path/foo*');
+is( scalar(@match), 2, 'Found two results' );
+ok( $match[0] =~ /foo1.txt/, 'Found foo1' );
+ok( $match[1] =~ /foo2.txt/, 'Found foo2' );
Modified: branches/upstream/libfile-remove-perl/current/xt/pmv.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-remove-perl/current/xt/pmv.t?rev=71156&op=diff
==============================================================================
--- branches/upstream/libfile-remove-perl/current/xt/pmv.t (original)
+++ branches/upstream/libfile-remove-perl/current/xt/pmv.t Fri Mar 11 13:24:15 2011
@@ -9,7 +9,7 @@
}
my @MODULES = (
- 'Perl::MinimumVersion 1.25',
+ 'Perl::MinimumVersion 1.27',
'Test::MinimumVersion 0.101080',
);
More information about the Pkg-perl-cvs-commits
mailing list