Profile of /usr/local/lib/perl5/5.10.1/File/Find.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 05.Domain_and_Item.t
Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:20 2010

File | /usr/local/lib/perl5/5.10.1/File/Find.pm
Statements Executed | 214
Statement Execution Time | 6.08ms

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 146µs | 1.42ms | File::Find::::_find_dir_symlnkFile::Find::_find_dir_symlnk
1 | 1 | 1 | 85µs | 1.64ms | File::Find::::_find_optFile::Find::_find_opt
5 | 2 | 1 | 80µs | 118µs | File::Find::::Follow_SymLinkFile::Find::Follow_SymLink
1 | 1 | 2 | 46µs | 46µs | File::Find::::CORE:readdirFile::Find::CORE:readdir (opcode)
6 | 2 | 2 | 40µs | 40µs | File::Find::::CORE:lstatFile::Find::CORE:lstat (opcode)
1 | 1 | 2 | 30µs | 30µs | File::Find::::CORE:open_dirFile::Find::CORE:open_dir (opcode)
1 | 1 | 1 | 24µs | 24µs | File::Find::::BEGIN@2File::Find::BEGIN@2
1 | 1 | 1 | 21µs | 24µs | File::Find::::contract_nameFile::Find::contract_name
1 | 1 | 1 | 13µs | 1.66ms | File::Find::::findFile::Find::find
1 | 1 | 2 | 10µs | 10µs | File::Find::::CORE:closedirFile::Find::CORE:closedir (opcode)
1 | 1 | 1 | 10µs | 10µs | File::Find::::wrap_wantedFile::Find::wrap_wanted
1 | 1 | 1 | 10µs | 86µs | File::Find::::BEGIN@5File::Find::BEGIN@5
1 | 1 | 1 | 9µs | 12µs | File::Find::::BEGIN@424File::Find::BEGIN@424
6 | 1 | 2 | 8µs | 8µs | File::Find::::CORE:regcompFile::Find::CORE:regcomp (opcode)
1 | 1 | 1 | 7µs | 16µs | File::Find::::BEGIN@4File::Find::BEGIN@4
2 | 2 | 2 | 7µs | 7µs | File::Find::::CORE:qrFile::Find::CORE:qr (opcode)
1 | 1 | 1 | 7µs | 9µs | File::Find::::BEGIN@3File::Find::BEGIN@3
1 | 1 | 2 | 5µs | 5µs | File::Find::::CORE:statFile::Find::CORE:stat (opcode)
6 | 1 | 2 | 4µs | 4µs | File::Find::::CORE:matchFile::Find::CORE:match (opcode)
2 | 2 | 2 | 3µs | 3µs | File::Find::::CORE:substFile::Find::CORE:subst (opcode)
5 | 1 | 2 | 2µs | 2µs | File::Find::::CORE:ftlinkFile::Find::CORE:ftlink (opcode)
5 | 2 | 2 | 1µs | 1µs | File::Find::::CORE:ftdirFile::Find::CORE:ftdir (opcode)
0 | 0 | 0 | 0s | 0s | File::Find::::PathCombineFile::Find::PathCombine
0 | 0 | 0 | 0s | 0s | File::Find::::_find_dirFile::Find::_find_dir
0 | 0 | 0 | 0s | 0s | File::Find::::contract_name_MacFile::Find::contract_name_Mac
0 | 0 | 0 | 0s | 0s | File::Find::::finddepthFile::Find::finddepth
0 | 0 | 0 | 0s | 0s | File::Find::::is_tainted_ppFile::Find::is_tainted_pp

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package File::Find;
2 | 3 | 34µs | 1 | 24µs | # spent 24µs within File::Find::BEGIN@2 which was called # once (24µs+0s) by Module::Find::BEGIN@8 at line 2 use 5.006; # spent 24µs making 1 call to File::Find::BEGIN@2
3 | 3 | 18µs | 2 | 12µs | # spent 9µs (7+3) within File::Find::BEGIN@3 which was called # once (7µs+3µs) by Module::Find::BEGIN@8 at line 3 use strict; # spent 9µs making 1 call to File::Find::BEGIN@3 # spent 3µs making 1 call to strict::import
4 | 3 | 19µs | 2 | 24µs | # spent 16µs (7+8) within File::Find::BEGIN@4 which was called # once (7µs+8µs) by Module::Find::BEGIN@8 at line 4 use warnings; # spent 16µs making 1 call to File::Find::BEGIN@4 # spent 8µs making 1 call to warnings::import
5 | 3 | 139µs | 2 | 162µs | # spent 86µs (10+76) within File::Find::BEGIN@5 which was called # once (10µs+76µs) by Module::Find::BEGIN@8 at line 5 use warnings::register; # spent 86µs making 1 call to File::Find::BEGIN@5 # spent 76µs making 1 call to warnings::register::import
6 | 1 | 2µs |  |  | our $VERSION = '1.14';
7 | 1 | 2µs |  |  | require Exporter;
8 | 1 | 186µs |  |  | require Cwd;
9 |  |  |  |  |
10 |  |  |  |  | #
11 |  |  |  |  | # Modified to ensure sub-directory traversal order is not inverded by stack
12 |  |  |  |  | # push and pops. That is remains in the same order as in the directory file,
13 |  |  |  |  | # or user pre-processing (EG:sorted).
14 |  |  |  |  | #
15 |  |  |  |  |
16 |  |  |  |  | =head1 NAME
17 |  |  |  |  |
18 |  |  |  |  | File::Find - Traverse a directory tree.
19 |  |  |  |  |
20 |  |  |  |  | =head1 SYNOPSIS
21 |  |  |  |  |
22 |  |  |  |  | use File::Find;
23 |  |  |  |  | find(\&wanted, @directories_to_search);
24 |  |  |  |  | sub wanted { ... }
25 |  |  |  |  |
26 |  |  |  |  | use File::Find;
27 |  |  |  |  | finddepth(\&wanted, @directories_to_search);
28 |  |  |  |  | sub wanted { ... }
29 |  |  |  |  |
30 |  |  |  |  | use File::Find;
31 |  |  |  |  | find({ wanted => \&process, follow => 1 }, '.');
32 |  |  |  |  |
33 |  |  |  |  | =head1 DESCRIPTION
34 |  |  |  |  |
35 |  |  |  |  | These are functions for searching through directory trees doing work
36 |  |  |  |  | on each file found similar to the Unix I<find> command. File::Find
37 |  |  |  |  | exports two functions, C<find> and C<finddepth>. They work similarly
38 |  |  |  |  | but have subtle differences.
39 |  |  |  |  |
40 |  |  |  |  | =over 4
41 |  |  |  |  |
42 |  |  |  |  | =item B<find>
43 |  |  |  |  |
44 |  |  |  |  | find(\&wanted, @directories);
45 |  |  |  |  | find(\%options, @directories);
46 |  |  |  |  |
47 |  |  |  |  | C<find()> does a depth-first search over the given C<@directories> in
48 |  |  |  |  | the order they are given. For each file or directory found, it calls
49 |  |  |  |  | the C<&wanted> subroutine. (See below for details on how to use the
50 |  |  |  |  | C<&wanted> function). Additionally, for each directory found, it will
51 |  |  |  |  | C<chdir()> into that directory and continue the search, invoking the
52 |  |  |  |  | C<&wanted> function on each file or subdirectory in the directory.
53 |  |  |  |  |
54 |  |  |  |  | =item B<finddepth>
55 |  |  |  |  |
56 |  |  |  |  | finddepth(\&wanted, @directories);
57 |  |  |  |  | finddepth(\%options, @directories);
58 |  |  |  |  |
59 |  |  |  |  | C<finddepth()> works just like C<find()> except that it invokes the
60 |  |  |  |  | C<&wanted> function for a directory I<after> invoking it for the
61 |  |  |  |  | directory's contents. It does a postorder traversal instead of a
62 |  |  |  |  | preorder traversal, working from the bottom of the directory tree up
63 |  |  |  |  | where C<find()> works from the top of the tree down.
64 |  |  |  |  |
65 |  |  |  |  | =back
66 |  |  |  |  |
67 |  |  |  |  | =head2 %options
68 |  |  |  |  |
69 |  |  |  |  | The first argument to C<find()> is either a code reference to your
70 |  |  |  |  | C<&wanted> function, or a hash reference describing the operations
71 |  |  |  |  | to be performed for each file. The
72 |  |  |  |  | code reference is described in L<The wanted function> below.
73 |  |  |  |  |
74 |  |  |  |  | Here are the possible keys for the hash:
75 |  |  |  |  |
76 |  |  |  |  | =over 3
77 |  |  |  |  |
78 |  |  |  |  | =item C<wanted>
79 |  |  |  |  |
80 |  |  |  |  | The value should be a code reference. This code reference is
81 |  |  |  |  | described in L<The wanted function> below. The C<&wanted> subroutine is
82 |  |  |  |  | mandatory.
83 |  |  |  |  |
84 |  |  |  |  | =item C<bydepth>
85 |  |  |  |  |
86 |  |  |  |  | Reports the name of a directory only AFTER all its entries
87 |  |  |  |  | have been reported. Entry point C<finddepth()> is a shortcut for
88 |  |  |  |  | specifying C<< { bydepth => 1 } >> in the first argument of C<find()>.
89 |  |  |  |  |
90 |  |  |  |  | =item C<preprocess>
91 |  |  |  |  |
92 |  |  |  |  | The value should be a code reference. This code reference is used to
93 |  |  |  |  | preprocess the current directory. The name of the currently processed
94 |  |  |  |  | directory is in C<$File::Find::dir>. Your preprocessing function is
95 |  |  |  |  | called after C<readdir()>, but before the loop that calls the C<wanted()>
96 |  |  |  |  | function. It is called with a list of strings (actually file/directory
97 |  |  |  |  | names) and is expected to return a list of strings. The code can be
98 |  |  |  |  | used to sort the file/directory names alphabetically, numerically,
99 |  |  |  |  | or to filter out directory entries based on their name alone. When
100 |  |  |  |  | I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
101 |  |  |  |  |
102 |  |  |  |  | =item C<postprocess>
103 |  |  |  |  |
104 |  |  |  |  | The value should be a code reference. It is invoked just before leaving
105 |  |  |  |  | the currently processed directory. It is called in void context with no
106 |  |  |  |  | arguments. The name of the current directory is in C<$File::Find::dir>. This
107 |  |  |  |  | hook is handy for summarizing a directory, such as calculating its disk
108 |  |  |  |  | usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
109 |  |  |  |  | no-op.
110 |  |  |  |  |
111 |  |  |  |  | =item C<follow>
112 |  |  |  |  |
113 |  |  |  |  | Causes symbolic links to be followed. Since directory trees with symbolic
114 |  |  |  |  | links (followed) may contain files more than once and may even have
115 |  |  |  |  | cycles, a hash has to be built up with an entry for each file.
116 |  |  |  |  | This might be expensive both in space and time for a large
117 |  |  |  |  | directory tree. See I<follow_fast> and I<follow_skip> below.
118 |  |  |  |  | If either I<follow> or I<follow_fast> is in effect:
119 |  |  |  |  |
120 |  |  |  |  | =over 6
121 |  |  |  |  |
122 |  |  |  |  | =item *
123 |  |  |  |  |
124 |  |  |  |  | It is guaranteed that an I<lstat> has been called before the user's
125 |  |  |  |  | C<wanted()> function is called. This enables fast file checks involving S<_>.
126 |  |  |  |  | Note that this guarantee no longer holds if I<follow> or I<follow_fast>
127 |  |  |  |  | are not set.
128 |  |  |  |  |
129 |  |  |  |  | =item *
130 |  |  |  |  |
131 |  |  |  |  | There is a variable C<$File::Find::fullname> which holds the absolute
132 |  |  |  |  | pathname of the file with all symbolic links resolved. If the link is
133 |  |  |  |  | a dangling symbolic link, then fullname will be set to C<undef>.
134 |  |  |  |  |
135 |  |  |  |  | =back
136 |  |  |  |  |
137 |  |  |  |  | This is a no-op on Win32.
138 |  |  |  |  |
139 |  |  |  |  | =item C<follow_fast>
140 |  |  |  |  |
141 |  |  |  |  | This is similar to I<follow> except that it may report some files more
142 |  |  |  |  | than once. It does detect cycles, however. Since only symbolic links
143 |  |  |  |  | have to be hashed, this is much cheaper both in space and time. If
144 |  |  |  |  | processing a file more than once (by the user's C<wanted()> function)
145 |  |  |  |  | is worse than just taking time, the option I<follow> should be used.
146 |  |  |  |  |
147 |  |  |  |  | This is also a no-op on Win32.
148 |  |  |  |  |
149 |  |  |  |  | =item C<follow_skip>
150 |  |  |  |  |
151 |  |  |  |  | C<follow_skip==1>, which is the default, causes all files which are
152 |  |  |  |  | neither directories nor symbolic links to be ignored if they are about
153 |  |  |  |  | to be processed a second time. If a directory or a symbolic link
154 |  |  |  |  | are about to be processed a second time, File::Find dies.
155 |  |  |  |  |
156 |  |  |  |  | C<follow_skip==0> causes File::Find to die if any file is about to be
157 |  |  |  |  | processed a second time.
158 |  |  |  |  |
159 |  |  |  |  | C<follow_skip==2> causes File::Find to ignore any duplicate files and
160 |  |  |  |  | directories but to proceed normally otherwise.
161 |  |  |  |  |
162 |  |  |  |  | =item C<dangling_symlinks>
163 |  |  |  |  |
164 |  |  |  |  | If true and a code reference, will be called with the symbolic link
165 |  |  |  |  | name and the directory it lives in as arguments. Otherwise, if true
166 |  |  |  |  | and warnings are on, warning "symbolic_link_name is a dangling
167 |  |  |  |  | symbolic link\n" will be issued. If false, the dangling symbolic link
168 |  |  |  |  | will be silently ignored.
169 |  |  |  |  |
170 |  |  |  |  | =item C<no_chdir>
171 |  |  |  |  |
172 |  |  |  |  | Does not C<chdir()> to each directory as it recurses. The C<wanted()>
173 |  |  |  |  | function will need to be aware of this, of course. In this case,
174 |  |  |  |  | C<$_> will be the same as C<$File::Find::name>.
175 |  |  |  |  |
176 |  |  |  |  | =item C<untaint>
177 |  |  |  |  |
178 |  |  |  |  | If find is used in taint-mode (-T command line switch or if EUID != UID
179 |  |  |  |  | or if EGID != GID) then internally directory names have to be untainted
180 |  |  |  |  | before they can be chdir'ed to. Therefore they are checked against a regular
181 |  |  |  |  | expression I<untaint_pattern>. Note that all names passed to the user's
182 |  |  |  |  | I<wanted()> function are still tainted. If this option is used while
183 |  |  |  |  | not in taint-mode, C<untaint> is a no-op.
184 |  |  |  |  |
185 |  |  |  |  | =item C<untaint_pattern>
186 |  |  |  |  |
187 |  |  |  |  | See above. This should be set using the C<qr> quoting operator.
188 |  |  |  |  | The default is set to C<qr|^([-+@\w./]+)$|>.
189 |  |  |  |  | Note that the parentheses are vital.
190 |  |  |  |  |
191 |  |  |  |  | =item C<untaint_skip>
192 |  |  |  |  |
193 |  |  |  |  | If set, a directory which fails the I<untaint_pattern> is skipped,
194 |  |  |  |  | including all its sub-directories. The default is to 'die' in such a case.
195 |  |  |  |  |
196 |  |  |  |  | =back
197 |  |  |  |  |
198 |  |  |  |  | =head2 The wanted function
199 |  |  |  |  |
200 |  |  |  |  | The C<wanted()> function does whatever verifications you want on
201 |  |  |  |  | each file and directory. Note that despite its name, the C<wanted()>
202 |  |  |  |  | function is a generic callback function, and does B<not> tell
203 |  |  |  |  | File::Find if a file is "wanted" or not. In fact, its return value
204 |  |  |  |  | is ignored.
205 |  |  |  |  |
206 |  |  |  |  | The wanted function takes no arguments but rather does its work
207 |  |  |  |  | through a collection of variables.
208 |  |  |  |  |
209 |  |  |  |  | =over 4
210 |  |  |  |  |
211 |  |  |  |  | =item C<$File::Find::dir> is the current directory name,
212 |  |  |  |  |
213 |  |  |  |  | =item C<$_> is the current filename within that directory
214 |  |  |  |  |
215 |  |  |  |  | =item C<$File::Find::name> is the complete pathname to the file.
216 |  |  |  |  |
217 |  |  |  |  | =back
218 |  |  |  |  |
219 |  |  |  |  | The above variables have all been localized and may be changed without
220 |  |  |  |  | effecting data outside of the wanted function.
221 |  |  |  |  |
222 |  |  |  |  | For example, when examining the file F</some/path/foo.ext> you will have:
223 |  |  |  |  |
224 |  |  |  |  | $File::Find::dir = /some/path/
225 |  |  |  |  | $_ = foo.ext
226 |  |  |  |  | $File::Find::name = /some/path/foo.ext
227 |  |  |  |  |
228 |  |  |  |  | You are chdir()'d to C<$File::Find::dir> when the function is called,
229 |  |  |  |  | unless C<no_chdir> was specified. Note that when changing to
230 |  |  |  |  | directories is in effect the root directory (F</>) is a somewhat
231 |  |  |  |  | special case inasmuch as the concatenation of C<$File::Find::dir>,
232 |  |  |  |  | C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
233 |  |  |  |  | table below summarizes all variants:
234 |  |  |  |  |
235 |  |  |  |  | $File::Find::name $File::Find::dir $_
236 |  |  |  |  | default / / .
237 |  |  |  |  | no_chdir=>0 /etc / etc
238 |  |  |  |  | /etc/x /etc x
239 |  |  |  |  |
240 |  |  |  |  | no_chdir=>1 / / /
241 |  |  |  |  | /etc / /etc
242 |  |  |  |  | /etc/x /etc /etc/x
243 |  |  |  |  |
244 |  |  |  |  |
245 |  |  |  |  | When C<follow> or C<follow_fast> are in effect, there is
246 |  |  |  |  | also a C<$File::Find::fullname>. The function may set
247 |  |  |  |  | C<$File::Find::prune> to prune the tree unless C<bydepth> was
248 |  |  |  |  | specified. Unless C<follow> or C<follow_fast> is specified, for
249 |  |  |  |  | compatibility reasons (find.pl, find2perl) there are in addition the
250 |  |  |  |  | following globals available: C<$File::Find::topdir>,
251 |  |  |  |  | C<$File::Find::topdev>, C<$File::Find::topino>,
252 |  |  |  |  | C<$File::Find::topmode> and C<$File::Find::topnlink>.
253 |  |  |  |  |
254 |  |  |  |  | This library is useful for the C<find2perl> tool, which when fed,
255 |  |  |  |  |
256 |  |  |  |  | find2perl / -name .nfs\* -mtime +7 \
257 |  |  |  |  | -exec rm -f {} \; -o -fstype nfs -prune
258 |  |  |  |  |
259 |  |  |  |  | produces something like:
260 |  |  |  |  |
261 |  |  |  |  | sub wanted {
262 |  |  |  |  | /^\.nfs.*\z/s &&
263 |  |  |  |  | (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
264 |  |  |  |  | int(-M _) > 7 &&
265 |  |  |  |  | unlink($_)
266 |  |  |  |  | ||
267 |  |  |  |  | ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
268 |  |  |  |  | $dev < 0 &&
269 |  |  |  |  | ($File::Find::prune = 1);
270 |  |  |  |  | }
271 |  |  |  |  |
272 |  |  |  |  | Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
273 |  |  |  |  | filehandle that caches the information from the preceding
274 |  |  |  |  | C<stat()>, C<lstat()>, or filetest.
275 |  |  |  |  |
276 |  |  |  |  | Here's another interesting wanted function. It will find all symbolic
277 |  |  |  |  | links that don't resolve:
278 |  |  |  |  |
279 |  |  |  |  | sub wanted {
280 |  |  |  |  | -l && !-e && print "bogus link: $File::Find::name\n";
281 |  |  |  |  | }
282 |  |  |  |  |
283 |  |  |  |  | See also the script C<pfind> on CPAN for a nice application of this
284 |  |  |  |  | module.
285 |  |  |  |  |
286 |  |  |  |  | =head1 WARNINGS
287 |  |  |  |  |
288 |  |  |  |  | If you run your program with the C<-w> switch, or if you use the
289 |  |  |  |  | C<warnings> pragma, File::Find will report warnings for several weird
290 |  |  |  |  | situations. You can disable these warnings by putting the statement
291 |  |  |  |  |
292 |  |  |  |  | no warnings 'File::Find';
293 |  |  |  |  |
294 |  |  |  |  | in the appropriate scope. See L<perllexwarn> for more info about lexical
295 |  |  |  |  | warnings.
296 |  |  |  |  |
297 |  |  |  |  | =head1 CAVEAT
298 |  |  |  |  |
299 |  |  |  |  | =over 2
300 |  |  |  |  |
301 |  |  |  |  | =item $dont_use_nlink
302 |  |  |  |  |
303 |  |  |  |  | You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
304 |  |  |  |  | force File::Find to always stat directories. This was used for file systems
305 |  |  |  |  | that do not have an C<nlink> count matching the number of sub-directories.
306 |  |  |  |  | Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
307 |  |  |  |  | system) and a couple of others.
308 |  |  |  |  |
309 |  |  |  |  | You shouldn't need to set this variable, since File::Find should now detect
310 |  |  |  |  | such file systems on-the-fly and switch itself to using stat. This works even
311 |  |  |  |  | for parts of your file system, like a mounted CD-ROM.
312 |  |  |  |  |
313 |  |  |  |  | If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
314 |  |  |  |  |
315 |  |  |  |  | =item symlinks
316 |  |  |  |  |
317 |  |  |  |  | Be aware that the option to follow symbolic links can be dangerous.
318 |  |  |  |  | Depending on the structure of the directory tree (including symbolic
319 |  |  |  |  | links to directories) you might traverse a given (physical) directory
320 |  |  |  |  | more than once (only if C<follow_fast> is in effect).
321 |  |  |  |  | Furthermore, deleting or changing files in a symbolically linked directory
322 |  |  |  |  | might cause very unpleasant surprises, since you delete or change files
323 |  |  |  |  | in an unknown directory.
324 |  |  |  |  |
325 |  |  |  |  | =back
326 |  |  |  |  |
327 |  |  |  |  | =head1 NOTES
328 |  |  |  |  |
329 |  |  |  |  | =over 4
330 |  |  |  |  |
331 |  |  |  |  | =item *
332 |  |  |  |  |
333 |  |  |  |  | Mac OS (Classic) users should note a few differences:
334 |  |  |  |  |
335 |  |  |  |  | =over 4
336 |  |  |  |  |
337 |  |  |  |  | =item *
338 |  |  |  |  |
339 |  |  |  |  | The path separator is ':', not '/', and the current directory is denoted
340 |  |  |  |  | as ':', not '.'. You should be careful about specifying relative pathnames.
341 |  |  |  |  | While a full path always begins with a volume name, a relative pathname
342 |  |  |  |  | should always begin with a ':'. If specifying a volume name only, a
343 |  |  |  |  | trailing ':' is required.
344 |  |  |  |  |
345 |  |  |  |  | =item *
346 |  |  |  |  |
347 |  |  |  |  | C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
348 |  |  |  |  | contains the name of a directory, that name may or may not end with a
349 |  |  |  |  | ':'. Likewise, C<$File::Find::name>, which contains the complete
350 |  |  |  |  | pathname to that directory, and C<$File::Find::fullname>, which holds
351 |  |  |  |  | the absolute pathname of that directory with all symbolic links resolved,
352 |  |  |  |  | may or may not end with a ':'.
353 |  |  |  |  |
354 |  |  |  |  | =item *
355 |  |  |  |  |
356 |  |  |  |  | The default C<untaint_pattern> (see above) on Mac OS is set to
357 |  |  |  |  | C<qr|^(.+)$|>. Note that the parentheses are vital.
358 |  |  |  |  |
359 |  |  |  |  | =item *
360 |  |  |  |  |
361 |  |  |  |  | The invisible system file "Icon\015" is ignored. While this file may
362 |  |  |  |  | appear in every directory, there are some more invisible system files
363 |  |  |  |  | on every volume, which are all located at the volume root level (i.e.
364 |  |  |  |  | "MacintoshHD:"). These system files are B<not> excluded automatically.
365 |  |  |  |  | Your filter may use the following code to recognize invisible files or
366 |  |  |  |  | directories (requires Mac::Files):
367 |  |  |  |  |
368 |  |  |  |  | use Mac::Files;
369 |  |  |  |  |
370 |  |  |  |  | # invisible() -- returns 1 if file/directory is invisible,
371 |  |  |  |  | # 0 if it's visible or undef if an error occurred
372 |  |  |  |  |
373 |  |  |  |  | sub invisible($) {
374 |  |  |  |  | my $file = shift;
375 |  |  |  |  | my ($fileCat, $fileInfo);
376 |  |  |  |  | my $invisible_flag = 1 << 14;
377 |  |  |  |  |
378 |  |  |  |  | if ( $fileCat = FSpGetCatInfo($file) ) {
379 |  |  |  |  | if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
380 |  |  |  |  | return (($fileInfo->fdFlags & $invisible_flag) && 1);
381 |  |  |  |  | }
382 |  |  |  |  | }
383 |  |  |  |  | return undef;
384 |  |  |  |  | }
385 |  |  |  |  |
386 |  |  |  |  | Generally, invisible files are system files, unless an odd application
387 |  |  |  |  | decides to use invisible files for its own purposes. To distinguish
388 |  |  |  |  | such files from system files, you have to look at the B<type> and B<creator>
389 |  |  |  |  | file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
390 |  |  |  |  | C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
391 |  |  |  |  | (see MacPerl.pm for details).
392 |  |  |  |  |
393 |  |  |  |  | Files that appear on the desktop actually reside in an (hidden) directory
394 |  |  |  |  | named "Desktop Folder" on the particular disk volume. Note that, although
395 |  |  |  |  | all desktop files appear to be on the same "virtual" desktop, each disk
396 |  |  |  |  | volume actually maintains its own "Desktop Folder" directory.
397 |  |  |  |  |
398 |  |  |  |  | =back
399 |  |  |  |  |
400 |  |  |  |  | =back
401 |  |  |  |  |
402 |  |  |  |  | =head1 BUGS AND CAVEATS
403 |  |  |  |  |
404 |  |  |  |  | Despite the name of the C<finddepth()> function, both C<find()> and
405 |  |  |  |  | C<finddepth()> perform a depth-first search of the directory
406 |  |  |  |  | hierarchy.
407 |  |  |  |  |
408 |  |  |  |  | =head1 HISTORY
409 |  |  |  |  |
410 |  |  |  |  | File::Find used to produce incorrect results if called recursively.
411 |  |  |  |  | During the development of perl 5.8 this bug was fixed.
412 |  |  |  |  | The first fixed version of File::Find was 1.01.
413 |  |  |  |  |
414 |  |  |  |  | =head1 SEE ALSO
415 |  |  |  |  |
416 |  |  |  |  | find, find2perl.
417 |  |  |  |  |
418 |  |  |  |  | =cut
419 |  |  |  |  |
420 | 1 | 9µs |  |  | our @ISA = qw(Exporter);
421 | 1 | 2µs |  |  | our @EXPORT = qw(find finddepth);
422 |  |  |  |  |
423 |  |  |  |  |
424 | 3 | 4.70ms | 2 | 14µs | # spent 12µs (9+3) within File::Find::BEGIN@424 which was called # once (9µs+3µs) by Module::Find::BEGIN@8 at line 424 use strict; # spent 12µs making 1 call to File::Find::BEGIN@424 # spent 3µs making 1 call to strict::import
425 | 1 | 400ns |  |  | my $Is_VMS;
426 | 1 | 300ns |  |  | my $Is_MacOS;
427 |  |  |  |  |
428 | 1 | 120µs |  |  | require File::Basename;
429 | 1 | 1µs |  |  | require File::Spec;
430 |  |  |  |  |
431 |  |  |  |  | # Should ideally be my() not our() but local() currently
432 |  |  |  |  | # refuses to operate on lexicals
433 |  |  |  |  |
434 | 1 | 400ns |  |  | our %SLnkSeen;
435 | 1 | 2µs |  |  | our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
436 |  |  |  |  | $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
437 |  |  |  |  | $pre_process, $post_process, $dangling_symlinks);
438 |  |  |  |  |
439 |  |  |  |  | # spent 24µs (21+2) within File::Find::contract_name which was called # once (21µs+2µs) by File::Find::_find_opt at line 693 sub contract_name {
440 | 7 | 27µs |  |  | my ($cdir,$fn) = @_;
441 |  |  |  |  |
442 |  |  |  |  | return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
443 |  |  |  |  |
444 |  |  |  |  | $cdir = substr($cdir,0,rindex($cdir,'/')+1);
445 |  |  |  |  |
446 |  |  |  |  | $fn =~ s|^\./||; # spent 2µs making 1 call to File::Find::CORE:subst
447 |  |  |  |  |
448 |  |  |  |  | my $abs_name= $cdir . $fn;
449 |  |  |  |  |
450 |  |  |  |  | if (substr($fn,0,3) eq '../') {
451 |  |  |  |  | 1 while $abs_name =~ s!/[^/]*/\.\./!/!;
452 |  |  |  |  | }
453 |  |  |  |  |
454 |  |  |  |  | return $abs_name;
455 |  |  |  |  | }
456 |  |  |  |  |
457 |  |  |  |  | # return the absolute name of a directory or file
458 |  |  |  |  | sub contract_name_Mac {
459 |  |  |  |  | my ($cdir,$fn) = @_;
460 |  |  |  |  | my $abs_name;
461 |  |  |  |  |
462 |  |  |  |  | if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
463 |  |  |  |  |
464 |  |  |  |  | my $colon_count = length ($1);
465 |  |  |  |  | if ($colon_count == 1) {
466 |  |  |  |  | $abs_name = $cdir . $2;
467 |  |  |  |  | return $abs_name;
468 |  |  |  |  | }
469 |  |  |  |  | else {
470 |  |  |  |  | # need to move up the tree, but
471 |  |  |  |  | # only if it's not a volume name
472 |  |  |  |  | for (my $i=1; $i<$colon_count; $i++) {
473 |  |  |  |  | unless ($cdir =~ /^[^:]+:$/) { # volume name
474 |  |  |  |  | $cdir =~ s/[^:]+:$//;
475 |  |  |  |  | }
476 |  |  |  |  | else {
477 |  |  |  |  | return undef;
478 |  |  |  |  | }
479 |  |  |  |  | }
480 |  |  |  |  | $abs_name = $cdir . $2;
481 |  |  |  |  | return $abs_name;
482 |  |  |  |  | }
483 |  |  |  |  |
484 |  |  |  |  | }
485 |  |  |  |  | else {
486 |  |  |  |  |
487 |  |  |  |  | # $fn may be a valid path to a directory or file or (dangling)
488 |  |  |  |  | # symlink, without a leading ':'
489 |  |  |  |  | if ( (-e $fn) || (-l $fn) ) {
490 |  |  |  |  | if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
491 |  |  |  |  | return $fn; # $fn is already an absolute path
492 |  |  |  |  | }
493 |  |  |  |  | else {
494 |  |  |  |  | $abs_name = $cdir . $fn;
495 |  |  |  |  | return $abs_name;
496 |  |  |  |  | }
497 |  |  |  |  | }
498 |  |  |  |  | else { # argh!, $fn is not a valid directory/file
499 |  |  |  |  | return undef;
500 |  |  |  |  | }
501 |  |  |  |  | }
502 |  |  |  |  | }
503 |  |  |  |  |
504 |  |  |  |  | sub PathCombine($$) {
505 |  |  |  |  | my ($Base,$Name) = @_;
506 |  |  |  |  | my $AbsName;
507 |  |  |  |  |
508 |  |  |  |  | if ($Is_MacOS) {
509 |  |  |  |  | # $Name is the resolved symlink (always a full path on MacOS),
510 |  |  |  |  | # i.e. there's no need to call contract_name_Mac()
511 |  |  |  |  | $AbsName = $Name;
512 |  |  |  |  |
513 |  |  |  |  | # (simple) check for recursion
514 |  |  |  |  | if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
515 |  |  |  |  | return undef;
516 |  |  |  |  | }
517 |  |  |  |  | }
518 |  |  |  |  | else {
519 |  |  |  |  | if (substr($Name,0,1) eq '/') {
520 |  |  |  |  | $AbsName= $Name;
521 |  |  |  |  | }
522 |  |  |  |  | else {
523 |  |  |  |  | $AbsName= contract_name($Base,$Name);
524 |  |  |  |  | }
525 |  |  |  |  |
526 |  |  |  |  | # (simple) check for recursion
527 |  |  |  |  | my $newlen= length($AbsName);
528 |  |  |  |  | if ($newlen <= length($Base)) {
529 |  |  |  |  | if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
530 |  |  |  |  | && $AbsName eq substr($Base,0,$newlen))
531 |  |  |  |  | {
532 |  |  |  |  | return undef;
533 |  |  |  |  | }
534 |  |  |  |  | }
535 |  |  |  |  | }
536 |  |  |  |  | return $AbsName;
537 |  |  |  |  | }
538 |  |  |  |  |
539 |  |  |  |  | # spent 118µs (80+38) within File::Find::Follow_SymLink which was called 5 times, avg 24µs/call: # 4 times (41µs+28µs) by File::Find::_find_dir_symlnk at line 1179, avg 17µs/call # once (39µs+11µs) by File::Find::_find_opt at line 696 sub Follow_SymLink($) {
540 | 30 | 119µs |  |  | my ($AbsName) = @_;
541 |  |  |  |  |
542 |  |  |  |  | my ($NewName,$DEV, $INO);
543 |  |  |  |  | ($DEV, $INO)= lstat $AbsName; # spent 36µs making 5 calls to File::Find::CORE:lstat, avg 7µs/call
544 |  |  |  |  |
545 |  |  |  |  | while (-l _) { # spent 2µs making 5 calls to File::Find::CORE:ftlink, avg 460ns/call
546 |  |  |  |  | if ($SLnkSeen{$DEV, $INO}++) {
547 |  |  |  |  | if ($follow_skip < 2) {
548 |  |  |  |  | die "$AbsName is encountered a second time";
549 |  |  |  |  | }
550 |  |  |  |  | else {
551 |  |  |  |  | return undef;
552 |  |  |  |  | }
553 |  |  |  |  | }
554 |  |  |  |  | $NewName= PathCombine($AbsName, readlink($AbsName));
555 |  |  |  |  | unless(defined $NewName) {
556 |  |  |  |  | if ($follow_skip < 2) {
557 |  |  |  |  | die "$AbsName is a recursive symbolic link";
558 |  |  |  |  | }
559 |  |  |  |  | else {
560 |  |  |  |  | return undef;
561 |  |  |  |  | }
562 |  |  |  |  | }
563 |  |  |  |  | else {
564 |  |  |  |  | $AbsName= $NewName;
565 |  |  |  |  | }
566 |  |  |  |  | ($DEV, $INO) = lstat($AbsName);
567 |  |  |  |  | return undef unless defined $DEV; # dangling symbolic link
568 |  |  |  |  | }
569 |  |  |  |  |
570 |  |  |  |  | if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
571 |  |  |  |  | if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
572 |  |  |  |  | die "$AbsName encountered a second time";
573 |  |  |  |  | }
574 |  |  |  |  | else {
575 |  |  |  |  | return undef;
576 |  |  |  |  | }
577 |  |  |  |  | }
578 |  |  |  |  |
579 |  |  |  |  | return $AbsName;
580 |  |  |  |  | }
581 |  |  |  |  |
582 | 1 | 1µs |  |  | our($dir, $name, $fullname, $prune);
583 |  |  |  |  | sub _find_dir_symlnk($$$);
584 |  |  |  |  | sub _find_dir($$$);
585 |  |  |  |  |
586 |  |  |  |  | # check whether or not a scalar variable is tainted
587 |  |  |  |  | # (code straight from the Camel, 3rd ed., page 561)
588 |  |  |  |  | sub is_tainted_pp {
589 |  |  |  |  | my $arg = shift;
590 |  |  |  |  | my $nada = substr($arg, 0, 0); # zero-length
591 |  |  |  |  | local $@;
592 |  |  |  |  | eval { eval "# $nada" };
593 |  |  |  |  | return length($@) != 0;
594 |  |  |  |  | }
595 |  |  |  |  |
596 |  |  |  |  | # spent 1.64ms (85µs+1.55) within File::Find::_find_opt which was called # once (85µs+1.55ms) by File::Find::find at line 1297 sub _find_opt {
597 | 44 | 134µs |  |  | my $wanted = shift;
598 |  |  |  |  | die "invalid top directory" unless defined $_[0];
599 |  |  |  |  |
600 |  |  |  |  | # This function must local()ize everything because callbacks may
601 |  |  |  |  | # call find() or finddepth()
602 |  |  |  |  |
603 |  |  |  |  | local %SLnkSeen;
604 |  |  |  |  | local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
605 |  |  |  |  | $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
606 |  |  |  |  | $pre_process, $post_process, $dangling_symlinks);
607 |  |  |  |  | local($dir, $name, $fullname, $prune);
608 |  |  |  |  | local *_ = \my $a;
609 |  |  |  |  |
610 |  |  |  |  | my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd(); # spent 52µs making 1 call to Cwd::getcwd
611 |  |  |  |  | if ($Is_VMS) {
612 |  |  |  |  | # VMS returns this by default in VMS format which just doesn't
613 |  |  |  |  | # work for the rest of this module.
614 |  |  |  |  | $cwd = VMS::Filespec::unixpath($cwd);
615 |  |  |  |  |
616 |  |  |  |  | # Apparently this is not expected to have a trailing space.
617 |  |  |  |  | # To attempt to make VMS/UNIX conversions mostly reversable,
618 |  |  |  |  | # a trailing slash is needed. The run-time functions ignore the
619 |  |  |  |  | # resulting double slash, but it causes the perl tests to fail.
620 |  |  |  |  | $cwd =~ s#/\z##;
621 |  |  |  |  |
622 |  |  |  |  | # This comes up in upper case now, but should be lower.
623 |  |  |  |  | # In the future this could be exact case, no need to change.
624 |  |  |  |  | }
625 |  |  |  |  | my $cwd_untainted = $cwd;
626 |  |  |  |  | my $check_t_cwd = 1;
627 |  |  |  |  | $wanted_callback = $wanted->{wanted};
628 |  |  |  |  | $bydepth = $wanted->{bydepth};
629 |  |  |  |  | $pre_process = $wanted->{preprocess};
630 |  |  |  |  | $post_process = $wanted->{postprocess};
631 |  |  |  |  | $no_chdir = $wanted->{no_chdir};
632 |  |  |  |  | $full_check = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
633 |  |  |  |  | $follow = $^O eq 'MSWin32' ? 0 :
634 |  |  |  |  | $full_check || $wanted->{follow_fast};
635 |  |  |  |  | $follow_skip = $wanted->{follow_skip};
636 |  |  |  |  | $untaint = $wanted->{untaint};
637 |  |  |  |  | $untaint_pat = $wanted->{untaint_pattern};
638 |  |  |  |  | $untaint_skip = $wanted->{untaint_skip};
639 |  |  |  |  | $dangling_symlinks = $wanted->{dangling_symlinks};
640 |  |  |  |  |
641 |  |  |  |  | # for compatibility reasons (find.pl, find2perl)
642 |  |  |  |  | local our ($topdir, $topdev, $topino, $topmode, $topnlink);
643 |  |  |  |  |
644 |  |  |  |  | # a symbolic link to a directory doesn't increase the link count
645 |  |  |  |  | $avoid_nlink = $follow || $File::Find::dont_use_nlink;
646 |  |  |  |  |
647 |  |  |  |  | my ($abs_dir, $Is_Dir);
648 |  |  |  |  |
649 |  |  |  |  | Proc_Top_Item:
650 |  |  |  |  | foreach my $TOP (@_) {
651 |  |  |  |  | my $top_item = $TOP;
652 |  |  |  |  |
653 |  |  |  |  | ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item; # spent 5µs making 1 call to File::Find::CORE:stat
654 |  |  |  |  |
655 |  |  |  |  | if ($Is_MacOS) {
656 |  |  |  |  | $top_item = ":$top_item"
657 |  |  |  |  | if ( (-d _) && ( $top_item !~ /:/ ) );
658 |  |  |  |  | } elsif ($^O eq 'MSWin32') {
659 |  |  |  |  | $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
660 |  |  |  |  | }
661 |  |  |  |  | else {
662 |  |  |  |  | $top_item =~ s|/\z|| unless $top_item eq '/'; # spent 900ns making 1 call to File::Find::CORE:subst
663 |  |  |  |  | }
664 |  |  |  |  |
665 |  |  |  |  | $Is_Dir= 0;
666 |  |  |  |  |
667 |  |  |  |  | if ($follow) {
668 |  |  |  |  |
669 |  |  |  |  | if ($Is_MacOS) {
670 |  |  |  |  | $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
671 |  |  |  |  |
672 |  |  |  |  | if ($top_item eq $File::Find::current_dir) {
673 |  |  |  |  | $abs_dir = $cwd;
674 |  |  |  |  | }
675 |  |  |  |  | else {
676 |  |  |  |  | $abs_dir = contract_name_Mac($cwd, $top_item);
677 |  |  |  |  | unless (defined $abs_dir) {
678 |  |  |  |  | warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
679 |  |  |  |  | next Proc_Top_Item;
680 |  |  |  |  | }
681 |  |  |  |  | }
682 |  |  |  |  |
683 |  |  |  |  | }
684 |  |  |  |  | else {
685 |  |  |  |  | if (substr($top_item,0,1) eq '/') {
686 |  |  |  |  | $abs_dir = $top_item;
687 |  |  |  |  | }
688 |  |  |  |  | elsif ($top_item eq $File::Find::current_dir) {
689 |  |  |  |  | $abs_dir = $cwd;
690 |  |  |  |  | }
691 |  |  |  |  | else { # care about any ../
692 |  |  |  |  | $top_item =~ s/\.dir\z//i if $Is_VMS;
693 |  |  |  |  | $abs_dir = contract_name("$cwd/",$top_item); # spent 24µs making 1 call to File::Find::contract_name
694 |  |  |  |  | }
695 |  |  |  |  | }
696 |  |  |  |  | $abs_dir= Follow_SymLink($abs_dir); # spent 50µs making 1 call to File::Find::Follow_SymLink
697 |  |  |  |  | unless (defined $abs_dir) {
698 |  |  |  |  | if ($dangling_symlinks) {
699 |  |  |  |  | if (ref $dangling_symlinks eq 'CODE') {
700 |  |  |  |  | $dangling_symlinks->($top_item, $cwd);
701 |  |  |  |  | } else {
702 |  |  |  |  | warnings::warnif "$top_item is a dangling symbolic link\n";
703 |  |  |  |  | }
704 |  |  |  |  | }
705 |  |  |  |  | next Proc_Top_Item;
706 |  |  |  |  | }
707 |  |  |  |  |
708 |  |  |  |  | if (-d _) { # spent 300ns making 1 call to File::Find::CORE:ftdir
709 |  |  |  |  | $top_item =~ s/\.dir\z//i if $Is_VMS;
710 |  |  |  |  | _find_dir_symlnk($wanted, $abs_dir, $top_item); # spent 1.42ms making 1 call to File::Find::_find_dir_symlnk
711 |  |  |  |  | $Is_Dir= 1;
712 |  |  |  |  | }
713 |  |  |  |  | }
714 |  |  |  |  | else { # no follow
715 |  |  |  |  | $topdir = $top_item;
716 |  |  |  |  | unless (defined $topnlink) {
717 |  |  |  |  | warnings::warnif "Can't stat $top_item: $!\n";
718 |  |  |  |  | next Proc_Top_Item;
719 |  |  |  |  | }
720 |  |  |  |  | if (-d _) {
721 |  |  |  |  | $top_item =~ s/\.dir\z//i if $Is_VMS;
722 |  |  |  |  | _find_dir($wanted, $top_item, $topnlink);
723 |  |  |  |  | $Is_Dir= 1;
724 |  |  |  |  | }
725 |  |  |  |  | else {
726 |  |  |  |  | $abs_dir= $top_item;
727 |  |  |  |  | }
728 |  |  |  |  | }
729 |  |  |  |  |
730 |  |  |  |  | unless ($Is_Dir) {
731 |  |  |  |  | unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
732 |  |  |  |  | if ($Is_MacOS) {
733 |  |  |  |  | ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
734 |  |  |  |  | }
735 |  |  |  |  | else {
736 |  |  |  |  | ($dir,$_) = ('./', $top_item);
737 |  |  |  |  | }
738 |  |  |  |  | }
739 |  |  |  |  |
740 |  |  |  |  | $abs_dir = $dir;
741 |  |  |  |  | if (( $untaint ) && (is_tainted($dir) )) {
742 |  |  |  |  | ( $abs_dir ) = $dir =~ m|$untaint_pat|;
743 |  |  |  |  | unless (defined $abs_dir) {
744 |  |  |  |  | if ($untaint_skip == 0) {
745 |  |  |  |  | die "directory $dir is still tainted";
746 |  |  |  |  | }
747 |  |  |  |  | else {
748 |  |  |  |  | next Proc_Top_Item;
749 |  |  |  |  | }
750 |  |  |  |  | }
751 |  |  |  |  | }
752 |  |  |  |  |
753 |  |  |  |  | unless ($no_chdir || chdir $abs_dir) {
754 |  |  |  |  | warnings::warnif "Couldn't chdir $abs_dir: $!\n";
755 |  |  |  |  | next Proc_Top_Item;
756 |  |  |  |  | }
757 |  |  |  |  |
758 |  |  |  |  | $name = $abs_dir . $_; # $File::Find::name
759 |  |  |  |  | $_ = $name if $no_chdir;
760 |  |  |  |  |
761 |  |  |  |  | { $wanted_callback->() }; # protect against wild "next"
762 |  |  |  |  |
763 |  |  |  |  | }
764 |  |  |  |  |
765 |  |  |  |  | unless ( $no_chdir ) {
766 |  |  |  |  | if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
767 |  |  |  |  | ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
768 |  |  |  |  | unless (defined $cwd_untainted) {
769 |  |  |  |  | die "insecure cwd in find(depth)";
770 |  |  |  |  | }
771 |  |  |  |  | $check_t_cwd = 0;
772 |  |  |  |  | }
773 |  |  |  |  | unless (chdir $cwd_untainted) {
774 |  |  |  |  | die "Can't cd to $cwd: $!\n";
775 |  |  |  |  | }
776 |  |  |  |  | }
777 |  |  |  |  | }
778 |  |  |  |  | }
779 |  |  |  |  |
780 |  |  |  |  | # API:
781 |  |  |  |  | # $wanted
782 |  |  |  |  | # $p_dir : "parent directory"
783 |  |  |  |  | # $nlink : what came back from the stat
784 |  |  |  |  | # preconditions:
785 |  |  |  |  | # chdir (if not no_chdir) to dir
786 |  |  |  |  |
787 |  |  |  |  | sub _find_dir($$$) {
788 |  |  |  |  | my ($wanted, $p_dir, $nlink) = @_;
789 |  |  |  |  | my ($CdLvl,$Level) = (0,0);
790 |  |  |  |  | my @Stack;
791 |  |  |  |  | my @filenames;
792 |  |  |  |  | my ($subcount,$sub_nlink);
793 |  |  |  |  | my $SE= [];
794 |  |  |  |  | my $dir_name= $p_dir;
795 |  |  |  |  | my $dir_pref;
796 |  |  |  |  | my $dir_rel = $File::Find::current_dir;
797 |  |  |  |  | my $tainted = 0;
798 |  |  |  |  | my $no_nlink;
799 |  |  |  |  |
800 |  |  |  |  | if ($Is_MacOS) {
801 |  |  |  |  | $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
802 |  |  |  |  | } elsif ($^O eq 'MSWin32') {
803 |  |  |  |  | $dir_pref = ($p_dir =~ m|\w:/?$| ? $p_dir : "$p_dir/" );
804 |  |  |  |  | } elsif ($^O eq 'VMS') {
805 |  |  |  |  |
806 |  |  |  |  | # VMS is returning trailing .dir on directories
807 |  |  |  |  | # and trailing . on files and symbolic links
808 |  |  |  |  | # in UNIX syntax.
809 |  |  |  |  | #
810 |  |  |  |  |
811 |  |  |  |  | $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
812 |  |  |  |  |
813 |  |  |  |  | $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
814 |  |  |  |  | }
815 |  |  |  |  | else {
816 |  |  |  |  | $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
817 |  |  |  |  | }
818 |  |  |  |  |
819 |  |  |  |  | local ($dir, $name, $prune, *DIR);
820 |  |  |  |  |
821 |  |  |  |  | unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
822 |  |  |  |  | my $udir = $p_dir;
823 |  |  |  |  | if (( $untaint ) && (is_tainted($p_dir) )) {
824 |  |  |  |  | ( $udir ) = $p_dir =~ m|$untaint_pat|;
825 |  |  |  |  | unless (defined $udir) {
826 |  |  |  |  | if ($untaint_skip == 0) {
827 |  |  |  |  | die "directory $p_dir is still tainted";
828 |  |  |  |  | }
829 |  |  |  |  | else {
830 |  |  |  |  | return;
831 |  |  |  |  | }
832 |  |  |  |  | }
833 |  |  |  |  | }
834 |  |  |  |  | unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
835 |  |  |  |  | warnings::warnif "Can't cd to $udir: $!\n";
836 |  |  |  |  | return;
837 |  |  |  |  | }
838 |  |  |  |  | }
839 |  |  |  |  |
840 |  |  |  |  | # push the starting directory
841 |  |  |  |  | push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
842 |  |  |  |  |
843 |  |  |  |  | if ($Is_MacOS) {
844 |  |  |  |  | $p_dir = $dir_pref; # ensure trailing ':'
845 |  |  |  |  | }
846 |  |  |  |  |
847 |  |  |  |  | while (defined $SE) {
848 |  |  |  |  | unless ($bydepth) {
849 |  |  |  |  | $dir= $p_dir; # $File::Find::dir
850 |  |  |  |  | $name= $dir_name; # $File::Find::name
851 |  |  |  |  | $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
852 |  |  |  |  | # prune may happen here
853 |  |  |  |  | $prune= 0;
854 |  |  |  |  | { $wanted_callback->() }; # protect against wild "next"
855 |  |  |  |  | next if $prune;
856 |  |  |  |  | }
857 |  |  |  |  |
858 |  |  |  |  | # change to that directory
859 |  |  |  |  | unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
860 |  |  |  |  | my $udir= $dir_rel;
861 |  |  |  |  | if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
862 |  |  |  |  | ( $udir ) = $dir_rel =~ m|$untaint_pat|;
863 |  |  |  |  | unless (defined $udir) {
864 |  |  |  |  | if ($untaint_skip == 0) {
865 |  |  |  |  | if ($Is_MacOS) {
866 |  |  |  |  | die "directory ($p_dir) $dir_rel is still tainted";
867 |  |  |  |  | }
868 |  |  |  |  | else {
869 |  |  |  |  | die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
870 |  |  |  |  | }
871 |  |  |  |  | } else { # $untaint_skip == 1
872 |  |  |  |  | next;
873 |  |  |  |  | }
874 |  |  |  |  | }
875 |  |  |  |  | }
876 |  |  |  |  | unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
877 |  |  |  |  | if ($Is_MacOS) {
878 |  |  |  |  | warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
879 |  |  |  |  | }
880 |  |  |  |  | else {
881 |  |  |  |  | warnings::warnif "Can't cd to (" .
882 |  |  |  |  | ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
883 |  |  |  |  | }
884 |  |  |  |  | next;
885 |  |  |  |  | }
886 |  |  |  |  | $CdLvl++;
887 |  |  |  |  | }
888 |  |  |  |  |
889 |  |  |  |  | if ($Is_MacOS) {
890 |  |  |  |  | $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
891 |  |  |  |  | }
892 |  |  |  |  |
893 |  |  |  |  | $dir= $dir_name; # $File::Find::dir
894 |  |  |  |  |
895 |  |  |  |  | # Get the list of files in the current directory.
896 |  |  |  |  | unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
897 |  |  |  |  | warnings::warnif "Can't opendir($dir_name): $!\n";
898 |  |  |  |  | next;
899 |  |  |  |  | }
900 |  |  |  |  | @filenames = readdir DIR;
901 |  |  |  |  | closedir(DIR);
902 |  |  |  |  | @filenames = $pre_process->(@filenames) if $pre_process;
903 |  |  |  |  | push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
904 |  |  |  |  |
905 |  |  |  |  | # default: use whatever was specifid
906 |  |  |  |  | # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
907 |  |  |  |  | $no_nlink = $avoid_nlink;
908 |  |  |  |  | # if dir has wrong nlink count, force switch to slower stat method
909 |  |  |  |  | $no_nlink = 1 if ($nlink < 2);
910 |  |  |  |  |
911 |  |  |  |  | if ($nlink == 2 && !$no_nlink) {
912 |  |  |  |  | # This dir has no subdirectories.
913 |  |  |  |  | for my $FN (@filenames) {
914 |  |  |  |  | if ($Is_VMS) {
915 |  |  |  |  | # Big hammer here - Compensate for VMS trailing . and .dir
916 |  |  |  |  | # No win situation until this is changed, but this
917 |  |  |  |  | # will handle the majority of the cases with breaking the fewest
918 |  |  |  |  |
919 |  |  |  |  | $FN =~ s/\.dir\z//i;
920 |  |  |  |  | $FN =~ s#\.$## if ($FN ne '.');
921 |  |  |  |  | }
922 |  |  |  |  | next if $FN =~ $File::Find::skip_pattern;
923 |  |  |  |  |
924 |  |  |  |  | $name = $dir_pref . $FN; # $File::Find::name
925 |  |  |  |  | $_ = ($no_chdir ? $name : $FN); # $_
926 |  |  |  |  | { $wanted_callback->() }; # protect against wild "next"
927 |  |  |  |  | }
928 |  |  |  |  |
929 |  |  |  |  | }
930 |  |  |  |  | else {
931 |  |  |  |  | # This dir has subdirectories.
932 |  |  |  |  | $subcount = $nlink - 2;
933 |  |  |  |  |
934 |  |  |  |  | # HACK: insert directories at this position. so as to preserve
935 |  |  |  |  | # the user pre-processed ordering of files.
936 |  |  |  |  | # EG: directory traversal is in user sorted order, not at random.
937 |  |  |  |  | my $stack_top = @Stack;
938 |  |  |  |  |
939 |  |  |  |  | for my $FN (@filenames) {
940 |  |  |  |  | next if $FN =~ $File::Find::skip_pattern;
941 |  |  |  |  | if ($subcount > 0 || $no_nlink) {
942 |  |  |  |  | # Seen all the subdirs?
943 |  |  |  |  | # check for directoriness.
944 |  |  |  |  | # stat is faster for a file in the current directory
945 |  |  |  |  | $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
946 |  |  |  |  |
947 |  |  |  |  | if (-d _) {
948 |  |  |  |  | --$subcount;
949 |  |  |  |  | $FN =~ s/\.dir\z//i if $Is_VMS;
950 |  |  |  |  | # HACK: replace push to preserve dir traversal order
951 |  |  |  |  | #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
952 |  |  |  |  | splice @Stack, $stack_top, 0,
953 |  |  |  |  | [$CdLvl,$dir_name,$FN,$sub_nlink];
954 |  |  |  |  | }
955 |  |  |  |  | else {
956 |  |  |  |  | $name = $dir_pref . $FN; # $File::Find::name
957 |  |  |  |  | $_= ($no_chdir ? $name : $FN); # $_
958 |  |  |  |  | { $wanted_callback->() }; # protect against wild "next"
959 |  |  |  |  | }
960 |  |  |  |  | }
961 |  |  |  |  | else {
962 |  |  |  |  | $name = $dir_pref . $FN; # $File::Find::name
963 |  |  |  |  | $_= ($no_chdir ? $name : $FN); # $_
964 |  |  |  |  | { $wanted_callback->() }; # protect against wild "next"
965 |  |  |  |  | }
966 |  |  |  |  | }
967 |  |  |  |  | }
968 |  |  |  |  | }
969 |  |  |  |  | continue {
970 |  |  |  |  | while ( defined ($SE = pop @Stack) ) {
971 |  |  |  |  | ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
972 |  |  |  |  | if ($CdLvl > $Level && !$no_chdir) {
973 |  |  |  |  | my $tmp;
974 |  |  |  |  | if ($Is_MacOS) {
975 |  |  |  |  | $tmp = (':' x ($CdLvl-$Level)) . ':';
976 |  |  |  |  | }
977 |  |  |  |  | elsif ($Is_VMS) {
978 |  |  |  |  | $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
979 |  |  |  |  | }
980 |  |  |  |  | else {
981 |  |  |  |  | $tmp = join('/',('..') x ($CdLvl-$Level));
982 |  |  |  |  | }
983 |  |  |  |  | die "Can't cd to $tmp from $dir_name"
984 |  |  |  |  | unless chdir ($tmp);
985 |  |  |  |  | $CdLvl = $Level;
986 |  |  |  |  | }
987 |  |  |  |  |
988 |  |  |  |  | if ($Is_MacOS) {
989 |  |  |  |  | # $pdir always has a trailing ':', except for the starting dir,
990 |  |  |  |  | # where $dir_rel eq ':'
991 |  |  |  |  | $dir_name = "$p_dir$dir_rel";
992 |  |  |  |  | $dir_pref = "$dir_name:";
993 |  |  |  |  | }
994 |  |  |  |  | elsif ($^O eq 'MSWin32') {
995 |  |  |  |  | $dir_name = ($p_dir =~ m|\w:/?$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
996 |  |  |  |  | $dir_pref = "$dir_name/";
997 |  |  |  |  | }
998 |  |  |  |  | elsif ($^O eq 'VMS') {
999 |  |  |  |  | if ($p_dir =~ m/[\]>]+$/) {
1000 |  |  |  |  | $dir_name = $p_dir;
1001 |  |  |  |  | $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
1002 |  |  |  |  | $dir_pref = $dir_name;
1003 |  |  |  |  | }
1004 |  |  |  |  | else {
1005 |  |  |  |  | $dir_name = "$p_dir/$dir_rel";
1006 |  |  |  |  | $dir_pref = "$dir_name/";
1007 |  |  |  |  | }
1008 |  |  |  |  | }
1009 |  |  |  |  | else {
1010 |  |  |  |  | $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1011 |  |  |  |  | $dir_pref = "$dir_name/";
1012 |  |  |  |  | }
1013 |  |  |  |  |
1014 |  |  |  |  | if ( $nlink == -2 ) {
1015 |  |  |  |  | $name = $dir = $p_dir; # $File::Find::name / dir
1016 |  |  |  |  | $_ = $File::Find::current_dir;
1017 |  |  |  |  | $post_process->(); # End-of-directory processing
1018 |  |  |  |  | }
1019 |  |  |  |  | elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
1020 |  |  |  |  | $name = $dir_name;
1021 |  |  |  |  | if ($Is_MacOS) {
1022 |  |  |  |  | if ($dir_rel eq ':') { # must be the top dir, where we started
1023 |  |  |  |  | $name =~ s|:$||; # $File::Find::name
1024 |  |  |  |  | $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1025 |  |  |  |  | }
1026 |  |  |  |  | $dir = $p_dir; # $File::Find::dir
1027 |  |  |  |  | $_ = ($no_chdir ? $name : $dir_rel); # $_
1028 |  |  |  |  | }
1029 |  |  |  |  | else {
1030 |  |  |  |  | if ( substr($name,-2) eq '/.' ) {
1031 |  |  |  |  | substr($name, length($name) == 2 ? -1 : -2) = '';
1032 |  |  |  |  | }
1033 |  |  |  |  | $dir = $p_dir;
1034 |  |  |  |  | $_ = ($no_chdir ? $dir_name : $dir_rel );
1035 |  |  |  |  | if ( substr($_,-2) eq '/.' ) {
1036 |  |  |  |  | substr($_, length($_) == 2 ? -1 : -2) = '';
1037 |  |  |  |  | }
1038 |  |  |  |  | }
1039 |  |  |  |  | { $wanted_callback->() }; # protect against wild "next"
1040 |  |  |  |  | }
1041 |  |  |  |  | else {
1042 |  |  |  |  | push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
1043 |  |  |  |  | last;
1044 |  |  |  |  | }
1045 |  |  |  |  | }
1046 |  |  |  |  | }
1047 |  |  |  |  | }
1048 |  |  |  |  |
1049 |  |  |  |  |
1050 |  |  |  |  | # API:
1051 |  |  |  |  | # $wanted
1052 |  |  |  |  | # $dir_loc : absolute location of a dir
1053 |  |  |  |  | # $p_dir : "parent directory"
1054 |  |  |  |  | # preconditions:
1055 |  |  |  |  | # chdir (if not no_chdir) to dir
1056 |  |  |  |  |
1057 |  |  |  |  | # spent 1.42ms (146µs+1.28) within File::Find::_find_dir_symlnk which was called # once (146µs+1.28ms) by File::Find::_find_opt at line 710 sub _find_dir_symlnk($$$) {
1058 | 84 | 231µs |  |  | my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
1059 |  |  |  |  | my @Stack;
1060 |  |  |  |  | my @filenames;
1061 |  |  |  |  | my $new_loc;
1062 |  |  |  |  | my $updir_loc = $dir_loc; # untainted parent directory
1063 |  |  |  |  | my $SE = [];
1064 |  |  |  |  | my $dir_name = $p_dir;
1065 |  |  |  |  | my $dir_pref;
1066 |  |  |  |  | my $loc_pref;
1067 |  |  |  |  | my $dir_rel = $File::Find::current_dir;
1068 |  |  |  |  | my $byd_flag; # flag for pending stack entry if $bydepth
1069 |  |  |  |  | my $tainted = 0;
1070 |  |  |  |  | my $ok = 1;
1071 |  |  |  |  |
1072 |  |  |  |  | if ($Is_MacOS) {
1073 |  |  |  |  | $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
1074 |  |  |  |  | $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
1075 |  |  |  |  | } else {
1076 |  |  |  |  | $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
1077 |  |  |  |  | $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
1078 |  |  |  |  | }
1079 |  |  |  |  |
1080 |  |  |  |  | local ($dir, $name, $fullname, $prune, *DIR);
1081 |  |  |  |  |
1082 |  |  |  |  | unless ($no_chdir) {
1083 |  |  |  |  | # untaint the topdir
1084 |  |  |  |  | if (( $untaint ) && (is_tainted($dir_loc) )) {
1085 |  |  |  |  | ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1086 |  |  |  |  | # once untainted, $updir_loc is pushed on the stack (as parent directory);
1087 |  |  |  |  | # hence, we don't need to untaint the parent directory every time we chdir
1088 |  |  |  |  | # to it later
1089 |  |  |  |  | unless (defined $updir_loc) {
1090 |  |  |  |  | if ($untaint_skip == 0) {
1091 |  |  |  |  | die "directory $dir_loc is still tainted";
1092 |  |  |  |  | }
1093 |  |  |  |  | else {
1094 |  |  |  |  | return;
1095 |  |  |  |  | }
1096 |  |  |  |  | }
1097 |  |  |  |  | }
1098 |  |  |  |  | $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1099 |  |  |  |  | unless ($ok) {
1100 |  |  |  |  | warnings::warnif "Can't cd to $updir_loc: $!\n";
1101 |  |  |  |  | return;
1102 |  |  |  |  | }
1103 |  |  |  |  | }
1104 |  |  |  |  |
1105 |  |  |  |  | push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
1106 |  |  |  |  |
1107 |  |  |  |  | if ($Is_MacOS) {
1108 |  |  |  |  | $p_dir = $dir_pref; # ensure trailing ':'
1109 |  |  |  |  | }
1110 |  |  |  |  |
1111 |  |  |  |  | while (defined $SE) {
1112 |  |  |  |  |
1113 |  |  |  |  | unless ($bydepth) {
1114 |  |  |  |  | # change (back) to parent directory (always untainted)
1115 |  |  |  |  | unless ($no_chdir) {
1116 |  |  |  |  | unless (chdir $updir_loc) {
1117 |  |  |  |  | warnings::warnif "Can't cd to $updir_loc: $!\n";
1118 |  |  |  |  | next;
1119 |  |  |  |  | }
1120 |  |  |  |  | }
1121 |  |  |  |  | $dir= $p_dir; # $File::Find::dir
1122 |  |  |  |  | $name= $dir_name; # $File::Find::name
1123 |  |  |  |  | $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1124 |  |  |  |  | $fullname= $dir_loc; # $File::Find::fullname
1125 |  |  |  |  | # prune may happen here
1126 |  |  |  |  | $prune= 0;
1127 |  |  |  |  | lstat($_); # make sure file tests with '_' work # spent 4µs making 1 call to File::Find::CORE:lstat
1128 |  |  |  |  | { $wanted_callback->() }; # protect against wild "next" # spent 204µs making 1 call to Module::Find::_wanted
1129 |  |  |  |  | next if $prune;
1130 |  |  |  |  | }
1131 |  |  |  |  |
1132 |  |  |  |  | # change to that directory
1133 |  |  |  |  | unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1134 |  |  |  |  | $updir_loc = $dir_loc;
1135 |  |  |  |  | if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1136 |  |  |  |  | # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1137 |  |  |  |  | ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1138 |  |  |  |  | unless (defined $updir_loc) {
1139 |  |  |  |  | if ($untaint_skip == 0) {
1140 |  |  |  |  | die "directory $dir_loc is still tainted";
1141 |  |  |  |  | }
1142 |  |  |  |  | else {
1143 |  |  |  |  | next;
1144 |  |  |  |  | }
1145 |  |  |  |  | }
1146 |  |  |  |  | }
1147 |  |  |  |  | unless (chdir $updir_loc) {
1148 |  |  |  |  | warnings::warnif "Can't cd to $updir_loc: $!\n";
1149 |  |  |  |  | next;
1150 |  |  |  |  | }
1151 |  |  |  |  | }
1152 |  |  |  |  |
1153 |  |  |  |  | if ($Is_MacOS) {
1154 |  |  |  |  | $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1155 |  |  |  |  | }
1156 |  |  |  |  |
1157 |  |  |  |  | $dir = $dir_name; # $File::Find::dir
1158 |  |  |  |  |
1159 |  |  |  |  | # Get the list of files in the current directory.
1160 |  |  |  |  | unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) { # spent 30µs making 1 call to File::Find::CORE:open_dir
1161 |  |  |  |  | warnings::warnif "Can't opendir($dir_loc): $!\n";
1162 |  |  |  |  | next;
1163 |  |  |  |  | }
1164 |  |  |  |  | @filenames = readdir DIR; # spent 46µs making 1 call to File::Find::CORE:readdir
1165 |  |  |  |  | closedir(DIR); # spent 10µs making 1 call to File::Find::CORE:closedir
1166 |  |  |  |  |
1167 |  |  |  |  | for my $FN (@filenames) {
1168 |  |  |  |  | if ($Is_VMS) {
1169 |  |  |  |  | # Big hammer here - Compensate for VMS trailing . and .dir
1170 |  |  |  |  | # No win situation until this is changed, but this
1171 |  |  |  |  | # will handle the majority of the cases with breaking the fewest.
1172 |  |  |  |  |
1173 |  |  |  |  | $FN =~ s/\.dir\z//i;
1174 |  |  |  |  | $FN =~ s#\.$## if ($FN ne '.');
1175 |  |  |  |  | }
1176 |  |  |  |  | next if $FN =~ $File::Find::skip_pattern; # spent 8µs making 6 calls to File::Find::CORE:regcomp, avg 1µs/call # spent 4µs making 6 calls to File::Find::CORE:match, avg 667ns/call
1177 |  |  |  |  |
1178 |  |  |  |  | # follow symbolic links / do an lstat
1179 |  |  |  |  | $new_loc = Follow_SymLink($loc_pref.$FN); # spent 68µs making 4 calls to File::Find::Follow_SymLink, avg 17µs/call
1180 |  |  |  |  |
1181 |  |  |  |  | # ignore if invalid symlink
1182 |  |  |  |  | unless (defined $new_loc) {
1183 |  |  |  |  | if (!defined -l _ && $dangling_symlinks) {
1184 |  |  |  |  | if (ref $dangling_symlinks eq 'CODE') {
1185 |  |  |  |  | $dangling_symlinks->($FN, $dir_pref);
1186 |  |  |  |  | } else {
1187 |  |  |  |  | warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1188 |  |  |  |  | }
1189 |  |  |  |  | }
1190 |  |  |  |  |
1191 |  |  |  |  | $fullname = undef;
1192 |  |  |  |  | $name = $dir_pref . $FN;
1193 |  |  |  |  | $_ = ($no_chdir ? $name : $FN);
1194 |  |  |  |  | { $wanted_callback->() };
1195 |  |  |  |  | next;
1196 |  |  |  |  | }
1197 |  |  |  |  |
1198 |  |  |  |  | if (-d _) { # spent 1µs making 4 calls to File::Find::CORE:ftdir, avg 250ns/call
1199 |  |  |  |  | if ($Is_VMS) {
1200 |  |  |  |  | $FN =~ s/\.dir\z//i;
1201 |  |  |  |  | $FN =~ s#\.$## if ($FN ne '.');
1202 |  |  |  |  | $new_loc =~ s/\.dir\z//i;
1203 |  |  |  |  | $new_loc =~ s#\.$## if ($new_loc ne '.');
1204 |  |  |  |  | }
1205 |  |  |  |  | push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1206 |  |  |  |  | }
1207 |  |  |  |  | else {
1208 |  |  |  |  | $fullname = $new_loc; # $File::Find::fullname
1209 |  |  |  |  | $name = $dir_pref . $FN; # $File::Find::name
1210 |  |  |  |  | $_ = ($no_chdir ? $name : $FN); # $_
1211 |  |  |  |  | { $wanted_callback->() }; # protect against wild "next" # spent 901µs making 4 calls to Module::Find::_wanted, avg 225µs/call
1212 |  |  |  |  | }
1213 |  |  |  |  | }
1214 |  |  |  |  |
1215 |  |  |  |  | }
1216 |  |  |  |  | continue {
1217 |  |  |  |  | while (defined($SE = pop @Stack)) {
1218 |  |  |  |  | ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1219 |  |  |  |  | if ($Is_MacOS) {
1220 |  |  |  |  | # $p_dir always has a trailing ':', except for the starting dir,
1221 |  |  |  |  | # where $dir_rel eq ':'
1222 |  |  |  |  | $dir_name = "$p_dir$dir_rel";
1223 |  |  |  |  | $dir_pref = "$dir_name:";
1224 |  |  |  |  | $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1225 |  |  |  |  | }
1226 |  |  |  |  | else {
1227 |  |  |  |  | $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1228 |  |  |  |  | $dir_pref = "$dir_name/";
1229 |  |  |  |  | $loc_pref = "$dir_loc/";
1230 |  |  |  |  | }
1231 |  |  |  |  | if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1232 |  |  |  |  | unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1233 |  |  |  |  | unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1234 |  |  |  |  | warnings::warnif "Can't cd to $updir_loc: $!\n";
1235 |  |  |  |  | next;
1236 |  |  |  |  | }
1237 |  |  |  |  | }
1238 |  |  |  |  | $fullname = $dir_loc; # $File::Find::fullname
1239 |  |  |  |  | $name = $dir_name; # $File::Find::name
1240 |  |  |  |  | if ($Is_MacOS) {
1241 |  |  |  |  | if ($dir_rel eq ':') { # must be the top dir, where we started
1242 |  |  |  |  | $name =~ s|:$||; # $File::Find::name
1243 |  |  |  |  | $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1244 |  |  |  |  | }
1245 |  |  |  |  | $dir = $p_dir; # $File::Find::dir
1246 |  |  |  |  | $_ = ($no_chdir ? $name : $dir_rel); # $_
1247 |  |  |  |  | }
1248 |  |  |  |  | else {
1249 |  |  |  |  | if ( substr($name,-2) eq '/.' ) {
1250 |  |  |  |  | substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1251 |  |  |  |  | }
1252 |  |  |  |  | $dir = $p_dir; # $File::Find::dir
1253 |  |  |  |  | $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1254 |  |  |  |  | if ( substr($_,-2) eq '/.' ) {
1255 |  |  |  |  | substr($_, length($_) == 2 ? -1 : -2) = '';
1256 |  |  |  |  | }
1257 |  |  |  |  | }
1258 |  |  |  |  |
1259 |  |  |  |  | lstat($_); # make sure file tests with '_' work
1260 |  |  |  |  | { $wanted_callback->() }; # protect against wild "next"
1261 |  |  |  |  | }
1262 |  |  |  |  | else {
1263 |  |  |  |  | push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1264 |  |  |  |  | last;
1265 |  |  |  |  | }
1266 |  |  |  |  | }
1267 |  |  |  |  | }
1268 |  |  |  |  | }
1269 |  |  |  |  |
1270 |  |  |  |  |
1271 |  |  |  |  | # spent 10µs within File::Find::wrap_wanted which was called # once (10µs+0s) by File::Find::find at line 1297 sub wrap_wanted {
1272 | 6 | 12µs |  |  | my $wanted = shift;
1273 |  |  |  |  | if ( ref($wanted) eq 'HASH' ) {
1274 |  |  |  |  | unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
1275 |  |  |  |  | die 'no &wanted subroutine given';
1276 |  |  |  |  | }
1277 |  |  |  |  | if ( $wanted->{follow} || $wanted->{follow_fast}) {
1278 |  |  |  |  | $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1279 |  |  |  |  | }
1280 |  |  |  |  | if ( $wanted->{untaint} ) {
1281 |  |  |  |  | $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1282 |  |  |  |  | unless defined $wanted->{untaint_pattern};
1283 |  |  |  |  | $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1284 |  |  |  |  | }
1285 |  |  |  |  | return $wanted;
1286 |  |  |  |  | }
1287 |  |  |  |  | elsif( ref( $wanted ) eq 'CODE' ) {
1288 |  |  |  |  | return { wanted => $wanted };
1289 |  |  |  |  | }
1290 |  |  |  |  | else {
1291 |  |  |  |  | die 'no &wanted subroutine given';
1292 |  |  |  |  | }
1293 |  |  |  |  | }
1294 |  |  |  |  |
1295 |  |  |  |  | # spent 1.66ms (13µs+1.65) within File::Find::find which was called # once (13µs+1.65ms) by Module::Find::_find at line 191 of Module/Find.pm sub find {
1296 | 2 | 8µs |  |  | my $wanted = shift;
1297 |  |  |  |  | _find_opt(wrap_wanted($wanted), @_); # spent 1.64ms making 1 call to File::Find::_find_opt # spent 10µs making 1 call to File::Find::wrap_wanted
1298 |  |  |  |  | }
1299 |  |  |  |  |
1300 |  |  |  |  | sub finddepth {
1301 |  |  |  |  | my $wanted = wrap_wanted(shift);
1302 |  |  |  |  | $wanted->{bydepth} = 1;
1303 |  |  |  |  | _find_opt($wanted, @_);
1304 |  |  |  |  | }
1305 |  |  |  |  |
1306 |  |  |  |  | # default
1307 | 1 | 225µs | 1 | 5µs | $File::Find::skip_pattern = qr/^\.{1,2}\z/; # spent 5µs making 1 call to File::Find::CORE:qr
1308 | 1 | 6µs | 1 | 2µs | $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|; # spent 2µs making 1 call to File::Find::CORE:qr
1309 |  |  |  |  |
1310 |  |  |  |  | # These are hard-coded for now, but may move to hint files.
1311 | 1 | 2µs |  |  | if ($^O eq 'VMS') {
1312 |  |  |  |  | $Is_VMS = 1;
1313 |  |  |  |  | $File::Find::dont_use_nlink = 1;
1314 |  |  |  |  | }
1315 |  |  |  |  | elsif ($^O eq 'MacOS') {
1316 |  |  |  |  | $Is_MacOS = 1;
1317 |  |  |  |  | $File::Find::dont_use_nlink = 1;
1318 |  |  |  |  | $File::Find::skip_pattern = qr/^Icon\015\z/;
1319 |  |  |  |  | $File::Find::untaint_pattern = qr|^(.+)$|;
1320 |  |  |  |  | }
1321 |  |  |  |  |
1322 |  |  |  |  | # this _should_ work properly on all platforms
1323 |  |  |  |  | # where File::Find can be expected to work
1324 | 1 | 10µs | 1 | 2µs | $File::Find::current_dir = File::Spec->curdir || '.'; # spent 2µs making 1 call to File::Spec::Unix::curdir
1325 |  |  |  |  |
1326 | 1 | 3µs |  |  | $File::Find::dont_use_nlink = 1
1327 |  |  |  |  | if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1328 |  |  |  |  | $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1329 |  |  |  |  | $^O eq 'nto';
1330 |  |  |  |  |
1331 |  |  |  |  | # Set dont_use_nlink in your hint file if your system's stat doesn't
1332 |  |  |  |  | # report the number of links in a directory as an indication
1333 |  |  |  |  | # of the number of files.
1334 |  |  |  |  | # See, e.g. hints/machten.sh for MachTen 2.2.
1335 | 1 | 1µs |  |  | unless ($File::Find::dont_use_nlink) {
1336 | 1 | 900ns |  |  | require Config;
1337 | 1 | 5µs | 1 | 3µs | $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); # spent 3µs making 1 call to Config::FETCH
1338 |  |  |  |  | }
1339 |  |  |  |  |
1340 |  |  |  |  | # We need a function that checks if a scalar is tainted. Either use the
1341 |  |  |  |  | # Scalar::Util module's tainted() function or our (slower) pure Perl
1342 |  |  |  |  | # fallback is_tainted_pp()
1343 |  |  |  |  | {
1344 | 2 | 1µs |  |  | local $@;
1345 | 2 | 2µs |  |  | eval { require Scalar::Util };
1346 | 1 | 3µs |  |  | *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1347 |  |  |  |  | }
1348 |  |  |  |  |
1349 | 1 | 49µs |  |  | 1;
|  |  |  |  | # spent 10µs within File::Find::CORE:closedir which was called # once (10µs+0s) by File::Find::_find_dir_symlnk at line 1165 of File/Find.pm sub File::Find::CORE:closedir; # xsub
|  |  |  |  | # spent 1µs within File::Find::CORE:ftdir which was called 5 times, avg 260ns/call: # 4 times (1µs+0s) by File::Find::_find_dir_symlnk at line 1198 of File/Find.pm, avg 250ns/call # once (300ns+0s) by File::Find::_find_opt at line 708 of File/Find.pm sub File::Find::CORE:ftdir; # xsub
|  |  |  |  | # spent 2µs within File::Find::CORE:ftlink which was called 5 times, avg 460ns/call: # 5 times (2µs+0s) by File::Find::Follow_SymLink at line 545 of File/Find.pm, avg 460ns/call sub File::Find::CORE:ftlink; # xsub
|  |  |  |  | # spent 40µs within File::Find::CORE:lstat which was called 6 times, avg 7µs/call: # 5 times (36µs+0s) by File::Find::Follow_SymLink at line 543 of File/Find.pm, avg 7µs/call # once (4µs+0s) by File::Find::_find_dir_symlnk at line 1127 of File/Find.pm sub File::Find::CORE:lstat; # xsub
|  |  |  |  | # spent 4µs within File::Find::CORE:match which was called 6 times, avg 667ns/call: # 6 times (4µs+0s) by File::Find::_find_dir_symlnk at line 1176 of File/Find.pm, avg 667ns/call sub File::Find::CORE:match; # xsub
|  |  |  |  | # spent 30µs within File::Find::CORE:open_dir which was called # once (30µs+0s) by File::Find::_find_dir_symlnk at line 1160 of File/Find.pm sub File::Find::CORE:open_dir; # xsub
|  |  |  |  | # spent 7µs within File::Find::CORE:qr which was called 2 times, avg 4µs/call: # once (5µs+0s) by Module::Find::BEGIN@8 at line 1307 of File/Find.pm # once (2µs+0s) by Module::Find::BEGIN@8 at line 1308 of File/Find.pm sub File::Find::CORE:qr; # xsub
|  |  |  |  | # spent 46µs within File::Find::CORE:readdir which was called # once (46µs+0s) by File::Find::_find_dir_symlnk at line 1164 of File/Find.pm sub File::Find::CORE:readdir; # xsub
|  |  |  |  | # spent 8µs within File::Find::CORE:regcomp which was called 6 times, avg 1µs/call: # 6 times (8µs+0s) by File::Find::_find_dir_symlnk at line 1176 of File/Find.pm, avg 1µs/call sub File::Find::CORE:regcomp; # xsub
|  |  |  |  | # spent 5µs within File::Find::CORE:stat which was called # once (5µs+0s) by File::Find::_find_opt at line 653 of File/Find.pm sub File::Find::CORE:stat; # xsub
|  |  |  |  | # spent 3µs within File::Find::CORE:subst which was called 2 times, avg 2µs/call: # once (2µs+0s) by File::Find::contract_name at line 446 of File/Find.pm # once (900ns+0s) by File::Find::_find_opt at line 662 of File/Find.pm sub File::Find::CORE:subst; # xsub