Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/File/ShareDir.pm |
Statements | Executed 149 statements in 1.97ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 1.62ms | 1.85ms | BEGIN@114 | File::ShareDir::
2 | 1 | 1 | 71µs | 361µs | _module_dir_new | File::ShareDir::
1 | 1 | 1 | 60µs | 60µs | BEGIN@108 | File::ShareDir::
2 | 1 | 1 | 54µs | 258µs | _module_dir_old | File::ShareDir::
14 | 2 | 1 | 44µs | 44µs | CORE:ftdir (opcode) | File::ShareDir::
2 | 2 | 1 | 36µs | 953µs | module_file | File::ShareDir::
4 | 2 | 1 | 31µs | 165µs | _MODULE | File::ShareDir::
2 | 1 | 1 | 21µs | 690µs | module_dir | File::ShareDir::
1 | 1 | 1 | 19µs | 19µs | BEGIN@117 | File::ShareDir::
2 | 1 | 1 | 18µs | 33µs | _FILE | File::ShareDir::
2 | 1 | 1 | 15µs | 15µs | CORE:regcomp (opcode) | File::ShareDir::
4 | 1 | 1 | 14µs | 25µs | _CLASS | File::ShareDir::
6 | 2 | 1 | 14µs | 14µs | CORE:match (opcode) | File::ShareDir::
1 | 1 | 1 | 12µs | 65µs | BEGIN@133 | File::ShareDir::
1 | 1 | 1 | 11µs | 15µs | BEGIN@109 | File::ShareDir::
1 | 1 | 1 | 11µs | 22µs | BEGIN@443 | File::ShareDir::
4 | 2 | 1 | 10µs | 10µs | CORE:fteread (opcode) | File::ShareDir::
2 | 1 | 1 | 9µs | 13µs | _module_subdir | File::ShareDir::
2 | 1 | 1 | 8µs | 8µs | CORE:ftis (opcode) | File::ShareDir::
1 | 1 | 1 | 7µs | 62µs | BEGIN@116 | File::ShareDir::
2 | 1 | 1 | 4µs | 4µs | CORE:subst (opcode) | File::ShareDir::
1 | 1 | 1 | 4µs | 4µs | BEGIN@110 | File::ShareDir::
1 | 1 | 1 | 4µs | 4µs | BEGIN@111 | File::ShareDir::
1 | 1 | 1 | 4µs | 4µs | BEGIN@112 | File::ShareDir::
1 | 1 | 1 | 4µs | 4µs | BEGIN@113 | File::ShareDir::
0 | 0 | 0 | 0s | 0s | _DIST | File::ShareDir::
0 | 0 | 0 | 0s | 0s | _dist_dir_new | File::ShareDir::
0 | 0 | 0 | 0s | 0s | _dist_dir_old | File::ShareDir::
0 | 0 | 0 | 0s | 0s | _dist_file_new | File::ShareDir::
0 | 0 | 0 | 0s | 0s | _dist_file_old | File::ShareDir::
0 | 0 | 0 | 0s | 0s | _dist_packfile | File::ShareDir::
0 | 0 | 0 | 0s | 0s | class_file | File::ShareDir::
0 | 0 | 0 | 0s | 0s | dist_dir | File::ShareDir::
0 | 0 | 0 | 0s | 0s | dist_file | File::ShareDir::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package File::ShareDir; | ||||
2 | |||||
3 | =pod | ||||
4 | |||||
5 | =head1 NAME | ||||
6 | |||||
7 | File::ShareDir - Locate per-dist and per-module shared files | ||||
8 | |||||
9 | =head1 SYNOPSIS | ||||
10 | |||||
11 | use File::ShareDir ':ALL'; | ||||
12 | |||||
13 | # Where are distribution-level shared data files kept | ||||
14 | $dir = dist_dir('File-ShareDir'); | ||||
15 | |||||
16 | # Where are module-level shared data files kept | ||||
17 | $dir = module_dir('File::ShareDir'); | ||||
18 | |||||
19 | # Find a specific file in our dist/module shared dir | ||||
20 | $file = dist_file( 'File-ShareDir', 'file/name.txt'); | ||||
21 | $file = module_file('File::ShareDir', 'file/name.txt'); | ||||
22 | |||||
23 | # Like module_file, but search up the inheritance tree | ||||
24 | $file = class_file( 'Foo::Bar', 'file/name.txt' ); | ||||
25 | |||||
26 | =head1 DESCRIPTION | ||||
27 | |||||
28 | The intent of L<File::ShareDir> is to provide a companion to | ||||
29 | L<Class::Inspector> and L<File::HomeDir>, modules that take a | ||||
30 | process that is well-known by advanced Perl developers but gets a | ||||
31 | little tricky, and make it more available to the larger Perl community. | ||||
32 | |||||
33 | Quite often you want or need your Perl module (CPAN or otherwise) | ||||
34 | to have access to a large amount of read-only data that is stored | ||||
35 | on the file-system at run-time. | ||||
36 | |||||
37 | On a linux-like system, this would be in a place such as /usr/share, | ||||
38 | however Perl runs on a wide variety of different systems, and so | ||||
39 | the use of any one location is unreliable. | ||||
40 | |||||
41 | Perl provides a little-known method for doing this, but almost | ||||
42 | nobody is aware that it exists. As a result, module authors often | ||||
43 | go through some very strange ways to make the data available to | ||||
44 | their code. | ||||
45 | |||||
46 | The most common of these is to dump the data out to an enormous | ||||
47 | Perl data structure and save it into the module itself. The | ||||
48 | result are enormous multi-megabyte .pm files that chew up a | ||||
49 | lot of memory needlessly. | ||||
50 | |||||
51 | Another method is to put the data "file" after the __DATA__ compiler | ||||
52 | tag and limit yourself to access as a filehandle. | ||||
53 | |||||
54 | The problem to solve is really quite simple. | ||||
55 | |||||
56 | 1. Write the data files to the system at install time. | ||||
57 | |||||
58 | 2. Know where you put them at run-time. | ||||
59 | |||||
60 | Perl's install system creates an "auto" directory for both | ||||
61 | every distribution and for every module file. | ||||
62 | |||||
63 | These are used by a couple of different auto-loading systems | ||||
64 | to store code fragments generated at install time, and various | ||||
65 | other modules written by the Perl "ancient masters". | ||||
66 | |||||
67 | But the same mechanism is available to any dist or module to | ||||
68 | store any sort of data. | ||||
69 | |||||
70 | =head2 Using Data in your Module | ||||
71 | |||||
72 | C<File::ShareDir> forms one half of a two part solution. | ||||
73 | |||||
74 | Once the files have been installed to the correct directory, | ||||
75 | you can use C<File::ShareDir> to find your files again after | ||||
76 | the installation. | ||||
77 | |||||
78 | For the installation half of the solution, see L<Module::Install> | ||||
79 | and its C<install_share> directive. | ||||
80 | |||||
81 | =head1 FUNCTIONS | ||||
82 | |||||
83 | C<File::ShareDir> provides four functions for locating files and | ||||
84 | directories. | ||||
85 | |||||
86 | For greater maintainability, none of these are exported by default | ||||
87 | and you are expected to name the ones you want at use-time, or provide | ||||
88 | the C<':ALL'> tag. All of the following are equivalent. | ||||
89 | |||||
90 | # Load but don't import, and then call directly | ||||
91 | use File::ShareDir; | ||||
92 | $dir = File::ShareDir::dist_dir('My-Dist'); | ||||
93 | |||||
94 | # Import a single function | ||||
95 | use File::ShareDir 'dist_dir'; | ||||
96 | dist_dir('My-Dist'); | ||||
97 | |||||
98 | # Import all the functions | ||||
99 | use File::ShareDir ':ALL'; | ||||
100 | dist_dir('My-Dist'); | ||||
101 | |||||
102 | All of the functions will check for you that the dir/file actually | ||||
103 | exists, and that you have read permissions, or they will throw an | ||||
104 | exception. | ||||
105 | |||||
106 | =cut | ||||
107 | |||||
108 | 3 | 69µs | 1 | 60µs | # spent 60µs within File::ShareDir::BEGIN@108 which was called:
# once (60µs+0s) by Tapper::Config::BEGIN@17 at line 108 # spent 60µs making 1 call to File::ShareDir::BEGIN@108 |
109 | 3 | 21µs | 2 | 19µs | # spent 15µs (11+4) within File::ShareDir::BEGIN@109 which was called:
# once (11µs+4µs) by Tapper::Config::BEGIN@17 at line 109 # spent 15µs making 1 call to File::ShareDir::BEGIN@109
# spent 4µs making 1 call to strict::import |
110 | 3 | 15µs | 1 | 4µs | # spent 4µs within File::ShareDir::BEGIN@110 which was called:
# once (4µs+0s) by Tapper::Config::BEGIN@17 at line 110 # spent 4µs making 1 call to File::ShareDir::BEGIN@110 |
111 | 3 | 15µs | 1 | 4µs | # spent 4µs within File::ShareDir::BEGIN@111 which was called:
# once (4µs+0s) by Tapper::Config::BEGIN@17 at line 111 # spent 4µs making 1 call to File::ShareDir::BEGIN@111 |
112 | 3 | 14µs | 1 | 4µs | # spent 4µs within File::ShareDir::BEGIN@112 which was called:
# once (4µs+0s) by Tapper::Config::BEGIN@17 at line 112 # spent 4µs making 1 call to File::ShareDir::BEGIN@112 |
113 | 3 | 14µs | 1 | 4µs | # spent 4µs within File::ShareDir::BEGIN@113 which was called:
# once (4µs+0s) by Tapper::Config::BEGIN@17 at line 113 # spent 4µs making 1 call to File::ShareDir::BEGIN@113 |
114 | 3 | 104µs | 1 | 1.85ms | # spent 1.85ms (1.62+233µs) within File::ShareDir::BEGIN@114 which was called:
# once (1.62ms+233µs) by Tapper::Config::BEGIN@17 at line 114 # spent 1.85ms making 1 call to File::ShareDir::BEGIN@114 |
115 | |||||
116 | 3 | 51µs | 2 | 118µs | # spent 62µs (7+56) within File::ShareDir::BEGIN@116 which was called:
# once (7µs+56µs) by Tapper::Config::BEGIN@17 at line 116 # spent 62µs making 1 call to File::ShareDir::BEGIN@116
# spent 56µs making 1 call to vars::import |
117 | # spent 19µs within File::ShareDir::BEGIN@117 which was called:
# once (19µs+0s) by Tapper::Config::BEGIN@17 at line 131 | ||||
118 | 4 | 19µs | $VERSION = '1.03'; | ||
119 | @ISA = qw{ Exporter }; | ||||
120 | @EXPORT_OK = qw{ | ||||
121 | dist_dir | ||||
122 | dist_file | ||||
123 | module_dir | ||||
124 | module_file | ||||
125 | class_dir | ||||
126 | class_file | ||||
127 | }; | ||||
128 | %EXPORT_TAGS = ( | ||||
129 | ALL => [ @EXPORT_OK ], | ||||
130 | ); | ||||
131 | 1 | 24µs | 1 | 19µs | } # spent 19µs making 1 call to File::ShareDir::BEGIN@117 |
132 | |||||
133 | 3 | 834µs | 2 | 119µs | # spent 65µs (12+54) within File::ShareDir::BEGIN@133 which was called:
# once (12µs+54µs) by Tapper::Config::BEGIN@17 at line 133 # spent 65µs making 1 call to File::ShareDir::BEGIN@133
# spent 54µs making 1 call to constant::import |
134 | |||||
- - | |||||
139 | ##################################################################### | ||||
140 | # Interface Functions | ||||
141 | |||||
142 | =pod | ||||
143 | |||||
144 | =head2 dist_dir | ||||
145 | |||||
146 | # Get a distribution's shared files directory | ||||
147 | my $dir = dist_dir('My-Distribution'); | ||||
148 | |||||
149 | The C<dist_dir> function takes a single parameter of the name of an | ||||
150 | installed (CPAN or otherwise) distribution, and locates the shared | ||||
151 | data directory created at install time for it. | ||||
152 | |||||
153 | Returns the directory path as a string, or dies if it cannot be | ||||
154 | located or is not readable. | ||||
155 | |||||
156 | =cut | ||||
157 | |||||
158 | sub dist_dir { | ||||
159 | my $dist = _DIST(shift); | ||||
160 | my $dir; | ||||
161 | |||||
162 | # Try the new version | ||||
163 | $dir = _dist_dir_new( $dist ); | ||||
164 | return $dir if defined $dir; | ||||
165 | |||||
166 | # Fall back to the legacy version | ||||
167 | $dir = _dist_dir_old( $dist ); | ||||
168 | return $dir if defined $dir; | ||||
169 | |||||
170 | # Ran out of options | ||||
171 | Carp::croak("Failed to find share dir for dist '$dist'"); | ||||
172 | } | ||||
173 | |||||
174 | sub _dist_dir_new { | ||||
175 | my $dist = shift; | ||||
176 | |||||
177 | # Create the subpath | ||||
178 | my $path = File::Spec->catdir( | ||||
179 | 'auto', 'share', 'dist', $dist, | ||||
180 | ); | ||||
181 | |||||
182 | # Find the full dir withing @INC | ||||
183 | foreach my $inc ( @INC ) { | ||||
184 | next unless defined $inc and ! ref $inc; | ||||
185 | my $dir = File::Spec->catdir( $inc, $path ); | ||||
186 | next unless -d $dir; | ||||
187 | unless ( -r $dir ) { | ||||
188 | Carp::croak("Found directory '$dir', but no read permissions"); | ||||
189 | } | ||||
190 | return $dir; | ||||
191 | } | ||||
192 | |||||
193 | return undef; | ||||
194 | } | ||||
195 | |||||
196 | sub _dist_dir_old { | ||||
197 | my $dist = shift; | ||||
198 | |||||
199 | # Create the subpath | ||||
200 | my $path = File::Spec->catdir( | ||||
201 | 'auto', split( /-/, $dist ), | ||||
202 | ); | ||||
203 | |||||
204 | # Find the full dir within @INC | ||||
205 | foreach my $inc ( @INC ) { | ||||
206 | next unless defined $inc and ! ref $inc; | ||||
207 | my $dir = File::Spec->catdir( $inc, $path ); | ||||
208 | next unless -d $dir; | ||||
209 | unless ( -r $dir ) { | ||||
210 | Carp::croak("Found directory '$dir', but no read permissions"); | ||||
211 | } | ||||
212 | return $dir; | ||||
213 | } | ||||
214 | |||||
215 | return undef; | ||||
216 | } | ||||
217 | |||||
218 | =pod | ||||
219 | |||||
220 | =head2 module_dir | ||||
221 | |||||
222 | # Get a module's shared files directory | ||||
223 | my $dir = module_dir('My::Module'); | ||||
224 | |||||
225 | The C<module_dir> function takes a single parameter of the name of an | ||||
226 | installed (CPAN or otherwise) module, and locates the shared data | ||||
227 | directory created at install time for it. | ||||
228 | |||||
229 | In order to find the directory, the module B<must> be loaded when | ||||
230 | calling this function. | ||||
231 | |||||
232 | Returns the directory path as a string, or dies if it cannot be | ||||
233 | located or is not readable. | ||||
234 | |||||
235 | =cut | ||||
236 | |||||
237 | # spent 690µs (21+669) within File::ShareDir::module_dir which was called 2 times, avg 345µs/call:
# 2 times (21µs+669µs) by File::ShareDir::module_file at line 391, avg 345µs/call | ||||
238 | 10 | 14µs | 2 | 51µs | my $module = _MODULE(shift); # spent 51µs making 2 calls to File::ShareDir::_MODULE, avg 25µs/call |
239 | my $dir; | ||||
240 | |||||
241 | # Try the new version | ||||
242 | 2 | 361µs | $dir = _module_dir_new( $module ); # spent 361µs making 2 calls to File::ShareDir::_module_dir_new, avg 180µs/call | ||
243 | return $dir if defined $dir; | ||||
244 | |||||
245 | # Fall back to the legacy version | ||||
246 | 2 | 258µs | return _module_dir_old( $module ); # spent 258µs making 2 calls to File::ShareDir::_module_dir_old, avg 129µs/call | ||
247 | } | ||||
248 | |||||
249 | # spent 361µs (71+290) within File::ShareDir::_module_dir_new which was called 2 times, avg 180µs/call:
# 2 times (71µs+290µs) by File::ShareDir::module_dir at line 242, avg 180µs/call | ||||
250 | 44 | 97µs | my $module = shift; | ||
251 | |||||
252 | # Create the subpath | ||||
253 | 4 | 75µs | my $path = File::Spec->catdir( # spent 62µs making 2 calls to File::Spec::Unix::catdir, avg 31µs/call
# spent 13µs making 2 calls to File::ShareDir::_module_subdir, avg 7µs/call | ||
254 | 'auto', 'share', 'module', | ||||
255 | _module_subdir( $module ), | ||||
256 | ); | ||||
257 | |||||
258 | # Find the full dir withing @INC | ||||
259 | foreach my $inc ( @INC ) { | ||||
260 | next unless defined $inc and ! ref $inc; | ||||
261 | 12 | 180µs | my $dir = File::Spec->catdir( $inc, $path ); # spent 180µs making 12 calls to File::Spec::Unix::catdir, avg 15µs/call | ||
262 | 12 | 35µs | next unless -d $dir; # spent 35µs making 12 calls to File::ShareDir::CORE:ftdir, avg 3µs/call | ||
263 | unless ( -r $dir ) { | ||||
264 | Carp::croak("Found directory '$dir', but no read permissions"); | ||||
265 | } | ||||
266 | return $dir; | ||||
267 | } | ||||
268 | |||||
269 | return undef; | ||||
270 | } | ||||
271 | |||||
272 | # spent 258µs (54+204) within File::ShareDir::_module_dir_old which was called 2 times, avg 129µs/call:
# 2 times (54µs+204µs) by File::ShareDir::module_dir at line 246, avg 129µs/call | ||||
273 | 20 | 81µs | my $module = shift; | ||
274 | 2 | 102µs | my $short = Class::Inspector->filename($module); # spent 102µs making 2 calls to Class::Inspector::filename, avg 51µs/call | ||
275 | 2 | 36µs | my $long = Class::Inspector->loaded_filename($module); # spent 36µs making 2 calls to Class::Inspector::loaded_filename, avg 18µs/call | ||
276 | $short =~ tr{/}{:} if IS_MACOS; | ||||
277 | substr( $short, -3, 3, '' ); | ||||
278 | 4 | 18µs | $long =~ m/^(.*)\Q$short\E\.pm\z/s or die("Failed to find base dir"); # spent 15µs making 2 calls to File::ShareDir::CORE:regcomp, avg 7µs/call
# spent 3µs making 2 calls to File::ShareDir::CORE:match, avg 2µs/call | ||
279 | 2 | 34µs | my $dir = File::Spec->catdir( "$1", 'auto', $short ); # spent 34µs making 2 calls to File::Spec::Unix::catdir, avg 17µs/call | ||
280 | 2 | 8µs | unless ( -d $dir ) { # spent 8µs making 2 calls to File::ShareDir::CORE:ftdir, avg 4µs/call | ||
281 | Carp::croak("Directory '$dir', does not exist"); | ||||
282 | } | ||||
283 | 2 | 6µs | unless ( -r $dir ) { # spent 6µs making 2 calls to File::ShareDir::CORE:fteread, avg 3µs/call | ||
284 | Carp::croak("Directory '$dir', no read permissions"); | ||||
285 | } | ||||
286 | return $dir; | ||||
287 | } | ||||
288 | |||||
289 | =pod | ||||
290 | |||||
291 | =head2 dist_file | ||||
292 | |||||
293 | # Find a file in our distribution shared dir | ||||
294 | my $dir = dist_file('My-Distribution', 'file/name.txt'); | ||||
295 | |||||
296 | The C<dist_file> function takes two params of the distribution name | ||||
297 | and file name, locates the dist dir, and then finds the file within | ||||
298 | it, verifying that the file actually exists, and that it is readable. | ||||
299 | |||||
300 | The filename should be a relative path in the format of your local | ||||
301 | filesystem. It will simply added to the directory using L<File::Spec>'s | ||||
302 | C<catfile> method. | ||||
303 | |||||
304 | Returns the file path as a string, or dies if the file or the dist's | ||||
305 | directory cannot be located, or the file is not readable. | ||||
306 | |||||
307 | =cut | ||||
308 | |||||
309 | sub dist_file { | ||||
310 | my $dist = _DIST(shift); | ||||
311 | my $file = _FILE(shift); | ||||
312 | |||||
313 | # Try the new version first | ||||
314 | my $path = _dist_file_new( $dist, $file ); | ||||
315 | return $path if defined $path; | ||||
316 | |||||
317 | # Hand off to the legacy version | ||||
318 | return _dist_file_old( $dist, $file );; | ||||
319 | } | ||||
320 | |||||
321 | sub _dist_file_new { | ||||
322 | my $dist = shift; | ||||
323 | my $file = shift; | ||||
324 | |||||
325 | # If it exists, what should the path be | ||||
326 | my $dir = _dist_dir_new( $dist ); | ||||
327 | my $path = File::Spec->catfile( $dir, $file ); | ||||
328 | |||||
329 | # Does the file exist | ||||
330 | return undef unless -e $path; | ||||
331 | unless ( -f $path ) { | ||||
332 | Carp::croak("Found dist_file '$path', but not a file"); | ||||
333 | } | ||||
334 | unless ( -r $path ) { | ||||
335 | Carp::croak("File '$path', no read permissions"); | ||||
336 | } | ||||
337 | |||||
338 | return $path; | ||||
339 | } | ||||
340 | |||||
341 | sub _dist_file_old { | ||||
342 | my $dist = shift; | ||||
343 | my $file = shift; | ||||
344 | |||||
345 | # Create the subpath | ||||
346 | my $path = File::Spec->catfile( | ||||
347 | 'auto', split( /-/, $dist ), $file, | ||||
348 | ); | ||||
349 | |||||
350 | # Find the full dir withing @INC | ||||
351 | foreach my $inc ( @INC ) { | ||||
352 | next unless defined $inc and ! ref $inc; | ||||
353 | my $full = File::Spec->catdir( $inc, $path ); | ||||
354 | next unless -e $full; | ||||
355 | unless ( -r $full ) { | ||||
356 | Carp::croak("Directory '$full', no read permissions"); | ||||
357 | } | ||||
358 | return $full; | ||||
359 | } | ||||
360 | |||||
361 | # Couldn't find it | ||||
362 | Carp::croak("Failed to find shared file '$file' for dist '$dist'"); | ||||
363 | } | ||||
364 | |||||
365 | =pod | ||||
366 | |||||
367 | =head2 module_file | ||||
368 | |||||
369 | # Find a file in our module shared dir | ||||
370 | my $dir = module_file('My::Module', 'file/name.txt'); | ||||
371 | |||||
372 | The C<module_file> function takes two params of the module name | ||||
373 | and file name. It locates the module dir, and then finds the file within | ||||
374 | it, verifying that the file actually exists, and that it is readable. | ||||
375 | |||||
376 | In order to find the directory, the module B<must> be loaded when | ||||
377 | calling this function. | ||||
378 | |||||
379 | The filename should be a relative path in the format of your local | ||||
380 | filesystem. It will simply added to the directory using L<File::Spec>'s | ||||
381 | C<catfile> method. | ||||
382 | |||||
383 | Returns the file path as a string, or dies if the file or the dist's | ||||
384 | directory cannot be located, or the file is not readable. | ||||
385 | |||||
386 | =cut | ||||
387 | |||||
388 | # spent 953µs (36+917) within File::ShareDir::module_file which was called 2 times, avg 477µs/call:
# once (21µs+536µs) by Tapper::Config::_switch_context at line 71 of Tapper/Config.pm
# once (15µs+381µs) by Tapper::Config::_prepare_special_entries at line 82 of Tapper/Config.pm | ||||
389 | 14 | 45µs | 2 | 114µs | my $module = _MODULE(shift); # spent 114µs making 2 calls to File::ShareDir::_MODULE, avg 57µs/call |
390 | 2 | 33µs | my $file = _FILE(shift); # spent 33µs making 2 calls to File::ShareDir::_FILE, avg 17µs/call | ||
391 | 2 | 690µs | my $dir = module_dir($module); # spent 690µs making 2 calls to File::ShareDir::module_dir, avg 345µs/call | ||
392 | 2 | 66µs | my $path = File::Spec->catfile($dir, $file); # spent 66µs making 2 calls to File::Spec::Unix::catfile, avg 33µs/call | ||
393 | 2 | 8µs | unless ( -e $path ) { # spent 8µs making 2 calls to File::ShareDir::CORE:ftis, avg 4µs/call | ||
394 | Carp::croak("File '$file' does not exist in module dir"); | ||||
395 | } | ||||
396 | 2 | 5µs | unless ( -r $path ) { # spent 5µs making 2 calls to File::ShareDir::CORE:fteread, avg 2µs/call | ||
397 | Carp::croak("File '$file' cannot be read, no read permissions"); | ||||
398 | } | ||||
399 | $path; | ||||
400 | } | ||||
401 | |||||
402 | =pod | ||||
403 | |||||
404 | =head2 class_file | ||||
405 | |||||
406 | # Find a file in our module shared dir, or in our parent class | ||||
407 | my $dir = class_file('My::Module', 'file/name.txt'); | ||||
408 | |||||
409 | The C<module_file> function takes two params of the module name | ||||
410 | and file name. It locates the module dir, and then finds the file within | ||||
411 | it, verifying that the file actually exists, and that it is readable. | ||||
412 | |||||
413 | In order to find the directory, the module B<must> be loaded when | ||||
414 | calling this function. | ||||
415 | |||||
416 | The filename should be a relative path in the format of your local | ||||
417 | filesystem. It will simply added to the directory using L<File::Spec>'s | ||||
418 | C<catfile> method. | ||||
419 | |||||
420 | If the file is NOT found for that module, C<class_file> will scan up | ||||
421 | the module's @ISA tree, looking for the file in all of the parent | ||||
422 | classes. | ||||
423 | |||||
424 | This allows you to, in effect, "subclass" shared files. | ||||
425 | |||||
426 | Returns the file path as a string, or dies if the file or the dist's | ||||
427 | directory cannot be located, or the file is not readable. | ||||
428 | |||||
429 | =cut | ||||
430 | |||||
431 | sub class_file { | ||||
432 | my $module = _MODULE(shift); | ||||
433 | my $file = _FILE(shift); | ||||
434 | |||||
435 | # Get the super path ( not including UNIVERSAL ) | ||||
436 | # Rather than using Class::ISA, we'll use an inlined version | ||||
437 | # that implements the same basic algorithm. | ||||
438 | my @path = (); | ||||
439 | my @queue = ( $module ); | ||||
440 | my %seen = ( $module => 1 ); | ||||
441 | while ( my $cl = shift @queue ) { | ||||
442 | push @path, $cl; | ||||
443 | 3 | 456µs | 2 | 33µs | # spent 22µs (11+11) within File::ShareDir::BEGIN@443 which was called:
# once (11µs+11µs) by Tapper::Config::BEGIN@17 at line 443 # spent 22µs making 1 call to File::ShareDir::BEGIN@443
# spent 11µs making 1 call to strict::unimport |
444 | unshift @queue, grep { ! $seen{$_}++ } | ||||
445 | map { s/^::/main::/; s/\'/::/g; $_ } | ||||
446 | ( @{"${cl}::ISA"} ); | ||||
447 | } | ||||
448 | |||||
449 | # Search up the path | ||||
450 | foreach my $class ( @path ) { | ||||
451 | local $@; | ||||
452 | my $dir = eval { | ||||
453 | module_dir($class); | ||||
454 | }; | ||||
455 | next if $@; | ||||
456 | my $path = File::Spec->catfile($dir, $file); | ||||
457 | unless ( -e $path ) { | ||||
458 | next; | ||||
459 | } | ||||
460 | unless ( -r $path ) { | ||||
461 | Carp::croak("File '$file' cannot be read, no read permissions"); | ||||
462 | } | ||||
463 | return $path; | ||||
464 | } | ||||
465 | Carp::croak("File '$file' does not exist in class or parent shared files"); | ||||
466 | } | ||||
467 | |||||
- - | |||||
471 | ##################################################################### | ||||
472 | # Support Functions | ||||
473 | |||||
474 | # spent 13µs (9+4) within File::ShareDir::_module_subdir which was called 2 times, avg 7µs/call:
# 2 times (9µs+4µs) by File::ShareDir::_module_dir_new at line 253, avg 7µs/call | ||||
475 | 6 | 16µs | my $module = shift; | ||
476 | 2 | 4µs | $module =~ s/::/-/g; # spent 4µs making 2 calls to File::ShareDir::CORE:subst, avg 2µs/call | ||
477 | return $module; | ||||
478 | } | ||||
479 | |||||
480 | sub _dist_packfile { | ||||
481 | my $module = shift; | ||||
482 | my @dirs = grep { -e } ( $Config::Config{archlibexp}, $Config::Config{sitearchexp} ); | ||||
483 | my $file = File::Spec->catfile( | ||||
484 | 'auto', split( /::/, $module), '.packlist', | ||||
485 | ); | ||||
486 | |||||
487 | foreach my $dir ( @dirs ) { | ||||
488 | my $path = File::Spec->catfile( $dir, $file ); | ||||
489 | next unless -f $path; | ||||
490 | |||||
491 | # Load the file | ||||
492 | my $packlist = ExtUtils::Packlist->new($path); | ||||
493 | unless ( $packlist ) { | ||||
494 | die "Failed to load .packlist file for $module"; | ||||
495 | } | ||||
496 | |||||
497 | die "CODE INCOMPLETE"; | ||||
498 | } | ||||
499 | |||||
500 | die "CODE INCOMPLETE"; | ||||
501 | } | ||||
502 | |||||
503 | # Inlined from Params::Util pure perl version | ||||
504 | # spent 25µs (14+11) within File::ShareDir::_CLASS which was called 4 times, avg 6µs/call:
# 4 times (14µs+11µs) by File::ShareDir::_MODULE at line 525, avg 6µs/call | ||||
505 | 4 | 33µs | 4 | 11µs | (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s) ? $_[0] : undef; # spent 11µs making 4 calls to File::ShareDir::CORE:match, avg 3µs/call |
506 | } | ||||
507 | |||||
508 | |||||
509 | # Maintainer note: The following private functions are used by | ||||
510 | # File::ShareDir::PAR. (It has to or else it would have to copy&fork) | ||||
511 | # So if you significantly change or even remove them, please | ||||
512 | # notify the File::ShareDir::PAR maintainer(s). Thank you! | ||||
513 | |||||
514 | # Matches a valid distribution name | ||||
515 | ### This is a total guess at this point | ||||
516 | sub _DIST { | ||||
517 | if ( defined $_[0] and ! ref $_[0] and $_[0] =~ /^[a-z0-9+_-]+$/is ) { | ||||
518 | return shift; | ||||
519 | } | ||||
520 | Carp::croak("Not a valid distribution name"); | ||||
521 | } | ||||
522 | |||||
523 | # A valid and loaded module name | ||||
524 | sub _MODULE { | ||||
525 | 8 | 25µs | 4 | 25µs | my $module = _CLASS(shift) or Carp::croak("Not a valid module name"); # spent 25µs making 4 calls to File::ShareDir::_CLASS, avg 6µs/call |
526 | 4 | 109µs | if ( Class::Inspector->loaded($module) ) { # spent 109µs making 4 calls to Class::Inspector::loaded, avg 27µs/call | ||
527 | return $module; | ||||
528 | } | ||||
529 | Carp::croak("Module '$module' is not loaded"); | ||||
530 | } | ||||
531 | |||||
532 | # A valid file name | ||||
533 | # spent 33µs (18+16) within File::ShareDir::_FILE which was called 2 times, avg 17µs/call:
# 2 times (18µs+16µs) by File::ShareDir::module_file at line 390, avg 17µs/call | ||||
534 | 8 | 18µs | my $file = shift; | ||
535 | unless ( defined $file and ! ref $file and length $file ) { | ||||
536 | Carp::croak("Did not pass a file name"); | ||||
537 | } | ||||
538 | 2 | 16µs | if ( File::Spec->file_name_is_absolute($file) ) { # spent 16µs making 2 calls to File::Spec::Unix::file_name_is_absolute, avg 8µs/call | ||
539 | Carp::croak("Cannot use absolute file name '$file'"); | ||||
540 | } | ||||
541 | $file; | ||||
542 | } | ||||
543 | |||||
544 | 1 | 3µs | 1; | ||
545 | |||||
546 | =pod | ||||
547 | |||||
548 | =head1 SUPPORT | ||||
549 | |||||
550 | Bugs should always be submitted via the CPAN bug tracker | ||||
551 | |||||
552 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-ShareDir> | ||||
553 | |||||
554 | For other issues, contact the maintainer. | ||||
555 | |||||
556 | =head1 AUTHOR | ||||
557 | |||||
558 | Adam Kennedy E<lt>adamk@cpan.orgE<gt> | ||||
559 | |||||
560 | =head1 SEE ALSO | ||||
561 | |||||
562 | L<File::HomeDir>, L<Module::Install>, L<Module::Install::Share>, | ||||
563 | L<File::ShareDir::PAR> | ||||
564 | |||||
565 | =head1 COPYRIGHT | ||||
566 | |||||
567 | Copyright 2005 - 2011 Adam Kennedy. | ||||
568 | |||||
569 | This program is free software; you can redistribute | ||||
570 | it and/or modify it under the same terms as Perl itself. | ||||
571 | |||||
572 | The full text of the license can be found in the | ||||
573 | LICENSE file included with this module. | ||||
574 | |||||
575 | =cut | ||||
sub File::ShareDir::CORE:ftdir; # opcode | |||||
sub File::ShareDir::CORE:fteread; # opcode | |||||
# spent 8µs within File::ShareDir::CORE:ftis which was called 2 times, avg 4µs/call:
# 2 times (8µs+0s) by File::ShareDir::module_file at line 393, avg 4µs/call | |||||
sub File::ShareDir::CORE:match; # opcode | |||||
# spent 15µs within File::ShareDir::CORE:regcomp which was called 2 times, avg 7µs/call:
# 2 times (15µs+0s) by File::ShareDir::_module_dir_old at line 278, avg 7µs/call | |||||
# spent 4µs within File::ShareDir::CORE:subst which was called 2 times, avg 2µs/call:
# 2 times (4µs+0s) by File::ShareDir::_module_subdir at line 476, avg 2µs/call |