r5738 - in /packages/libfile-remove-perl/branches/upstream/current: Changes MANIFEST META.yml Makefile.PL README lib/File/Remove.pm t/03_deep_readonly.t t/04_can_delete.t t/05_links.t t/99_author.t
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Wed Jul 11 15:15:56 UTC 2007
Author: eloy
Date: Wed Jul 11 15:15:56 2007
New Revision: 5738
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=5738
Log:
[svn-upgrade] Integrating new upstream version, libfile-remove-perl (0.37)
Added:
packages/libfile-remove-perl/branches/upstream/current/t/04_can_delete.t
packages/libfile-remove-perl/branches/upstream/current/t/05_links.t
Modified:
packages/libfile-remove-perl/branches/upstream/current/Changes
packages/libfile-remove-perl/branches/upstream/current/MANIFEST
packages/libfile-remove-perl/branches/upstream/current/META.yml
packages/libfile-remove-perl/branches/upstream/current/Makefile.PL
packages/libfile-remove-perl/branches/upstream/current/README
packages/libfile-remove-perl/branches/upstream/current/lib/File/Remove.pm
packages/libfile-remove-perl/branches/upstream/current/t/03_deep_readonly.t
packages/libfile-remove-perl/branches/upstream/current/t/99_author.t
Modified: packages/libfile-remove-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfile-remove-perl/branches/upstream/current/Changes?rev=5738&op=diff
==============================================================================
--- packages/libfile-remove-perl/branches/upstream/current/Changes (original)
+++ packages/libfile-remove-perl/branches/upstream/current/Changes Wed Jul 11 15:15:56 2007
@@ -1,77 +1,98 @@
Revision history for Perl extension File::Remove.
-0.34 Mon Nov 6 2006
- - Update t/03 to skip the "is this file not writable" test when
- it would fail because the tests are being run by root (as sometimes
- happens when installing Perl modules).
- --Jesse Vincent (jesse at bestpractical.com)
+0.37 Sun 8 Jul 2007 (Adam Kennedy)
+ - Restoring support for broken symlinks (Marek Rouchal)
+ - Adding tests for the broken symlink case (Marek Rouchal)
+ - Tidying up the Changes file a bit
+
+0.36 Fri 30 Jun 2007 (Adam Kennedy)
+ - Avoid the installation of Mac::Glue.
+ (It should not be necesary to test voice synthesis to delete a file)
+ - Anyone truly needing "trash" support will need to add a dependency
+ on Mac::Glue themself. The function may be split out of File::Remove
+ later down the track.
+ - Constanting the debugger flag for a minor speed and memory improvement
+ - Copy in a known-readonly flag for more accurate testing on Win32
+ - Remove assumption that -w implied deletion rights on Win32
+ - Validate that the file was actually deleted.
+ - Add better mode-handling for files.
+ - Add smarter implementation of "candelete" logic.
+
+0.35 Fri 9 Feb 2007 (Stephen Steneker)
+ - Update makefile to require Mac::Glue version compatible with Intel macs
+ - Change pod heading from "methods" to "subroutines" [RT#13687]
+ - No functional changes from 0.34
+
+0.34 Mon Nov 6 2006 (Jesse Vincent)
+ - Update t/03 to skip the "is this file not writable" test when
+ it would fail because the tests are being run by root (as sometimes
+ happens when installing Perl modules).
0.33 Tue 24 Oct 2006
- - Previous release tested ok.
- - Incrementing for production release.
- - No functional changes
+ - Previous release tested ok.
+ - Incrementing for production release.
+ - No functional changes
0.32_01 Mon 23 Oct 2006
- - Use File::Spec to clean/canon paths instead of hand-stripping trailing slash
- - Apply the File::Path "safe" check manually for the root only, and
- use File::Path itself with safe OFF, so that we can handle deleting
- deep readonly files (and do it properly on VMS)
- - Added a test for the deletion of deep readonly files
- - Removing the use of "our" variables to try and get the Perl version
- dependency back to at least 5.005.
- - Report "deleted" for non-existant files they want to delete
- - Report the path they pass, but for dir USE a File::Spec->canonpath
+ - Use File::Spec to clean/canon paths instead of hand-stripping trailing slash
+ - Apply the File::Path "safe" check manually for the root only, and
+ use File::Path itself with safe OFF, so that we can handle deleting
+ deep readonly files (and do it properly on VMS)
+ - Added a test for the deletion of deep readonly files
+ - Removing the use of "our" variables to try and get the Perl version
+ dependency back to at least 5.005.
+ - Report "deleted" for non-existant files they want to delete
+ - Report the path they pass, but for dir USE a File::Spec->canonpath
0.31 Wed Dec 28 17:40:00 2005
- - Applied Eric Hanchrow's patch to support filenames with spaces.
- - Skip recycle tests unless recycle/trash support is available.
+ - Applied Eric Hanchrow's patch to support filenames with spaces.
+ - Skip recycle tests unless recycle/trash support is available.
0.30 Wed Jul 14 19:12:00 2005
- - Applied CNANDOR's patch to fix trash() support on OS X 10.4.
+ - Applied CNANDOR's patch to fix trash() support on OS X 10.4.
0.29 Mon Dec 04 16:35:00 2004
- - Stabilize undelete support for OS X and Windows.
+ - Stabilize undelete support for OS X and Windows.
0.26 Mon Nov 16 07:31:00 2004
- - Fix the synopsis.
+ - Fix the synopsis.
0.25 Mon Nov 15 12:04:00 2004
- - Renamed undelete() to trash(), to be more clear.
- - Allow users to provide their own rmdir/unlink to trash().
- - Re-disabled debugging by default.
+ - Renamed undelete() to trash(), to be more clear.
+ - Allow users to provide their own rmdir/unlink to trash().
+ - Re-disabled debugging by default.
0.24 Mon Nov 15 11:32:00 2004
- - Add undelete support for OS X (via Mac::Glue).
- - Fix undelete overloading of unlink/rmdir and update tests.
- - Fix the documentation to be readable with perldoc.
+ - Add undelete support for OS X (via Mac::Glue).
+ - Fix undelete overloading of unlink/rmdir and update tests.
+ - Fix the documentation to be readable with perldoc.
0.23 Mon Nov 15 09:45:00 2004
- - Add undelete supportand tests (currently only for Win32, via
- Win32::FileOp).
+ - Add undelete supportand tests (currently only for Win32, via
+ Win32::FileOp).
0.22 Mon Nov 15 08:17:00 2004
- - Add the first set of tests.
+ - Add the first set of tests.
0.21 Tue Jul 20 10:17:00 2004
- - Converted the internals to File::Spec.
-
- - Maintenance transferred by modules at perl.org to Richard Soderberg.
- Please e-mail bug reports to <bug-File-Remove at rt.cpan.org>.
+ - Converted the internals to File::Spec.
+ - Maintenance transferred by modules at perl.org to Richard Soderberg.
+ Please e-mail bug reports to <bug-File-Remove at rt.cpan.org>.
0.20 Tue Apr 15 23:34:25 1998
- - Now you can pass a scalar reference as the first argument and it
- will used as the recursive flag when removing directories. With
- recursive flag set to 0 only the files in the directory are
- removed and no attempt is made to recurse into subdirectories.
- Nevertheless, if the directory becomes empty it is removed.
+ - Now you can pass a scalar reference as the first argument and it
+ will used as the recursive flag when removing directories. With
+ recursive flag set to 0 only the files in the directory are
+ removed and no attempt is made to recurse into subdirectories.
+ Nevertheless, if the directory becomes empty it is removed.
0.12 Tue Apr 14 15:50:56 1998
- - change the umask and set the permission on directories so we can
- remove the files
+ - change the umask and set the permission on directories so we can
+ remove the files
0.11 Mon Apr 13 16:37:30 1998
- - changed the return values to successes rather than failures since
- it makes more sense.
+ - changed the return values to successes rather than failures since
+ it makes more sense.
0.10 Fri Apr 10 22:32:13 EDT 1998
- - original version
+ - original version
Modified: packages/libfile-remove-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfile-remove-perl/branches/upstream/current/MANIFEST?rev=5738&op=diff
==============================================================================
--- packages/libfile-remove-perl/branches/upstream/current/MANIFEST (original)
+++ packages/libfile-remove-perl/branches/upstream/current/MANIFEST Wed Jul 11 15:15:56 2007
@@ -7,5 +7,7 @@
t/01_compile.t
t/02_directories.t
t/03_deep_readonly.t
+t/04_can_delete.t
+t/05_links.t
t/99_author.t
META.yml Module meta-data (added by MakeMaker)
Modified: packages/libfile-remove-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfile-remove-perl/branches/upstream/current/META.yml?rev=5738&op=diff
==============================================================================
--- packages/libfile-remove-perl/branches/upstream/current/META.yml (original)
+++ packages/libfile-remove-perl/branches/upstream/current/META.yml Wed Jul 11 15:15:56 2007
@@ -1,11 +1,12 @@
--- #YAML:1.0
name: File-Remove
-version: 0.34
+version: 0.37
abstract: Remove files and directories
license: ~
-generated_by: ExtUtils::MakeMaker version 6.31
+generated_by: ExtUtils::MakeMaker version 6.32
distribution_type: module
requires:
+ File::Copy: 0
File::Glob: 0
File::Path: 0
File::Spec: 0.84
Modified: packages/libfile-remove-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfile-remove-perl/branches/upstream/current/Makefile.PL?rev=5738&op=diff
==============================================================================
--- packages/libfile-remove-perl/branches/upstream/current/Makefile.PL (original)
+++ packages/libfile-remove-perl/branches/upstream/current/Makefile.PL Wed Jul 11 15:15:56 2007
@@ -1,3 +1,4 @@
+use strict;
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
@@ -5,17 +6,10 @@
NAME => 'File::Remove',
VERSION_FROM => 'lib/File/Remove.pm', # finds $VERSION
PREREQ_PM => {
- 'File::Spec' => 0.84,
+ 'File::Spec' => '0.84',
+ 'File::Copy' => 0,
'File::Path' => 0,
'File::Glob' => 0,
- # Win32::FileOp requires Win32::API
- # Win32::API is not working at time of writing.
- #($^O eq 'MSWin32' or $^O eq 'cygwin')
- # ? ('Win32::FileOp' => 0)
- # : (),
- ($^O eq 'darwin')
- ? ('Mac::Glue' => 0)
- : (),
}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/File/Remove.pm', # retrieve abstract from module
Modified: packages/libfile-remove-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfile-remove-perl/branches/upstream/current/README?rev=5738&op=diff
==============================================================================
--- packages/libfile-remove-perl/branches/upstream/current/README (original)
+++ packages/libfile-remove-perl/branches/upstream/current/README Wed Jul 11 15:15:56 2007
@@ -1,40 +1,79 @@
-File-Remove version 0.01
-========================
+NAME
+ File::Remove - Remove files and directories
-The README is used to introduce the module and provide instructions on
-how to install the module, any machine dependencies it may have (for
-example C compilers and installed libraries) and any other information
-that should be provided before the module is installed.
+SYNOPSIS
+ use File::Remove qw(remove);
-A README file is required for CPAN modules since CPAN extracts the
-README file from a module distribution so that people browsing the
-archive can use it get an idea of the modules uses. It is usually a
-good idea to provide version information here so that people can
-decide whether fixes for the module are worth downloading.
+ # removes (without recursion) several files
+ remove qw( *.c *.pl );
-INSTALLATION
+ # removes (with recursion) several directories
+ remove \1, qw( directory1 directory2 );
-To install this module type the following:
+ # removes (with recursion) several files and directories
+ remove \1, qw( file1 file2 directory1 *~ );
- perl Makefile.PL
- make
- make test
- make install
+ # trashes (with support for undeleting later) several files
+ trash qw( *~ );
-DEPENDENCIES
+DESCRIPTION
+ File::Remove::remove removes files and directories. It acts like
+ /bin/rm, for the most part. Although "unlink" can be given a list of
+ files, it will not remove directories; this module remedies that. It
+ also accepts wildcards, * and ?, as arguments for filenames.
-This module requires these other modules and libraries:
+ File::Remove::trash accepts the same arguments as remove, with the
+ addition of an optional, infrequently used "other platforms" hashref.
- blah blah blah
+SUBROUTINES
+ remove
+ Removes files and directories. Directories are removed recursively
+ like in rm -rf if the first argument is a reference to a scalar that
+ evaluates to true. If the first arguemnt is a reference to a scalar
+ then it is used as the value of the recursive flag. By default it's
+ false so only pass \1 to it.
-COPYRIGHT AND LICENCE
+ In list context it returns a list of files/directories removed, in
+ scalar context it returns the number of files/directories removed.
+ The list/number should match what was passed in if everything went
+ well.
-Put the correct copyright and licence information here.
+ rm Just calls remove. It's there for people who get tired of typing
+ remove.
-Copyright (C) 2004 by Richard Soderberg
+ trash
+ Removes files and directories, with support for undeleting later.
+ Accepts an optional "other platforms" hashref, passing the remaining
+ arguments to remove.
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself, either Perl version 5.8.3 or,
-at your option, any later version of Perl 5 you may have available.
+ Win32
+ Requires Win32::FileOp.
+ Installation not actually enforced on Win32 yet, since
+ Win32::FileOp has badly failing dependencies at time of writing.
+ OS X
+ Requires Mac::Glue.
+
+ Other platforms
+ The first argument to trash() must be a hashref with two keys,
+ 'rmdir' and 'unlink', each referencing a coderef. The coderefs
+ will be called with the filenames that are to be deleted.
+
+BUGS
+ See http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Remove for the
+ up-to-date bug listing.
+
+AUTHOR
+ Taken over by Adam Kennedy <adamk at cpan.org>, to fix the "deep readonly
+ files" bug, and do some more cleaning up.
+
+ Taken over by Richard Soderberg <perl at crystalflame.net>, so as to port
+ it to File::Spec and add tests.
+
+ Original copyright: (c) 1998 by Gabor Egressy, <gabor at vmunix.com>.
+
+ All rights reserved. All wrongs reversed. This program is free software;
+ you can redistribute and/or modify it under the same terms as Perl
+ itself.
+
Modified: packages/libfile-remove-perl/branches/upstream/current/lib/File/Remove.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfile-remove-perl/branches/upstream/current/lib/File/Remove.pm?rev=5738&op=diff
==============================================================================
--- packages/libfile-remove-perl/branches/upstream/current/lib/File/Remove.pm (original)
+++ packages/libfile-remove-perl/branches/upstream/current/lib/File/Remove.pm Wed Jul 11 15:15:56 2007
@@ -3,9 +3,12 @@
use strict;
use vars qw(@EXPORT_OK @ISA $VERSION $debug $unlink $rmdir);
BEGIN {
- $VERSION = '0.34';
+ $VERSION = '0.37';
@ISA = qw(Exporter);
@EXPORT_OK = qw(remove rm trash); # nothing by default :)
+
+ # Booleanise the debug flag
+ $debug = !! $debug;
}
# If we ever need a Mac::Glue object,
@@ -14,15 +17,23 @@
use File::Spec ();
use File::Path ();
-use File::Glob qw(bsd_glob);
+use File::Glob ();
sub expand (@) {
map { File::Glob::bsd_glob($_) } @_;
}
+# $debug variable must be set before loading File::Remove.
+# Convert to a constant to allow debugging code to be pruned out.
+use constant DEBUG => $debug;
+
# Are we on VMS?
# If so copy File::Path and assume VMS::Filespec is loaded
-use constant IS_VMS => $^O eq 'VMS';
+use constant IS_VMS => $^O eq 'VMS';
+
+# Are we on Win32?
+# If so write permissions does not imply deletion permissions
+use constant IS_WIN32 => $^O eq 'MSWin32';
@@ -41,27 +52,66 @@
# Iterate over the files
my @removes;
foreach my $path ( @files ) {
+ # need to check for symlink first
+ # could be pointing to nonexisting/non-readable destination
+ if ( -l $path ) {
+ print "link: $path\n" if $debug;
+ if ( $unlink ? $unlink->($path) : unlink($path) ) {
+ push @removes, $path;
+ }
+ next;
+ }
unless ( -e $path ) {
- print "missing: $path\n" if $debug;
+ print "missing: $path\n" if DEBUG;
push @removes, $path; # Say we deleted it
next;
}
- unless ( IS_VMS ? VMS::Filespec::candelete($path) : -w $path ) {
- print "nowrite: $path\n" if $debug;
+ my $can_delete;
+ if ( IS_VMS ) {
+ $can_delete = VMS::Filespec::candelete($path);
+ } elsif ( IS_WIN32 ) {
+ # Assume we can delete it for the moment
+ $can_delete = 1;
+ } elsif ( -w $path ) {
+ # We have write permissions already
+ $can_delete = 1;
+ } elsif ( $< == 0 ) {
+ # Unixy and root
+ $can_delete = 1;
+ } elsif ( (lstat($path))[4] == $< ) {
+ # I own the file
+ $can_delete = 1;
+ } else {
+ # I don't think we can delete it
+ $can_delete = 0;
+ }
+ unless ( $can_delete ) {
+ print "nowrite: $path\n" if DEBUG;
next;
}
- if ( -f $path or -l $path ) {
- print "file: $path\n" if $debug;
+ if ( -f $path ) {
+ print "file: $path\n" if DEBUG;
+ unless ( -w $path ) {
+ # Make the file writable (implementation from File::Path)
+ (undef, undef, my $rp) = lstat $path or next;
+ $rp &= 07777; # Don't forget setuid, setgid, sticky bits
+ $rp |= 0600; # Turn on user read/write
+ chmod $rp, $path;
+ }
if ( $unlink ? $unlink->($path) : unlink($path) ) {
+ # Failed to delete the file
+ next if -e $path;
push @removes, $path;
}
} elsif ( -d $path ) {
- print "dir: $path\n" if $debug;
+ print "dir: $path\n" if DEBUG;
my $dir = File::Spec->canonpath( $path );
if ( $$recursive ) {
- if ( File::Path::rmtree( [ $dir ], $debug, 0 ) ) {
+ if ( File::Path::rmtree( [ $dir ], DEBUG, 0 ) ) {
+ # Failed to delete the directory
+ next if -e $path;
push @removes, $path;
}
@@ -69,12 +119,14 @@
my ($save_mode) = (stat $dir)[2];
chmod $save_mode & 0777, $dir; # just in case we cannot remove it.
if ( $rmdir ? $rmdir->($dir) : rmdir($dir) ) {
+ # Failed to delete the directory
+ next if -e $path;
push @removes, $path;
}
}
} else {
- print "???: $path\n" if $debug;
+ print "???: $path\n" if DEBUG;
}
}
@@ -159,7 +211,7 @@
the addition of an optional, infrequently used "other platforms"
hashref.
-=head1 METHODS
+=head1 SUBROUTINES
=over 4
Modified: packages/libfile-remove-perl/branches/upstream/current/t/03_deep_readonly.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfile-remove-perl/branches/upstream/current/t/03_deep_readonly.t?rev=5738&op=diff
==============================================================================
--- packages/libfile-remove-perl/branches/upstream/current/t/03_deep_readonly.t (original)
+++ packages/libfile-remove-perl/branches/upstream/current/t/03_deep_readonly.t Wed Jul 11 15:15:56 2007
@@ -10,6 +10,7 @@
use Test::More qw(no_plan);
use File::Spec ();
+use File::Copy ();
use_ok( 'File::Remove' );
@@ -34,19 +35,16 @@
ok( -d $d2, "Created $d2 ok" );
ok( -r $d2, "Created $d2 -r" );
ok( -w $d2, "Created $d2 -w" );
- local *FILE;
- open( FILE, ">$f3" ) or die "open: $f3 failed";
- print FILE "This is a test file" or die "print: $f3 failed";
- close( FILE ) or die "close: $f3 failed";
- ok( -f $f3, "Created $f3 ok" );
- ok( -r $f3, "Created $f3 -r" );
- ok( -w $f3, "Created $f3 -w" );
- chmod( 0400, $f3 ) or die "chmod 0400 $f3 failed";
+ # Copy in a known-readonly file (in this case, the File::Spec lib we are using
+ File::Copy::copy( $INC{'File/Spec.pm'} => $f3 );
+ chmod( 0400, $f3 );
ok( -f $f3, "Created $f3 ok" );
ok( -r $f3, "Created $f3 -r" );
SKIP: {
- skip "This test doesn't work as root", 1 if($< == 0 );
- ok( ! -w $f3, "Created $f3 -w" );
+ if ( $^O ne 'MSWin32' and $< == 0 ) {
+ skip("This test doesn't work as root", 1);
+ }
+ ok( ! -w $f3, "Created $f3 ! -w" );
};
}
Added: packages/libfile-remove-perl/branches/upstream/current/t/04_can_delete.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfile-remove-perl/branches/upstream/current/t/04_can_delete.t?rev=5738&op=file
==============================================================================
--- packages/libfile-remove-perl/branches/upstream/current/t/04_can_delete.t (added)
+++ packages/libfile-remove-perl/branches/upstream/current/t/04_can_delete.t Wed Jul 11 15:15:56 2007
@@ -1,0 +1,87 @@
+#!/usr/bin/perl
+
+# Test that File::Remove can recursively remove a directory that
+# deeply contains a readonly file that is owned by the current user.
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
+use Test::More qw(no_plan);
+use File::Spec ();
+use File::Copy ();
+use_ok( 'File::Remove' );
+
+
+
+
+
+#####################################################################
+# Set up for the test
+
+my $in = File::Spec->catdir( File::Spec->curdir, 't' );
+ok( -d $in, 'Found t dir' );
+my $d1 = File::Spec->catdir( $in, 'd1' );
+my $d2 = File::Spec->catdir( $d1, 'd2' );
+my $f3 = File::Spec->catfile( $d2, 'f3.txt' );
+
+sub create_directory {
+ mkdir $d1 or die "Failed to create $d1";
+ ok( -d $d1, "Created $d1 ok" );
+ ok( -r $d1, "Created $d1 -r" );
+ ok( -w $d1, "Created $d1 -w" );
+ mkdir $d2 or die "Failed to create $d2";
+ ok( -d $d2, "Created $d2 ok" );
+ ok( -r $d2, "Created $d2 -r" );
+ ok( -w $d2, "Created $d2 -w" );
+ # Copy in a known-readonly file (in this case, the File::Spec lib we are using
+ File::Copy::copy( $INC{'File/Spec.pm'} => $f3 );
+ 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" );
+ };
+}
+
+sub clear_directory {
+ if ( -e $f3 ) {
+ chmod( 0700, $f3 ) or die "chmod 0700 $f3 failed";
+ unlink( $f3 ) or die "unlink: $f3 failed";
+ ! -e $f3 or die "unlink didn't work";
+ }
+ if ( -e $d2 ) {
+ rmdir( $d2 ) or die "rmdir: $d2 failed";
+ ! -e $d2 or die "rmdir didn't work";
+ }
+ if ( -e $d1 ) {
+ rmdir( $d1 ) or die "rmdir: $d1 failed";
+ ! -e $d1 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
+
+# Call a recursive remove of the directory, nothing should be left after
+is_deeply( [ File::Remove::remove( $f3 ) ], [ $f3 ], "remove('$f3') ok" );
+ok( ! -e $f3, "Removed the file ok" );
Added: packages/libfile-remove-perl/branches/upstream/current/t/05_links.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfile-remove-perl/branches/upstream/current/t/05_links.t?rev=5738&op=file
==============================================================================
--- packages/libfile-remove-perl/branches/upstream/current/t/05_links.t (added)
+++ packages/libfile-remove-perl/branches/upstream/current/t/05_links.t Wed Jul 11 15:15:56 2007
@@ -1,0 +1,66 @@
+#!/usr/bin/perl
+
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
+use Test::More; # tests => 3;
+use File::Spec::Functions ':ALL';
+use File::Remove ();
+
+unless( eval { symlink("",""); 1 } ) {
+ plan("skip_all" => "Operating system does not support Unix-like symlinks");
+ exit(0);
+}
+
+plan( tests => 8 );
+
+# Set up the tests
+my $testdir = catdir( 't', 'linktest' );
+if ( -d $testdir ) {
+ File::Remove::remove( \1, $testdir );
+ die "Failed to clear test directory '$testdir'" if -d $testdir;
+}
+ok( ! -d $testdir, 'Cleared testdir' );
+unless( mkdir($testdir, 0777) ) {
+ die("Cannot create test directory '$testdir': $!");
+}
+ok( -d $testdir, 'Created testdir' );
+my %links = (
+ l_ex => curdir(),
+ l_ex_a => rootdir(),
+ l_nex => 'does_not_exist'
+);
+my $errs = 0;
+foreach my $link (keys %links) {
+ my $path = catdir( $testdir, $link );
+ unless( symlink($links{$link}, $path )) {
+ diag("Cannot create symlink $link -> $links{$link}: $!");
+ $errs++;
+ }
+}
+if ( $errs ) {
+ die("Could not create test links");
+}
+
+ok( File::Remove::remove(\1, map { catdir($testdir, $_) } keys %links), "remove \\1: all links" );
+
+my @entries;
+
+ok( opendir(DIR, $testdir) );
+foreach my $dir ( readdir(DIR) ) {
+ next if $dir eq curdir();
+ next if $dir eq updir();
+ push @entries, $dir;
+}
+ok( closedir(DIR) );
+
+ok( @entries == 0, "no links remained in directory; found @entries" );
+
+ok( File::Remove::remove(\1, $testdir), "remove \\1: $testdir" );
+
+ok( ! -e $testdir, "!-e: $testdir" );
+
+1;
Modified: packages/libfile-remove-perl/branches/upstream/current/t/99_author.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfile-remove-perl/branches/upstream/current/t/99_author.t?rev=5738&op=diff
==============================================================================
--- packages/libfile-remove-perl/branches/upstream/current/t/99_author.t (original)
+++ packages/libfile-remove-perl/branches/upstream/current/t/99_author.t Wed Jul 11 15:15:56 2007
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
use strict;
BEGIN {
More information about the Pkg-perl-cvs-commits
mailing list