r846 - in packages: . libfile-remove-perl libfile-remove-perl/branches libfile-remove-perl/branches/upstream libfile-remove-perl/branches/upstream/current libfile-remove-perl/branches/upstream/current/lib libfile-remove-perl/branches/upstream/current/lib/File libfile-remove-perl/branches/upstream/current/t
Gunnar Wolf
gwolf@costa.debian.org
Wed, 30 Mar 2005 18:50:53 +0000
Author: gwolf
Date: 2005-03-30 18:50:52 +0000 (Wed, 30 Mar 2005)
New Revision: 846
Added:
packages/libfile-remove-perl/
packages/libfile-remove-perl/branches/
packages/libfile-remove-perl/branches/upstream/
packages/libfile-remove-perl/branches/upstream/current/
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/
packages/libfile-remove-perl/branches/upstream/current/lib/File/
packages/libfile-remove-perl/branches/upstream/current/lib/File/Remove.pm
packages/libfile-remove-perl/branches/upstream/current/t/
packages/libfile-remove-perl/branches/upstream/current/t/0_use.t
packages/libfile-remove-perl/branches/upstream/current/t/1_directories.t
packages/libfile-remove-perl/tags/
Log:
[svn-inject] Installing original source of libfile-remove-perl
Added: packages/libfile-remove-perl/branches/upstream/current/Changes
===================================================================
--- packages/libfile-remove-perl/branches/upstream/current/Changes 2005-03-30 18:45:09 UTC (rev 845)
+++ packages/libfile-remove-perl/branches/upstream/current/Changes 2005-03-30 18:50:52 UTC (rev 846)
@@ -0,0 +1,48 @@
+Revision history for Perl extension File::Remove.
+
+0.29 Mon Dec 04 16:35:00 2004
+ - Stabilize undelete support for OS X and Windows.
+
+0.26 Mon Nov 16 07:31:00 2004
+ - 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.
+
+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.
+
+0.23 Mon Nov 15 09:45:00 2004
+ - 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.
+
+0.21 Tue Jul 20 10:17:00 2004
+ - Converted the internals to File::Spec.
+
+ - Maintenance transferred by modules@perl.org to Richard Soderberg.
+ Please e-mail bug reports to <bug-File-Remove@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.
+
+0.12 Tue Apr 14 15:50:56 1998
+ - 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.
+
+0.10 Fri Apr 10 22:32:13 EDT 1998
+ - original version
Added: packages/libfile-remove-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libfile-remove-perl/branches/upstream/current/MANIFEST 2005-03-30 18:45:09 UTC (rev 845)
+++ packages/libfile-remove-perl/branches/upstream/current/MANIFEST 2005-03-30 18:50:52 UTC (rev 846)
@@ -0,0 +1,8 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/File/Remove.pm
+META.yml Module meta-data (added by MakeMaker)
+t/0_use.t
+t/1_directories.t
Added: packages/libfile-remove-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libfile-remove-perl/branches/upstream/current/META.yml 2005-03-30 18:45:09 UTC (rev 845)
+++ packages/libfile-remove-perl/branches/upstream/current/META.yml 2005-03-30 18:50:52 UTC (rev 846)
@@ -0,0 +1,10 @@
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: File-Remove
+version: 0.29
+version_from: lib/File/Remove.pm
+installdirs: site
+requires:
+ File::Spec: 0.84
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.12
Added: packages/libfile-remove-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libfile-remove-perl/branches/upstream/current/Makefile.PL 2005-03-30 18:45:09 UTC (rev 845)
+++ packages/libfile-remove-perl/branches/upstream/current/Makefile.PL 2005-03-30 18:50:52 UTC (rev 846)
@@ -0,0 +1,13 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'File::Remove',
+ VERSION_FROM => 'lib/File/Remove.pm', # finds $VERSION
+ PREREQ_PM => {
+ 'File::Spec' => 0.84,
+ }, # 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
+ AUTHOR => 'Richard Soderberg <rs@localdomain>') : ()),
+);
Added: packages/libfile-remove-perl/branches/upstream/current/README
===================================================================
--- packages/libfile-remove-perl/branches/upstream/current/README 2005-03-30 18:45:09 UTC (rev 845)
+++ packages/libfile-remove-perl/branches/upstream/current/README 2005-03-30 18:50:52 UTC (rev 846)
@@ -0,0 +1,40 @@
+File-Remove version 0.01
+========================
+
+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.
+
+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.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2004 by Richard Soderberg
+
+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.
+
+
Added: packages/libfile-remove-perl/branches/upstream/current/lib/File/Remove.pm
===================================================================
--- packages/libfile-remove-perl/branches/upstream/current/lib/File/Remove.pm 2005-03-30 18:45:09 UTC (rev 845)
+++ packages/libfile-remove-perl/branches/upstream/current/lib/File/Remove.pm 2005-03-30 18:50:52 UTC (rev 846)
@@ -0,0 +1,197 @@
+package File::Remove;
+
+=head1 NAME
+
+File::Remove - Remove files and directories
+
+=head1 SYNOPSIS
+
+ use File::Remove qw(remove);
+
+ # removes (without recursion) several files
+ remove qw( *.c *.pl );
+
+ # removes (with recursion) several directories
+ remove \1, qw( directory1 directory2 );
+
+ # removes (with recursion) several files and directories
+ remove \1, qw( file1 file2 directory1 *~ );
+
+ # trashes (with support for undeleting later) several files
+ trash qw( *~ );
+
+=head1 DESCRIPTION
+
+B<File::Remove::remove> removes files and directories. It acts like
+B</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.
+
+B<File::Remove::trash> accepts the same arguments as B<remove>, with
+the addition of an optional, infrequently used "other platforms"
+hashref.
+
+=head1 METHODS
+
+=over 4
+
+=item remove
+
+Removes files and directories. Directories are removed recursively like
+in B<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.
+
+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.
+
+=item rm
+
+Just calls B<remove>. It's there for people who get tired of typing
+B<remove>.
+
+=item trash
+
+Removes files and directories, with support for undeleting later.
+Accepts an optional "other platforms" hashref, passing the remaining
+arguments to B<remove>.
+
+=over 4
+
+=item Win32
+
+Requires L<Win32::FileOp>.
+
+=item OS X
+
+Requires L<Mac::Glue>.
+
+=item 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.
+
+=back
+
+=back
+
+=head1 BUGS
+
+See http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Remove for the
+up-to-date bug listing.
+
+=head1 AUTHOR
+
+Taken over by Richard Soderberg, E<lt>perl@crystalflame.netE<gt>, so as
+to port it to L<File::Spec> and add tests.
+
+Original copyright: (c) 1998 by Gabor Egressy, E<lt>gabor@vmunix.comE<gt>.
+
+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.
+
+=cut
+
+use strict;
+use vars qw(@EXPORT_OK @ISA $VERSION $debug $unlink $rmdir);
+@ISA = qw(Exporter);
+# we export nothing by default :)
+@EXPORT_OK = qw(remove rm trash);
+
+use File::Spec;
+use File::Path qw(rmtree);
+
+$VERSION = '0.29';
+
+sub expand (@)
+{
+ my @args;
+
+ for (@_) {
+ push @args, glob;
+ }
+ @args;
+}
+
+# acts like unlink would until given a directory as an argument, then
+# it acts like rm -rf ;) unless the recursive arg is zero which it is by
+# default
+sub remove (@)
+{
+ my $recursive;
+ if(ref $_[0] eq 'SCALAR') {
+ $recursive = shift;
+ }
+ else {
+ $recursive = \0;
+ }
+ my @files = expand @_;
+ my @removes;
+
+ my $ret;
+ for (@files) {
+ print "file: $_\n" if $debug;
+ if(-f $_ || -l $_) {
+ print "file unlink: $_\n" if $debug;
+ my $result = $unlink ? $unlink->($_) : unlink($_);
+ push(@removes, $_) if $result;
+ }
+ elsif(-d $_) {
+ print "dir: $_\n" if $debug;
+ # XXX: this regex seems unnecessary, and may trigger bugs someday.
+ # TODO: but better to trim trailing slashes for now.
+ s/\/$//;
+ if ($$recursive) {
+ my $result = rmtree([$_], $debug, 1);
+ push(@removes, $_) if $result;
+ } else {
+ my ($save_mode) = (stat $_)[2];
+ chmod $save_mode & 0777,$_; # just in case we cannot remove it.
+ my $result = $rmdir ? $rmdir->($_) : rmdir($_);
+ push(@removes, $_) if $result;
+ }
+ } else {
+ print "???: $_\n" if $debug;
+ }
+ }
+
+ @removes;
+}
+
+sub rm (@) { goto &remove }
+
+sub trash (@) {
+ our $unlink = $unlink;
+ our $rmdir = $rmdir;
+ if (ref($_[0]) eq 'HASH') {
+ my %options = %{+shift @_};
+ $unlink = $options{'unlink'};
+ $rmdir = $options{'rmdir'};
+ } elsif ($^O eq 'cygwin' || $^O =~ /^MSWin/) {
+ eval 'use Win32::FileOp ();';
+ die "Can't load Win32::FileOp to support the Recycle Bin: \$@ = $@" if length $@;
+ $unlink = \&Win32::FileOp::Recycle;
+ $rmdir = \&Win32::FileOp::Recycle;
+ } elsif ($^O eq 'darwin') {
+ our $f;
+ eval 'use Mac::Glue ();';
+ die "Can't load Mac::Glue::Finder to support the Trash Can: \$@ = $@" if length $@;
+ my $code = sub {
+ my $f = Mac::Glue->new("Finder");
+ my @files = map { s{^:}{}; $_ } map { s{/}{:}g; $_ } map { File::Spec->rel2abs($_) } @_;
+ $f->delete(@files);
+ };
+ $unlink = $code;
+ $rmdir = $code;
+ } else {
+ die "Support for trash() on platform '$^O' not available at this time.\n";
+ }
+ goto &remove;
+}
+
+sub undelete (@) { goto &trash }
+
+1;
Added: packages/libfile-remove-perl/branches/upstream/current/t/0_use.t
===================================================================
--- packages/libfile-remove-perl/branches/upstream/current/t/0_use.t 2005-03-30 18:45:09 UTC (rev 845)
+++ packages/libfile-remove-perl/branches/upstream/current/t/0_use.t 2005-03-30 18:50:52 UTC (rev 846)
@@ -0,0 +1,16 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl File-Remove.t'
+
+#########################
+
+# change 'tests => 2' to 'tests => last_test_to_print';
+
+use Test::More tests => 1;
+BEGIN { use_ok('File::Remove') };
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
+1;
Added: packages/libfile-remove-perl/branches/upstream/current/t/1_directories.t
===================================================================
--- packages/libfile-remove-perl/branches/upstream/current/t/1_directories.t 2005-03-30 18:45:09 UTC (rev 845)
+++ packages/libfile-remove-perl/branches/upstream/current/t/1_directories.t 2005-03-30 18:50:52 UTC (rev 846)
@@ -0,0 +1,189 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl File-Remove.t'
+
+#########################
+
+# change 'tests => 2' to 'tests => last_test_to_print';
+
+use Test::More qw(no_plan); # tests => 2;
+BEGIN { use_ok('File::Remove' => qw(remove trash)) };
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
+my @dirs = ("$0.tmp", map { "$0.tmp/$_" } qw(a a/b c c/d e e/f g));
+
+for my $path (reverse @dirs) {
+ if (-e $path) {
+ ok rmdir($path),
+ "rmdir: $path";
+ ok !-e $path,
+ "!-e: $path";
+ }
+}
+
+for my $path (@dirs) {
+ ok !-e $path,
+ "!-e: $path";
+ ok mkdir($path),
+ "mkdir: $path";
+ ok -e $path,
+ "-e: $path";
+}
+
+for my $path (reverse @dirs) {
+ ok -e $path,
+ "-e: $path";
+ ok rmdir($path),
+ "rmdir: $path";
+ ok !-e $path,
+ "!-e: $path";
+}
+
+for my $path (@dirs) {
+ ok !-e $path,
+ "!-e: $path";
+ ok mkdir($path),
+ "mkdir: $path";
+ ok -e $path,
+ "-e: $path";
+}
+
+for my $path (reverse @dirs) {
+ ok -e $path,
+ "-e: $path";
+ ok remove(\1, $path),
+ "remove \\1: $path";
+ ok !-e $path,
+ "!-e: $path";
+}
+
+for my $path (@dirs) {
+ ok !-e $path,
+ "!-e: $path";
+ ok mkdir($path),
+ "mkdir: $path";
+ ok -e $path,
+ "-e: $path";
+}
+
+for my $path (reverse @dirs) {
+ ok -e $path,
+ "-e: $path";
+ ok remove($path),
+ "remove: $path";
+ ok !-e $path,
+ "!-e: $path";
+}
+
+for my $path (reverse @dirs) {
+ ok !-e $path,
+ "-e: $path";
+ if (-e _) {
+ ok rmdir($path),
+ "rmdir: $path";
+ ok !-e $path,
+ "!-e: $path";
+ }
+}
+
+TODO: {
+ local $TODO;
+ if ($^O eq 'darwin') {
+ eval 'use Mac::Glue;';
+ $TODO = "Undelete support requires Mac::Glue" if length $@;
+ } elsif ($^O eq 'cygwin' || $^O =~ /^MSWin/) {
+ eval 'use Win32::FileOp::Recycle;';
+ $TODO = "Undelete support requires Win32::FileOp::Recycle" if length $@;
+ } else {
+ $TODO = "Undelete support not available by default";
+ }
+
+ for my $path (@dirs) {
+ ok !-e $path,
+ "!-e: $path";
+ ok mkdir($path),
+ "mkdir: $path";
+ ok -e $path,
+ "-e: $path";
+ }
+
+ for my $path (reverse @dirs) {
+ ok -e $path,
+ "-e: $path";
+ ok eval { trash($path) },
+ "trash: $path";
+ is $@, '',
+ "trash: \$@";
+ ok !-e $path,
+ "!-e: $path";
+ }
+
+ for my $path (reverse @dirs) {
+ ok !-e $path,
+ "-e: $path";
+ if (-e _) {
+ ok rmdir($path),
+ "rmdir: $path";
+ ok !-e $path,
+ "!-e: $path";
+ }
+ }
+
+ for my $path (@dirs) {
+ ok !-e $path,
+ "!-e: $path";
+ ok mkdir($path),
+ "mkdir: $path";
+ ok -e $path,
+ "-e: $path";
+ }
+
+ for my $path (reverse @dirs) {
+ ok -e $path,
+ "-e: $path";
+ ok remove($path),
+ "remove: $path";
+ ok !-e $path,
+ "!-e: $path";
+ }
+
+ for my $path (reverse @dirs) {
+ ok !-e $path,
+ "-e: $path";
+ if (-e _) {
+ ok rmdir($path),
+ "rmdir: $path";
+ ok !-e $path,
+ "!-e: $path";
+ }
+ }
+
+ for my $path (@dirs) {
+ ok !-e $path,
+ "!-e: $path";
+ ok mkdir($path),
+ "mkdir: $path";
+ ok -e $path,
+ "-e: $path";
+ }
+
+ for my $path (reverse @dirs) {
+ ok -e $path,
+ "-e: $path";
+ ok eval { trash({ 'rmdir' => sub { 1 }, 'unlink' => sub { 1 } }, $path) },
+ "trash: $path";
+ ok -e $path,
+ "-e: $path";
+ ok rmdir($path),
+ "rmdir: $path";
+ ok !-e $path,
+ "!-e: $path";
+ }
+
+ UNDELETE: 1;
+}
+
+1;