lib/File/Path.pm

   1 package File::Mkpath;
   2
   3 =head1 NAME
   4
   5 File::Mkpath - create or remove a series of directories
   6
   7 =head1 SYNOPSIS
   8
   9 C<use File::Mkpath>
  10
  11 C<mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);>
  12
  13 C<rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);>
  14
  15 =head1 DESCRIPTION
  16
  17 The C<mkpath> function provides a convenient way to create directories, even if
  18 your C<mkdir> kernel call won't create more than one level of directory at a
  19 time.  C<mkpath> takes three arguments:
  20
  21 =over 4
  22
  23 =item *
  24
  25 the name of the path to create, or a reference
  26 to a list of paths to create,
  27
  28 =item *
  29
  30 a boolean value, which if TRUE will cause C<mkpath>
  31 to print the name of each directory as it is created
  32 (defaults to FALSE), and
  33
  34 =item *
  35
  36 the numeric mode to use when creating the directories
  37 (defaults to 0777)
  38
  39 =back
  40
  41 It returns a list of all directories (including intermediates, determined using
  42 the Unix '/' separator) created.
  43
  44 Similarly, the C<rmtree> function provides a convenient way to delete a
  45 subtree from the directory structure, much like the Unix command C<rm -r>.
  46 C<rmtree> takes three arguments:
  47
  48 =over 4
  49
  50 =item *
  51
  52 the root of the subtree to delete, or a reference to
  53 a list of roots.  All of the files and directories
  54 below each root, as well as the roots themselves,
  55 will be deleted.  For the moment, C<rmtree> expects
  56 Unix file specification syntax.
  57
  58 =item *
  59
  60 a boolean value, which if TRUE will cause C<rmtree> to
  61 print a message each time it tries to delete a file,
  62 giving the name of the file, and indicating whether
  63 it's using C<rmdir> or C<unlink> to remove it.
  64 (defaults to FALSE)
  65
  66 =item *
  67
  68 a boolean value, which if TRUE will cause C<rmtree> to
  69 skip any files to which you do not have write access.
  70 This will change in the future when a criterion for
  71 'delete permission' is settled. (defaults to FALSE)
  72
  73 =back
  74
  75 It returns the number of files successfully deleted.
  76
  77 =head1 AUTHORS
  78
  79 Tim Bunce <Tim.Bunce@ig.co.uk>
  80 Charles Bailey <bailey@genetics.upenn.edu>
  81
  82 =head1 REVISION
  83
  84 This document was last revised 29-Jan-1995, for perl 5.001
  85
  86 =cut
  87
  88 require 5.000;
  89 use Config;
  90 use Carp;
  91 require Exporter;
  92 @ISA = qw( Exporter );
  93 @EXPORT = qw( mkpath rmtree );
  94
  95 sub mkpath{
  96     my($paths, $verbose, $mode) = @_;
  97     # $paths   -- either a path string or ref to list of paths
  98     # $verbose -- optional print "mkdir $path" for each directory created
  99     # $mode    -- optional permissions, defaults to 0777
 100     local($")="/";
 101     $mode = 0777 unless defined($mode);
 102     $paths = [$paths] unless ref $paths;
 103     my(@created);
 104     foreach $path (@$paths){
 105         next if -d $path;
 106         my(@p);
 107         foreach(split(/\//, $path)){
 108             push(@p, $_);
 109             next if -d "@p/";
 110             print "mkdir @p\n" if $verbose;
 111             mkdir("@p",$mode) || croak "mkdir @p: $!";
 112             push(@created, "@p");
 113         }
 114     }
 115     @created;
 116 }
 117
 118 sub rmtree {
 119     my($roots, $verbose, $safe) = @_;
 120     my(@files,$count);
 121     $roots = [$roots] unless ref $roots;
 122
 123     foreach $root (@{$roots}) {
 124        $root =~ s#/$##;
 125        if (-d $root) {
 126            opendir(D,$root);
 127            @files = map("$root/$_", grep $_!~/^\.{1,2}$/, readdir(D));
 128            closedir(D);
 129            $count += rmtree(\@files,$verbose,$safe);
 130            next if ($safe && !(-w $root));
 131            print "rmdir $root\n" if $verbose;
 132            (rmdir $root && ++$count) or carp "Can't remove directory $root: $!";
 133         }
 134         else {
 135            next if ($safe && !(-w $root));
 136            print "unlink $root\n" if $verbose;
 137            (unlink($root) && ++$count) or carp "Can't unlink file $root: $!";
 138         }
 139     }
 140
 141     $count;
 142 }
 143
 144 1;
 145
 146 __END__