Profile of File/ShareDir.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:22:35 2012

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

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 1.62ms | 1.85ms | File::ShareDir::::BEGIN@114File::ShareDir::BEGIN@114
2 | 1 | 1 | 71µs | 361µs | File::ShareDir::::_module_dir_newFile::ShareDir::_module_dir_new
1 | 1 | 1 | 60µs | 60µs | File::ShareDir::::BEGIN@108File::ShareDir::BEGIN@108
2 | 1 | 1 | 54µs | 258µs | File::ShareDir::::_module_dir_oldFile::ShareDir::_module_dir_old
14 | 2 | 1 | 44µs | 44µs | File::ShareDir::::CORE:ftdirFile::ShareDir::CORE:ftdir (opcode)
2 | 2 | 1 | 36µs | 953µs | File::ShareDir::::module_fileFile::ShareDir::module_file
4 | 2 | 1 | 31µs | 165µs | File::ShareDir::::_MODULEFile::ShareDir::_MODULE
2 | 1 | 1 | 21µs | 690µs | File::ShareDir::::module_dirFile::ShareDir::module_dir
1 | 1 | 1 | 19µs | 19µs | File::ShareDir::::BEGIN@117File::ShareDir::BEGIN@117
2 | 1 | 1 | 18µs | 33µs | File::ShareDir::::_FILEFile::ShareDir::_FILE
2 | 1 | 1 | 15µs | 15µs | File::ShareDir::::CORE:regcompFile::ShareDir::CORE:regcomp (opcode)
4 | 1 | 1 | 14µs | 25µs | File::ShareDir::::_CLASSFile::ShareDir::_CLASS
6 | 2 | 1 | 14µs | 14µs | File::ShareDir::::CORE:matchFile::ShareDir::CORE:match (opcode)
1 | 1 | 1 | 12µs | 65µs | File::ShareDir::::BEGIN@133File::ShareDir::BEGIN@133
1 | 1 | 1 | 11µs | 15µs | File::ShareDir::::BEGIN@109File::ShareDir::BEGIN@109
1 | 1 | 1 | 11µs | 22µs | File::ShareDir::::BEGIN@443File::ShareDir::BEGIN@443
4 | 2 | 1 | 10µs | 10µs | File::ShareDir::::CORE:ftereadFile::ShareDir::CORE:fteread (opcode)
2 | 1 | 1 | 9µs | 13µs | File::ShareDir::::_module_subdirFile::ShareDir::_module_subdir
2 | 1 | 1 | 8µs | 8µs | File::ShareDir::::CORE:ftisFile::ShareDir::CORE:ftis (opcode)
1 | 1 | 1 | 7µs | 62µs | File::ShareDir::::BEGIN@116File::ShareDir::BEGIN@116
2 | 1 | 1 | 4µs | 4µs | File::ShareDir::::CORE:substFile::ShareDir::CORE:subst (opcode)
1 | 1 | 1 | 4µs | 4µs | File::ShareDir::::BEGIN@110File::ShareDir::BEGIN@110
1 | 1 | 1 | 4µs | 4µs | File::ShareDir::::BEGIN@111File::ShareDir::BEGIN@111
1 | 1 | 1 | 4µs | 4µs | File::ShareDir::::BEGIN@112File::ShareDir::BEGIN@112
1 | 1 | 1 | 4µs | 4µs | File::ShareDir::::BEGIN@113File::ShareDir::BEGIN@113
0 | 0 | 0 | 0s | 0s | File::ShareDir::::_DISTFile::ShareDir::_DIST
0 | 0 | 0 | 0s | 0s | File::ShareDir::::_dist_dir_newFile::ShareDir::_dist_dir_new
0 | 0 | 0 | 0s | 0s | File::ShareDir::::_dist_dir_oldFile::ShareDir::_dist_dir_old
0 | 0 | 0 | 0s | 0s | File::ShareDir::::_dist_file_newFile::ShareDir::_dist_file_new
0 | 0 | 0 | 0s | 0s | File::ShareDir::::_dist_file_oldFile::ShareDir::_dist_file_old
0 | 0 | 0 | 0s | 0s | File::ShareDir::::_dist_packfileFile::ShareDir::_dist_packfile
0 | 0 | 0 | 0s | 0s | File::ShareDir::::class_fileFile::ShareDir::class_file
0 | 0 | 0 | 0s | 0s | File::ShareDir::::dist_dirFile::ShareDir::dist_dir
0 | 0 | 0 | 0s | 0s | File::ShareDir::::dist_fileFile::ShareDir::dist_file

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::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 use 5.005; # 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 use strict; # 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 use Carp (); # 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 use Config (); # 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 use Exporter (); # 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 use File::Spec (); # 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 use Class::Inspector (); # 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 use vars qw{ $VERSION @ISA @EXPORT_OK %EXPORT_TAGS }; # 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 BEGIN {
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 use constant IS_MACOS => !! ($^O eq 'MacOS'); # 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 sub module_dir {
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 sub _module_dir_new {
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 sub _module_dir_old {
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 sub module_file {
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 no strict 'refs'; # 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 sub _module_subdir {
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 sub _CLASS {
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 |  |  |  |  | # spent 165µs (31+134) within File::ShareDir::_MODULE which was called 4 times, avg 41µs/call: # 2 times (23µs+92µs) by File::ShareDir::module_file at line 389, avg 57µs/call # 2 times (8µs+43µs) by File::ShareDir::module_dir at line 238, avg 25µs/call 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 sub _FILE {
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
|  |  |  |  | # spent 44µs within File::ShareDir::CORE:ftdir which was called 14 times, avg 3µs/call: # 12 times (35µs+0s) by File::ShareDir::_module_dir_new at line 262, avg 3µs/call # 2 times (8µs+0s) by File::ShareDir::_module_dir_old at line 280, avg 4µs/call sub File::ShareDir::CORE:ftdir; # opcode
|  |  |  |  | # spent 10µs within File::ShareDir::CORE:fteread which was called 4 times, avg 3µs/call: # 2 times (6µs+0s) by File::ShareDir::_module_dir_old at line 283, avg 3µs/call # 2 times (5µs+0s) by File::ShareDir::module_file at line 396, avg 2µs/call 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:ftis; # opcode
|  |  |  |  | # spent 14µs within File::ShareDir::CORE:match which was called 6 times, avg 2µs/call: # 4 times (11µs+0s) by File::ShareDir::_CLASS at line 505, avg 3µs/call # 2 times (3µs+0s) by File::ShareDir::_module_dir_old at line 278, avg 2µ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 sub File::ShareDir::CORE:regcomp; # opcode
|  |  |  |  | # 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 sub File::ShareDir::CORE:subst; # opcode