File Coverage

blib/lib/File/ShareDir.pm
Criterion Covered Total %
statement 138 138 100.0
branch 51 56 91.0
condition 12 12 100.0
subroutine 30 30 100.0
pod 5 5 100.0
total 236 241 97.9


line stmt bran cond sub pod time 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             =begin html
10              
11             Travis CI
12             Coverage Status
13             Say Thanks
14              
15             =end html
16              
17             =head1 SYNOPSIS
18              
19             use File::ShareDir ':ALL';
20            
21             # Where are distribution-level shared data files kept
22             $dir = dist_dir('File-ShareDir');
23            
24             # Where are module-level shared data files kept
25             $dir = module_dir('File::ShareDir');
26            
27             # Find a specific file in our dist/module shared dir
28             $file = dist_file( 'File-ShareDir', 'file/name.txt');
29             $file = module_file('File::ShareDir', 'file/name.txt');
30            
31             # Like module_file, but search up the inheritance tree
32             $file = class_file( 'Foo::Bar', 'file/name.txt' );
33              
34             =head1 DESCRIPTION
35              
36             The intent of L is to provide a companion to
37             L and L, modules that take a
38             process that is well-known by advanced Perl developers but gets a
39             little tricky, and make it more available to the larger Perl community.
40              
41             Quite often you want or need your Perl module (CPAN or otherwise)
42             to have access to a large amount of read-only data that is stored
43             on the file-system at run-time.
44              
45             On a linux-like system, this would be in a place such as /usr/share,
46             however Perl runs on a wide variety of different systems, and so
47             the use of any one location is unreliable.
48              
49             Perl provides a little-known method for doing this, but almost
50             nobody is aware that it exists. As a result, module authors often
51             go through some very strange ways to make the data available to
52             their code.
53              
54             The most common of these is to dump the data out to an enormous
55             Perl data structure and save it into the module itself. The
56             result are enormous multi-megabyte .pm files that chew up a
57             lot of memory needlessly.
58              
59             Another method is to put the data "file" after the __DATA__ compiler
60             tag and limit yourself to access as a filehandle.
61              
62             The problem to solve is really quite simple.
63              
64             1. Write the data files to the system at install time.
65            
66             2. Know where you put them at run-time.
67              
68             Perl's install system creates an "auto" directory for both
69             every distribution and for every module file.
70              
71             These are used by a couple of different auto-loading systems
72             to store code fragments generated at install time, and various
73             other modules written by the Perl "ancient masters".
74              
75             But the same mechanism is available to any dist or module to
76             store any sort of data.
77              
78             =head2 Using Data in your Module
79              
80             C forms one half of a two part solution.
81              
82             Once the files have been installed to the correct directory,
83             you can use C to find your files again after
84             the installation.
85              
86             For the installation half of the solution, see L
87             and its C directive.
88              
89             Using L together with L
90             allows one to rely on the files in appropriate C
91             or C in development phase, too.
92              
93             =head1 FUNCTIONS
94              
95             C provides four functions for locating files and
96             directories.
97              
98             For greater maintainability, none of these are exported by default
99             and you are expected to name the ones you want at use-time, or provide
100             the C<':ALL'> tag. All of the following are equivalent.
101              
102             # Load but don't import, and then call directly
103             use File::ShareDir;
104             $dir = File::ShareDir::dist_dir('My-Dist');
105            
106             # Import a single function
107             use File::ShareDir 'dist_dir';
108             dist_dir('My-Dist');
109            
110             # Import all the functions
111             use File::ShareDir ':ALL';
112             dist_dir('My-Dist');
113              
114             All of the functions will check for you that the dir/file actually
115             exists, and that you have read permissions, or they will throw an
116             exception.
117              
118             =cut
119              
120 6     6   226711 use 5.005;
  6         54  
121 6     6   33 use strict;
  6         11  
  6         196  
122 6     6   38 use warnings;
  6         25  
  6         215  
123              
124 6     6   33 use base ('Exporter');
  6         12  
  6         1047  
125 6     6   47 use constant IS_MACOS => !!($^O eq 'MacOS');
  6         10  
  6         620  
126 6     6   41 use constant IS_WIN32 => !!($^O eq 'MSWin32');
  6         11  
  6         349  
127              
128 6     6   40 use Carp ();
  6         11  
  6         150  
