Commit | Line | Data |
---|---|---|
1fc4cb55 | 1 | package File::Path; |
fed7345c AD |
2 | |
3 | =head1 NAME | |
4 | ||
1fc4cb55 | 5 | File::Path - create or remove a series of directories |
fed7345c AD |
6 | |
7 | =head1 SYNOPSIS | |
8 | ||
1fc4cb55 | 9 | C<use File::Path> |
fed7345c AD |
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, | |
567d72c2 | 55 | will be deleted. |
fed7345c AD |
56 | |
57 | =item * | |
58 | ||
59 | a boolean value, which if TRUE will cause C<rmtree> to | |
748a9306 LW |
60 | print a message each time it examines a file, giving the |
61 | name of the file, and indicating whether it's using C<rmdir> | |
62 | or C<unlink> to remove it, or that it's skipping it. | |
fed7345c AD |
63 | (defaults to FALSE) |
64 | ||
65 | =item * | |
66 | ||
67 | a boolean value, which if TRUE will cause C<rmtree> to | |
748a9306 LW |
68 | skip any files to which you do not have delete access |
69 | (if running under VMS) or write access (if running | |
70 | under another OS). This will change in the future when | |
71 | a criterion for 'delete permission' under OSs other | |
72 | than VMS is settled. (defaults to FALSE) | |
fed7345c AD |
73 | |
74 | =back | |
75 | ||
a5f75d66 AD |
76 | It returns the number of files successfully deleted. Symlinks are |
77 | treated as ordinary files. | |
fed7345c AD |
78 | |
79 | =head1 AUTHORS | |
80 | ||
1fef88e7 JM |
81 | Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt> |
82 | Charles Bailey E<lt>F<bailey@genetics.upenn.edu>E<gt> | |
fed7345c AD |
83 | |
84 | =head1 REVISION | |
85 | ||
a5f75d66 AD |
86 | This module was last revised 14-Feb-1996, for perl 5.002. $VERSION is |
87 | 1.01. | |
fed7345c AD |
88 | |
89 | =cut | |
90 | ||
a5f75d66 AD |
91 | $VERSION = "1.01"; # That's my hobby-horse, A.K. |
92 | ||
fed7345c | 93 | require 5.000; |
fed7345c AD |
94 | use Carp; |
95 | require Exporter; | |
96 | @ISA = qw( Exporter ); | |
97 | @EXPORT = qw( mkpath rmtree ); | |
98 | ||
f360dba1 | 99 | $Is_VMS = $^O eq 'VMS'; |
748a9306 | 100 | |
a5f75d66 | 101 | sub mkpath { |
fed7345c AD |
102 | my($paths, $verbose, $mode) = @_; |
103 | # $paths -- either a path string or ref to list of paths | |
104 | # $verbose -- optional print "mkdir $path" for each directory created | |
105 | # $mode -- optional permissions, defaults to 0777 | |
106 | local($")="/"; | |
107 | $mode = 0777 unless defined($mode); | |
108 | $paths = [$paths] unless ref $paths; | |
109 | my(@created); | |
110 | foreach $path (@$paths){ | |
748a9306 | 111 | next if -d $path; |
fed7345c AD |
112 | my(@p); |
113 | foreach(split(/\//, $path)){ | |
114 | push(@p, $_); | |
115 | next if -d "@p/"; | |
116 | print "mkdir @p\n" if $verbose; | |
117 | mkdir("@p",$mode) || croak "mkdir @p: $!"; | |
118 | push(@created, "@p"); | |
119 | } | |
120 | } | |
121 | @created; | |
122 | } | |
123 | ||
124 | sub rmtree { | |
125 | my($roots, $verbose, $safe) = @_; | |
7301ec2d DR |
126 | my(@files); |
127 | my($count) = 0; | |
fed7345c AD |
128 | $roots = [$roots] unless ref $roots; |
129 | ||
130 | foreach $root (@{$roots}) { | |
131 | $root =~ s#/$##; | |
a5f75d66 | 132 | if (not -l $root and -d _) { |
fed7345c | 133 | opendir(D,$root); |
567d72c2 | 134 | ($root = VMS::Filespec::unixify($root)) =~ s#\.dir$## if $Is_VMS; |
fed7345c AD |
135 | @files = map("$root/$_", grep $_!~/^\.{1,2}$/, readdir(D)); |
136 | closedir(D); | |
137 | $count += rmtree(\@files,$verbose,$safe); | |
748a9306 LW |
138 | if ($safe && |
139 | ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) { | |
140 | print "skipped $root\n" if $verbose; | |
141 | next; | |
142 | } | |
fed7345c AD |
143 | print "rmdir $root\n" if $verbose; |
144 | (rmdir $root && ++$count) or carp "Can't remove directory $root: $!"; | |
145 | } | |
146 | else { | |
748a9306 LW |
147 | if ($safe && |
148 | ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) { | |
149 | print "skipped $root\n" if $verbose; | |
150 | next; | |
151 | } | |
fed7345c | 152 | print "unlink $root\n" if $verbose; |
a5f75d66 | 153 | while (-e $root || -l $root) { # delete all versions under VMS |
4633a7c4 LW |
154 | (unlink($root) && ++$count) |
155 | or carp "Can't unlink file $root: $!"; | |
156 | } | |
fed7345c AD |
157 | } |
158 | } | |
159 | ||
160 | $count; | |
161 | } | |
162 | ||
163 | 1; | |
164 | ||
165 | __END__ |