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