129 6     6   33 use Exporter ();
  6         12  
  6         81  
130 6     6   25 use File::Spec ();
  6         32  
  6         156  
131 6     6   3278 use Class::Inspector ();
  6         21861  
  6         6244  
132              
133             our %DIST_SHARE;
134             our %MODULE_SHARE;
135              
136             our @CARP_NOT;
137             our @EXPORT_OK = qw{
138             dist_dir
139             dist_file
140             module_dir
141             module_file
142             class_dir
143             class_file
144             };
145             our %EXPORT_TAGS = (
146             ALL => [@EXPORT_OK],
147             );
148             our $VERSION = '1.118';
149              
150             #####################################################################
151             # Interface Functions
152              
153             =pod
154              
155             =head2 dist_dir
156              
157             # Get a distribution's shared files directory
158             my $dir = dist_dir('My-Distribution');
159              
160             The C function takes a single parameter of the name of an
161             installed (CPAN or otherwise) distribution, and locates the shared
162             data directory created at install time for it.
163              
164             Returns the directory path as a string, or dies if it cannot be
165             located or is not readable.
166              
167             =cut
168              
169             sub dist_dir
170             {
171 6     6 1 3684 my $dist = _DIST(shift);
172 6         16 my $dir;
173              
174             # Try the new version, then fall back to the legacy version
175 6   100     20 $dir = _dist_dir_new($dist) || _dist_dir_old($dist);
176              
177 6 100       41 return $dir if defined $dir;
178              
179             # Ran out of options
180 2         206 Carp::croak("Failed to find share dir for dist '$dist'");
181             }
182              
183             sub _dist_dir_new
184             {
185 12     12   21 my $dist = shift;
186              
187 12 100       38 return $DIST_SHARE{$dist} if exists $DIST_SHARE{$dist};
188              
189             # Create the subpath
190 10         93 my $path = File::Spec->catdir('auto', 'share', 'dist', $dist);
191              
192             # Find the full dir within @INC
193 10         32 return _search_inc_path($path);
194             }
195              
196             sub _dist_dir_old
197             {
198 8     8   20 my $dist = shift;
199              
200             # Create the subpath
201 8         56 my $path = File::Spec->catdir('auto', split(/-/, $dist),);
202              
203             # Find the full dir within @INC
204 8         28 return _search_inc_path($path);
205             }
206              
207             =pod
208              
209             =head2 module_dir
210              
211             # Get a module's shared files directory
212             my $dir = module_dir('My::Module');
213              
214             The C function takes a single parameter of the name of an
215             installed (CPAN or otherwise) module, and locates the shared data
216             directory created at install time for it.
217              
218             In order to find the directory, the module B be loaded when
219             calling this function.
220              
221             Returns the directory path as a string, or dies if it cannot be
222             located or is not readable.
223              
224             =cut
225              
226             sub module_dir
227             {
228 18     18 1 6783 my $module = _MODULE(shift);
229              
230 15 100       522 return $MODULE_SHARE{$module} if exists $MODULE_SHARE{$module};
231              
232             # Try the new version first, then fall back to the legacy version
233 13   100     45 return _module_dir_new($module) || _module_dir_old($module);
234             }
235              
236             sub _module_dir_new
237             {
238 13     13   21 my $module = shift;
239              
240             # Create the subpath
241 13         36 my $path = File::Spec->catdir('auto', 'share', 'module', _module_subdir($module),);
242              
243             # Find the full dir within @INC
244 13         43 return _search_inc_path($path);
245             }
246              
247             sub _module_dir_old
248             {
249 8     8   24 my $module = shift;
250 8         37 my $short = Class::Inspector->filename($module);
251 8         263 my $long = Class::Inspector->loaded_filename($module);
252 8         194 $short =~ tr{/}{:} if IS_MACOS;
253 8         11 $short =~ tr{\\} {/} if IS_WIN32;
254 8         11 $long =~ tr{\\} {/} if IS_WIN32;
255 8         21 substr($short, -3, 3, '');
256 8 100       251 $long =~ m/^(.*)\Q$short\E\.pm\z/s or Carp::croak("Failed to find base dir");
257 7         70 my $dir = File::Spec->catdir("$1", 'auto', $short);
258              
259 7 100       726 -d $dir or Carp::croak("Directory '$dir': No such directory");
260 3 50       51 -r $dir or Carp::croak("Directory '$dir': No read permission");
261              
262 3         30 return $dir;
263             }
264              
265             =pod
266              
267             =head2 dist_file
268              
269             # Find a file in our distribution shared dir
270             my $dir = dist_file('My-Distribution', 'file/name.txt');
271              
272             The C function takes two parameters of the distribution name
273             and file name, locates the dist directory, and then finds the file within
274             it, verifying that the file actually exists, and that it is readable.
275              
276             The filename should be a relative path in the format of your local
277             filesystem. It will simply added to the directory using L's
278             C method.
279              
280             Returns the file path as a string, or dies if the file or the dist's
281             directory cannot be located, or the file is not readable.
282              
283             =cut
284              
285             sub dist_file
286             {
287 6     6 1 3796 my $dist = _DIST(shift);
288 6         22 my $file = _FILE(shift);
289              
290             # Try the new version first, in doubt hand off to the legacy version
291 6   100     35 my $path = _dist_file_new($dist, $file) || _dist_file_old($dist, $file);
292 6 100       246 $path or Carp::croak("Failed to find shared file '$file' for dist '$dist'");
293              
294 4 100       165 -f $path or Carp::croak("File '$path': No such file");
295 3 50       78 -r $path or Carp::croak("File '$path': No read permission");
296              
297 3         37 return $path;
298             }
299              
300             sub _dist_file_new
301             {
302 6     6   13 my $dist = shift;
303 6         11 my $file = shift;
304              
305             # If it exists, what should the path be
306 6         19 my $dir = _dist_dir_new($dist);
307 6 100       28 return undef unless defined $dir;
308 3         39 my $path = File::Spec->catfile($dir, $file);
309              
310             # Does the file exist
311 3 100       72 return undef unless -e $path;
312              
313 2         11 return $path;
314             }
315              
316             sub _dist_file_old
317             {
318 4     4   10 my $dist = shift;
319 4         7 my $file = shift;
320              
321             # If it exists, what should the path be
322 4         9 my $dir = _dist_dir_old($dist);
323 4 100       17 return undef unless defined $dir;
324 3         28 my $path = File::Spec->catfile($dir, $file);
325              
326             # Does the file exist
327 3 100       76 return undef unless -e $path;
328              
329 2         11 return $path;
330             }
331              
332             =pod
333              
334             =head2 module_file
335              
336             # Find a file in our module shared dir
337             my $dir = module_file('My::Module', 'file/name.txt');
338              
339             The C function takes two parameters of the module name
340             and file name. It locates the module directory, and then finds the file
341             within it, verifying that the file actually exists, and that it is readable.
342              
343             In order to find the directory, the module B be loaded when
344             calling this function.
345              
346             The filename should be a relative path in the format of your local
347             filesystem. It will simply added to the directory using L's
348             C method.
349              
350             Returns the file path as a string, or dies if the file or the dist's
351             directory cannot be located, or the file is not readable.
352              
353             =cut
354              
355             sub module_file
356             {
357 4     4 1 3538 my $module = _MODULE(shift);
358 4         142 my $file = _FILE(shift);
359 4         12 my $dir = module_dir($module);
360 4         48 my $path = File::Spec->catfile($dir, $file);
361              
362 4 100       202 -e $path or Carp::croak("File '$path' does not exist in module dir");
363 3 50       58 -r $path or Carp::croak("File '$path': No read permission");
364              
365 3         29 return $path;
366             }
367              
368             =pod
369              
370             =head2 class_file
371              
372             # Find a file in our module shared dir, or in our parent class
373             my $dir = class_file('My::Module', 'file/name.txt');
374              
375             The C function takes two parameters of the module name
376             and file name. It locates the module directory, and then finds the file
377             within it, verifying that the file actually exists, and that it is readable.
378              
379             In order to find the directory, the module B be loaded when
380             calling this function.
381              
382             The filename should be a relative path in the format of your local
383             filesystem. It will simply added to the directory using L's
384             C method.
385              
386             If the file is NOT found for that module, C will scan up
387             the module's @ISA tree, looking for the file in all of the parent
388             classes.
389              
390             This allows you to, in effect, "subclass" shared files.
391              
392             Returns the file path as a string, or dies if the file or the dist's
393             directory cannot be located, or the file is not readable.
394              
395             =cut
396              
397             sub class_file
398             {
399 2     2 1 1344 my $module = _MODULE(shift);
400 2         65 my $file = _FILE(shift);
401              
402             # Get the super path ( not including UNIVERSAL )
403             # Rather than using Class::ISA, we'll use an inlined version
404             # that implements the same basic algorithm.
405 2         4 my @path = ();
406 2         8 my @queue = ($module);
407 2         6 my %seen = ($module => 1);
408 2         9 while (my $cl = shift @queue)
409             {
410 6         13 push @path, $cl;
411 6     6   62 no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict)
  6         12  
  6         4131  
412 4         23 unshift @queue, grep { !$seen{$_}++ }
413 6         9 map { my $s = $_; $s =~ s/^::/main::/; $s =~ s/\'/::/g; $s } (@{"${cl}::ISA"});
  4         9  
  4         6  
  4         7  
  4         10  
  6         29  
414             }
415              
416             # Search up the path
417 2         8 foreach my $class (@path)
418             {
419 5         11 my $dir = eval { module_dir($class); };
  5         14  
420 5 100       23 next if $@;
421 3         26 my $path = File::Spec->catfile($dir, $file);
422 3 100       58 -e $path or next;
423 1 50       18 -r $path or Carp::croak("File '$file' cannot be read, no read permissions");
424 1         8 return $path;
425             }
426 1         89 Carp::croak("File '$file' does not exist in class or parent shared files");
427             }
428              
429             ## no critic (BuiltinFunctions::ProhibitStringyEval)
430 6     6   3518 if (eval "use List::MoreUtils 0.428; 1;")
  6         77737  
  6         60  
