| 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 | File::ShareDir::BEGIN@114 |
| 2 | 1 | 1 | 71µs | 361µs | File::ShareDir::_module_dir_new |
| 1 | 1 | 1 | 60µs | 60µs | File::ShareDir::BEGIN@108 |
| 2 | 1 | 1 | 54µs | 258µs | File::ShareDir::_module_dir_old |
| 14 | 2 | 1 | 44µs | 44µs | File::ShareDir::CORE:ftdir (opcode) |
| 2 | 2 | 1 | 36µs | 953µs | File::ShareDir::module_file |
| 4 | 2 | 1 | 31µs | 165µs | File::ShareDir::_MODULE |
| 2 | 1 | 1 | 21µs | 690µs | File::ShareDir::module_dir |
| 1 | 1 | 1 | 19µs | 19µs | File::ShareDir::BEGIN@117 |
| 2 | 1 | 1 | 18µs | 33µs | File::ShareDir::_FILE |
| 2 | 1 | 1 | 15µs | 15µs | File::ShareDir::CORE:regcomp (opcode) |
| 4 | 1 | 1 | 14µs | 25µs | File::ShareDir::_CLASS |
| 6 | 2 | 1 | 14µs | 14µs | File::ShareDir::CORE:match (opcode) |
| 1 | 1 | 1 | 12µs | 65µs | File::ShareDir::BEGIN@133 |
| 1 | 1 | 1 | 11µs | 15µs | File::ShareDir::BEGIN@109 |
| 1 | 1 | 1 | 11µs | 22µs | File::ShareDir::BEGIN@443 |
| 4 | 2 | 1 | 10µs | 10µs | File::ShareDir::CORE:fteread (opcode) |
| 2 | 1 | 1 | 9µs | 13µs | File::ShareDir::_module_subdir |
| 2 | 1 | 1 | 8µs | 8µs | File::ShareDir::CORE:ftis (opcode) |
| 1 | 1 | 1 | 7µs | 62µs | File::ShareDir::BEGIN@116 |
| 2 | 1 | 1 | 4µs | 4µs | File::ShareDir::CORE:subst (opcode) |
| 1 | 1 | 1 | 4µs | 4µs | File::ShareDir::BEGIN@110 |
| 1 | 1 | 1 | 4µs | 4µs | File::ShareDir::BEGIN@111 |
| 1 | 1 | 1 | 4µs | 4µs | File::ShareDir::BEGIN@112 |
| 1 | 1 | 1 | 4µs | 4µs | File::ShareDir::BEGIN@113 |
| 0 | 0 | 0 | 0s | 0s | File::ShareDir::_DIST |
| 0 | 0 | 0 | 0s | 0s | File::ShareDir::_dist_dir_new |
| 0 | 0 | 0 | 0s | 0s | File::ShareDir::_dist_dir_old |
| 0 | 0 | 0 | 0s | 0s | File::ShareDir::_dist_file_new |
| 0 | 0 | 0 | 0s | 0s | File::ShareDir::_dist_file_old |
| 0 | 0 | 0 | 0s | 0s | File::ShareDir::_dist_packfile |
| 0 | 0 | 0 | 0s | 0s | File::ShareDir::class_file |
| 0 | 0 | 0 | 0s | 0s | File::ShareDir::dist_dir |
| 0 | 0 | 0 | 0s | 0s | File::ShareDir::dist_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 # 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 |