summaryrefslogtreecommitdiff
path: root/lib/File/Path.pm
diff options
context:
space:
mode:
authorPerl 5 Porters <perl5-porters@africa.nicoh.com>1997-04-17 00:00:00 +0000
committerChip Salzenberg <chip@atlantic.net>1997-04-17 00:00:00 +0000
commit96e4d5b14cf2dfb0235faa8bc3f701c15b15bb05 (patch)
tree573ae82e0e6a92c453a5b5cec1b10dc2f99362fe /lib/File/Path.pm
parent6877a1cf6ff3f0f711772ea75e579e2e7219cc46 (diff)
downloadperl-96e4d5b14cf2dfb0235faa8bc3f701c15b15bb05.tar.gz
[inseparable changes from match from perl-5.003_97e to perl-5.003_97f]
CORE LANGUAGE CHANGES Subject: New operator systell() From: Chip Salzenberg <chip@perl.com> Files: doio.c ext/Opcode/Opcode.pm keywords.pl opcode.pl pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod pp_sys.c t/op/sysio.t toke.c Subject: Allow constant sub to be optimized when called with parens From: Chip Salzenberg <chip@perl.com> Files: toke.c Subject: Make {,un}pack fail on invalid pack types From: Chip Salzenberg <chip@perl.com> Files: pod/perldiag.pod pp.c CORE PORTABILITY Subject: Fix bitwise ops and {,un}pack() on Cray CPUs From: Chip Salzenberg <chip@perl.com> Files: pp.c Subject: VMS update From: Charles Bailey <bailey@hmivax.humgen.upenn.edu> Files: lib/Cwd.pm lib/File/Path.pm lib/FindBin.pm vms/perly_c.vms vms/vms.c vms/writemain.pl Subject: Win32 update (three patches) From: Gurusamy Sarathy <gsar@engin.umich.edu> Files: lib/Cwd.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_Win32.pm lib/File/Basename.pm win32/Makefile win32/makedef.pl win32/perllib.c win32/win32.c win32/win32iop.h DOCUMENTATION Subject: Document size restrictions for packed integers From: Jarkko Hietaniemi <Jarkko.Hietaniemi@cc.hut.fi> Files: pod/perlfunc.pod LIBRARY AND EXTENSIONS Subject: Fix bug in Opcode when (maxo & 15) > 8 From: Chip Salzenberg <chip@perl.com> Files: ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm ext/Opcode/Opcode.xs
Diffstat (limited to 'lib/File/Path.pm')
-rw-r--r--lib/File/Path.pm51
1 files changed, 39 insertions, 12 deletions
diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index e086028300..419bd03adf 100644
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -69,21 +69,30 @@ skip any files to which you do not have delete access
(if running under VMS) or write access (if running
under another OS). This will change in the future when
a criterion for 'delete permission' under OSs other
-than VMS is settled. (defaults to FALSE)
+than VMS is settled. (defaults to FALSE)
=back
-It returns the number of files successfully deleted. Symlinks are
+It returns the number of files successfully deleted. Symlinks are
treated as ordinary files.
+B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
+in the face of failure or interruption. Files and directories which
+were not deleted may be left with permissions reset to allow world
+read and write access. Note also that the occurrence of errors in
+rmtree can be determined I<only> by trapping diagnostic messages
+using C<$SIG{__WARN__}>; it is not apparent from the return value.
+Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0>
+in situations where security is an issue.
+
=head1 AUTHORS
-Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt>
-Charles Bailey E<lt>F<bailey@genetics.upenn.edu>E<gt>
+Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
+Charles Bailey <F<bailey@genetics.upenn.edu>>
=head1 REVISION
-Current $VERSION is 1.02.
+Current $VERSION is 1.03.
=cut
@@ -94,7 +103,7 @@ use Exporter ();
use strict;
use vars qw( $VERSION @ISA @EXPORT );
-$VERSION = "1.02";
+$VERSION = "1.03";
@ISA = qw( Exporter );
@EXPORT = qw( mkpath rmtree );
@@ -138,13 +147,14 @@ sub rmtree {
my($root);
foreach $root (@{$roots}) {
$root =~ s#/$##;
- $count++, next unless -e $root;
+ next unless -e $root;
if (not -l $root and -d _) {
# notabene: 0777 is for making readable in the first place,
# it's also intended to change it to writable in case we have
# to recurse in which case we are better than rm -rf for
# subtrees with strange permissions
- chmod 0777, $root
+ my $rp = (stat(_))[2] & 0777; #Is this portable???
+ chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
or carp "Can't make directory $root read+writeable: $!"
unless $safe;
@@ -168,8 +178,15 @@ sub rmtree {
or carp "Can't make directory $root writeable: $!"
if $force_writeable;
print "rmdir $root\n" if $verbose;
- rmdir($root) && ++$count
- or carp "Can't remove directory $root: $!";
+ if (rmdir $root) {
+ ++$count;
+ }
+ else {
+ carp "Can't remove directory $root: $!";
+ chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+ or carp("and can't restore permissions to "
+ . sprintf("0%o",$rp) . "\n");
+ }
}
else {
if ($safe &&
@@ -177,14 +194,24 @@ sub rmtree {
print "skipped $root\n" if $verbose;
next;
}
+ my $rp = (stat(_))[2] & 0777; #Is this portable???
chmod 0666, $root
or carp "Can't make file $root writeable: $!"
if $force_writeable;
print "unlink $root\n" if $verbose;
# delete all versions under VMS
while (-e $root || -l $root) {
- unlink($root) && ++$count
- or croak "Can't unlink file $root: $!";
+ if (unlink $root) {
+ ++$count;
+ }
+ else {
+ carp "Can't unlink file $root: $!";
+ if ($force_writeable) {
+ chmod $rp, $root
+ or carp("and can't restore permissions to "
+ . sprintf("0%o",$rp) . "\n");
+ }
+ }
}
}
}