431             {
432             List::MoreUtils->import("firstres");
433             }
434             else
435             {
436             ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
437             eval <<'END_OF_BORROWED_CODE';
438             sub firstres (&@)
439             {
440             my $test = shift;
441             foreach (@_)
442             {
443             my $testval = $test->();
444             $testval and return $testval;
445             }
446             return undef;
447             }
448             END_OF_BORROWED_CODE
449             }
450              
451             #####################################################################
452             # Support Functions
453              
454             sub _search_inc_path
455             {
456 31     31   85 my $path = shift;
457              
458             # Find the full dir within @INC
459             my $dir = firstres(
460             sub {
461 243     243   487 my $d;
462 243 100       1534 $d = File::Spec->catdir($_, $path) if defined _STRING($_);
463 243 100       3210 defined $d and -d $d ? $d : 0;
    100          
464             },
465             @INC
466 31 100       215 ) or return;
467              
468 13 50       240 Carp::croak("Found directory '$dir', but no read permissions") unless -r $dir;
469              
470 13         69 return $dir;
471             }
472              
473             sub _module_subdir
474             {
475 13     13   19 my $module = shift;
476 13         50 $module =~ s/::/-/g;
477 13         112 return $module;
478             }
479              
480             ## no critic (BuiltinFunctions::ProhibitStringyEval)
481 6     6   3324 if (eval "use Params::Util 1.07; 1;")
  6         23617  
  6         193  
482             {
483             Params::Util->import("_CLASS", "_STRING");
484             }
485             else
486             {
487             ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
488             eval <<'END_OF_BORROWED_CODE';
489             # Inlined from Params::Util pure perl version
490             sub _CLASS ($)
491             {
492             return (defined $_[0] and !ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s) ? $_[0] : undef;
493             }
494              
495             sub _STRING ($)
496             {
497             (defined $_[0] and ! ref $_[0] and length($_[0])) ? $_[0] : undef;
498             }
499             END_OF_BORROWED_CODE
500             }
501              
502             # Maintainer note: The following private functions are used by
503             # File::ShareDir::PAR. (It has to or else it would have to copy&fork)
504             # So if you significantly change or even remove them, please
505             # notify the File::ShareDir::PAR maintainer(s). Thank you!
506              
507             # Matches a valid distribution name
508             ### This is a total guess at this point
509             sub _DIST ## no critic (Subroutines::RequireArgUnpacking)
510             {
511 16 100 100 16   3338 defined _STRING($_[0]) and $_[0] =~ /^[a-z0-9+_-]+$/is and return $_[0];
512 2         349 Carp::croak("Not a valid distribution name");
513             }
514              
515             # A valid and loaded module name
516             sub _MODULE
517             {
518 26 100   26   7170 my $module = _CLASS(shift) or Carp::croak("Not a valid module name");
519 24 100       321 Class::Inspector->loaded($module) and return $module;
520 1         186 Carp::croak("Module '$module' is not loaded");
521             }
522              
523             # A valid file name
524             sub _FILE
525             {
526 14     14   1336 my $file = shift;
527 14 100       137 _STRING($file) or Carp::croak("Did not pass a file name");
528 13 100       192 File::Spec->file_name_is_absolute($file) and Carp::croak("Cannot use absolute file name '$file'");
529 12         31 return $file;
530             }
531              
532             1;
533              
534             =pod
535              
536             =head1 EXTENDING
537              
538             =head2 Overriding Directory Resolution
539              
540             C has two convenience hashes for people who have advanced usage
541             requirements of C such as using uninstalled C
542             directories during development.
543              
544             #
545             # Dist-Name => /absolute/path/for/DistName/share/dir
546             #
547             %File::ShareDir::DIST_SHARE
548              
549             #
550             # Module::Name => /absolute/path/for/Module/Name/share/dir
551             #
552             %File::ShareDir::MODULE_SHARE
553              
554             Setting these values any time before the corresponding calls
555              
556             dist_dir('Dist-Name')
557             dist_file('Dist-Name','some/file');
558              
559             module_dir('Module::Name');
560             module_file('Module::Name','some/file');
561              
562             Will override the base directory for resolving those calls.
563              
564             An example of where this would be useful is in a test for a module that
565             depends on files installed into a share directory, to enable the tests
566             to use the development copy without needing to install them first.
567              
568             use File::ShareDir;
569             use Cwd qw( getcwd );
570             use File::Spec::Functions qw( rel2abs catdir );
571              
572             $File::ShareDir::MODULE_SHARE{'Foo::Module'} = rel2abs(catfile(getcwd,'share'));
573              
574             use Foo::Module;
575              
576             # internal calls in Foo::Module to module_file('Foo::Module','bar') now resolves to
577             # the source trees share/ directory instead of something in @INC
578              
579             =head1 SUPPORT
580              
581             Bugs should always be submitted via the CPAN request tracker, see below.
582              
583             You can find documentation for this module with the perldoc command.
584              
585             perldoc File::ShareDir
586              
587             You can also look for information at:
588              
589             =over 4
590              
591             =item * RT: CPAN's request tracker
592              
593             L
594              
595             =item * AnnoCPAN: Annotated CPAN documentation
596              
597             L
598              
599             =item * CPAN Ratings
600              
601             L
602              
603             =item * CPAN Search
604              
605             L
606              
607             =back
608              
609             =head2 Where can I go for other help?
610              
611             If you have a bug report, a patch or a suggestion, please open a new
612             report ticket at CPAN (but please check previous reports first in case
613             your issue has already been addressed).
614              
615             Report tickets should contain a detailed description of the bug or
616             enhancement request and at least an easily verifiable way of
617             reproducing the issue or fix. Patches are always welcome, too.
618              
619             =head2 Where can I go for help with a concrete version?
620              
621             Bugs and feature requests are accepted against the latest version
622             only. To get patches for earlier versions, you need to get an
623             agreement with a developer of your choice - who may or not report the
624             issue and a suggested fix upstream (depends on the license you have
625             chosen).
626              
627             =head2 Business support and maintenance
628              
629             For business support you can contact the maintainer via his CPAN
630             email address. Please keep in mind that business support is neither
631             available for free nor are you eligible to receive any support
632             based on the license distributed with this package.
633              
634             =head1 AUTHOR
635              
636             Adam Kennedy Eadamk@cpan.orgE
637              
638             =head2 MAINTAINER
639              
640             Jens Rehsack Erehsack@cpan.orgE
641              
642             =head1 SEE ALSO
643              
644             L,
645             L, L,
646             L, L,
647             L, L
648              
649             =head1 COPYRIGHT
650              
651             Copyright 2005 - 2011 Adam Kennedy,
652             Copyright 2014 - 2018 Jens Rehsack.
653              
654             This program is free software; you can redistribute
655             it and/or modify it under the same terms as Perl itself.
656              
657             The full text of the license can be found in the
658             LICENSE file included with this module.
659              
660             =cut