local-lib5/lib/perl5/File/ShareDir.pm

   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 use 5.005;
 109 use strict;
 110 use Carp             'croak';
 111 use Config           ();
 112 use Exporter         ();
 113 use File::Spec       ();
 114 use Params::Util     '_CLASS';
 115 use Class::Inspector ();
 116
 117 use vars qw{$VERSION @ISA @EXPORT_OK %EXPORT_TAGS};
 118 BEGIN {
 119         $VERSION     = '1.01';
 120         @ISA         = qw{ Exporter };
 121         @EXPORT_OK   = qw{
 122                 dist_dir dist_file
 123                 module_dir module_file
 124                 class_dir class_file
 125         };
 126         %EXPORT_TAGS = (
 127                 ALL => [ @EXPORT_OK ],
 128         );
 129 }
 130
 131 use constant IS_MACOS => !!($^O eq 'MacOS');
 132
 133
 134
 135
 136
 137 #####################################################################
 138 # Interface Functions
 139
 140 =pod
 141
 142 =head2 dist_dir
 143
 144   # Get a distribution's shared files directory
 145   my $dir = dist_dir('My-Distribution');
 146
 147 The C<dist_dir> function takes a single parameter of the name of an
 148 installed (CPAN or otherwise) distribution, and locates the shared
 149 data directory created at install time for it.
 150
 151 Returns the directory path as a string, or dies if it cannot be
 152 located or is not readable.
 153
 154 =cut
 155
 156 sub dist_dir {
 157         my $dist = _DIST(shift);
 158         my $dir;
 159
 160         # Try the new version
 161         $dir = _dist_dir_new( $dist );
 162         return $dir if defined $dir;
 163
 164         # Fall back to the legacy version
 165         $dir = _dist_dir_old( $dist );
 166         return $dir if defined $dir;
 167
 168         # Ran out of options
 169         croak("Failed to find share dir for dist '$dist'");
 170 }
 171
 172 sub _dist_dir_new {
 173         my $dist = shift;
 174
 175         # Create the subpath
 176         my $path = File::Spec->catdir(
 177                 'auto', 'share', 'dist', $dist,
 178         );
 179
 180         # Find the full dir withing @INC
 181         foreach my $inc ( @INC ) {
 182                 next unless defined $inc and ! ref $inc;
 183                 my $dir = File::Spec->catdir( $inc, $path );
 184                 next unless -d $dir;
 185                 unless ( -r $dir ) {
 186                         croak("Found directory '$dir', but no read permissions");
 187                 }
 188                 return $dir;
 189         }
 190
 191         return undef;
 192 }
 193
 194 sub _dist_dir_old {
 195         my $dist = shift;
 196
 197         # Create the subpath
 198         my $path = File::Spec->catdir(
 199                 'auto', split( /-/, $dist ),
 200         );
 201
 202         # Find the full dir within @INC
 203         foreach my $inc ( @INC ) {
 204                 next unless defined $inc and ! ref $inc;
 205                 my $dir = File::Spec->catdir( $inc, $path );
 206                 next unless -d $dir;
 207                 unless ( -r $dir ) {
 208                         croak("Found directory '$dir', but no read permissions");
 209                 }
 210                 return $dir;
 211         }
 212
 213         return undef;
 214 }
 215
 216 =pod
 217
 218 =head2 module_dir
 219
 220   # Get a module's shared files directory
 221   my $dir = module_dir('My::Module');
 222
 223 The C<module_dir> function takes a single parameter of the name of an
 224 installed (CPAN or otherwise) module, and locates the shared data
 225 directory created at install time for it.
 226
 227 In order to find the directory, the module B<must> be loaded when
 228 calling this function.
 229
 230 Returns the directory path as a string, or dies if it cannot be
 231 located or is not readable.
 232
 233 =cut
 234
 235 sub module_dir {
 236         my $module = _MODULE(shift);
 237         my $dir;
 238
 239         # Try the new version
 240         $dir = _module_dir_new( $module );
 241         return $dir if defined $dir;
 242
 243         # Fall back to the legacy version
 244         return _module_dir_old( $module );
 245 }
 246
 247 sub _module_dir_new {
 248         my $module = shift;
 249
 250         # Create the subpath
 251         my $path = File::Spec->catdir(
 252                 'auto', 'share', 'module',
 253                 _module_subdir( $module ),
 254         );
 255
 256         # Find the full dir withing @INC
 257         foreach my $inc ( @INC ) {
 258                 next unless defined $inc and ! ref $inc;
 259                 my $dir = File::Spec->catdir( $inc, $path );
 260                 next unless -d $dir;
 261                 unless ( -r $dir ) {
 262                         croak("Found directory '$dir', but no read permissions");
 263                 }
 264                 return $dir;
 265         }
 266
 267         return undef;
 268 }
 269
 270 sub _module_dir_old {
 271         my $module = shift;
 272         my $short  = Class::Inspector->filename($module);
 273         my $long   = Class::Inspector->loaded_filename($module);
 274         $short =~ tr{/}{:} if IS_MACOS;
 275         substr( $short, -3, 3, '' );
 276         $long  =~ m/^(.*)\Q$short\E\.pm\z/s or die("Failed to find base dir");
 277         my $dir = File::Spec->catdir( "$1", 'auto', $short );
 278         unless ( -d $dir ) {
 279                 croak("Directory '$dir', does not exist");
 280         }
 281         unless ( -r $dir ) {
 282                 croak("Directory '$dir', no read permissions");
 283         }
 284         return $dir;
 285 }
 286
 287 =pod
 288
 289 =head2 dist_file
 290
 291   # Find a file in our distribution shared dir
 292   my $dir = dist_file('My-Distribution', 'file/name.txt');
 293
 294 The C<dist_file> function takes two params of the distribution name
 295 and file name, locates the dist dir, and then finds the file within
 296 it, verifying that the file actually exists, and that it is readable.
 297
 298 The filename should be a relative path in the format of your local
 299 filesystem. It will simply added to the directory using L<File::Spec>'s
 300 C<catfile> method.
 301
 302 Returns the file path as a string, or dies if the file or the dist's
 303 directory cannot be located, or the file is not readable.
 304
 305 =cut
 306
 307 sub dist_file {
 308         my $dist = _DIST(shift);
 309         my $file = _FILE(shift);
 310
 311         # Try the new version first
 312         my $path = _dist_file_new( $dist, $file );
 313         return $path if defined $path;
 314
 315         # Hand off to the legacy version
 316         return _dist_file_old( $dist, $file );;
 317 }
 318
 319 sub _dist_file_new {
 320         my $dist = shift;
 321         my $file = shift;
 322
 323         # If it exists, what should the path be
 324         my $dir  = _dist_dir_new( $dist );
 325         my $path = File::Spec->catfile( $dir, $file );
 326
 327         # Does the file exist
 328         return undef unless -e $path;
 329         unless ( -f $path ) {
 330                 croak("Found dist_file '$path', but not a file");
 331         }
 332         unless ( -r $path ) {
 333                 croak("File '$path', no read permissions");
 334         }
 335
 336         return $path;
 337 }
 338
 339 sub _dist_file_old {
 340         my $dist = shift;
 341         my $file = shift;
 342
 343         # Create the subpath
 344         my $path = File::Spec->catfile(
 345                 'auto', split( /-/, $dist ), $file,
 346         );
 347
 348         # Find the full dir withing @INC
 349         foreach my $inc ( @INC ) {
 350                 next unless defined $inc and ! ref $inc;
 351                 my $full = File::Spec->catdir( $inc, $path );
 352                 next unless -e $full;
 353                 unless ( -r $full ) {
 354                         croak("Directory '$full', no read permissions");
 355                 }
 356                 return $full;
 357         }
 358
 359         # Couldn't find it
 360         croak("Failed to find shared file '$file' for dist '$dist'");
 361 }
 362
 363 =pod
 364
 365 =head2 module_file
 366
 367   # Find a file in our module shared dir
 368   my $dir = module_file('My::Module', 'file/name.txt');
 369
 370 The C<module_file> function takes two params of the module name
 371 and file name. It locates the module dir, and then finds the file within
 372 it, verifying that the file actually exists, and that it is readable.
 373
 374 In order to find the directory, the module B<must> be loaded when
 375 calling this function.
 376
 377 The filename should be a relative path in the format of your local
 378 filesystem. It will simply added to the directory using L<File::Spec>'s
 379 C<catfile> method.
 380
 381 Returns the file path as a string, or dies if the file or the dist's
 382 directory cannot be located, or the file is not readable.
 383
 384 =cut
 385
 386 sub module_file {
 387         my $module = _MODULE(shift);
 388         my $file   = _FILE(shift);
 389         my $dir    = module_dir($module);
 390         my $path   = File::Spec->catfile($dir, $file);
 391         unless ( -e $path ) {
 392                 croak("File '$file' does not exist in module dir");
 393         }
 394         unless ( -r $path ) {
 395                 croak("File '$file' cannot be read, no read permissions");
 396         }
 397         $path;
 398 }
 399
 400 =pod
 401
 402 =head2 class_file
 403
 404   # Find a file in our module shared dir, or in our parent class
 405   my $dir = class_file('My::Module', 'file/name.txt');
 406
 407 The C<module_file> function takes two params of the module name
 408 and file name. It locates the module dir, and then finds the file within
 409 it, verifying that the file actually exists, and that it is readable.
 410
 411 In order to find the directory, the module B<must> be loaded when
 412 calling this function.
 413
 414 The filename should be a relative path in the format of your local
 415 filesystem. It will simply added to the directory using L<File::Spec>'s
 416 C<catfile> method.
 417
 418 If the file is NOT found for that module, C<class_file> will scan up
 419 the module's @ISA tree, looking for the file in all of the parent
 420 classes.
 421
 422 This allows you to, in effect, "subclass" shared files.
 423
 424 Returns the file path as a string, or dies if the file or the dist's
 425 directory cannot be located, or the file is not readable.
 426
 427 =cut
 428
 429 sub class_file {
 430         my $module = _MODULE(shift);
 431         my $file   = _FILE(shift);
 432
 433         # Get the super path ( not including UNIVERSAL )
 434         # Rather than using Class::ISA, we'll use an inlined version
 435         # that implements the same basic algorithm.
 436         my @path  = ();
 437         my @queue = ( $module );
 438         my %seen  = ( $module => 1 );
 439         while ( my $cl = shift @queue ) {
 440                 push @path, $cl;
 441                 no strict 'refs';
 442                 unshift @queue, grep { ! $seen{$_}++ }
 443                         map { s/^::/main::/; s/\'/::/g; $_ }
 444                         ( @{"${cl}::ISA"} );
 445         }
 446
 447         # Search up the path
 448         foreach my $class ( @path ) {
 449                 local $@;
 450                 my $dir = eval {
 451                         module_dir($class);
 452                 };
 453                 next if $@;
 454                 my $path = File::Spec->catfile($dir, $file);
 455                 unless ( -e $path ) {
 456                         next;
 457                 }
 458                 unless ( -r $path ) {
 459                         croak("File '$file' cannot be read, no read permissions");
 460                 }
 461                 return $path;
 462         }
 463         croak("File '$file' does not exist in class or parent shared files");
 464 }
 465
 466
 467
 468
 469 #####################################################################
 470 # Support Functions
 471
 472 sub _module_subdir {
 473         my $module = shift;
 474         $module =~ s/::/-/g;
 475         return $module;
 476 }
 477
 478 sub _dist_packfile {
 479         my $module = shift;
 480         my @dirs   = grep { -e } ( $Config::Config{archlibexp}, $Config::Config{sitearchexp} );
 481         my $file   = File::Spec->catfile(
 482                 'auto', split( /::/, $module), '.packlist',
 483         );
 484
 485         foreach my $dir ( @dirs ) {
 486                 my $path = File::Spec->catfile( $dir, $file );
 487                 next unless -f $path;
 488
 489                 # Load the file
 490                 my $packlist = ExtUtils::Packlist->new($path);
 491                 unless ( $packlist ) {
 492                         die "Failed to load .packlist file for $module";
 493                 }
 494
 495                 die "CODE INCOMPLETE";
 496         }
 497
 498         die "CODE INCOMPLETE";
 499 }
 500
 501 # Matches a valid distribution name
 502 ### This is a total guess at this point
 503 sub _DIST {
 504         if ( defined $_[0] and ! ref $_[0] and $_[0] =~ /^[a-z0-9+_-]+$/is ) {
 505                 return shift;
 506         }
 507         croak("Not a valid distribution name");
 508 }
 509
 510 # A valid and loaded module name
 511 sub _MODULE {
 512         my $module = _CLASS(shift) or croak("Not a valid module name");
 513         if ( Class::Inspector->loaded($module) ) {
 514                 return $module;
 515         }
 516         croak("Module '$module' is not loaded");
 517 }
 518
 519 # A valid file name
 520 sub _FILE {
 521         my $file = shift;
 522         unless ( defined $file and ! ref $file and length $file ) {
 523                 croak("Did not pass a file name");
 524         }
 525         if ( File::Spec->file_name_is_absolute($file) ) {
 526                 croak("Cannot use absolute file name '$file'");
 527         }
 528         $file;
 529 }
 530
 531 1;
 532
 533 =pod
 534
 535 =head1 SUPPORT
 536
 537 Bugs should always be submitted via the CPAN bug tracker
 538
 539 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-ShareDir>
 540
 541 For other issues, contact the maintainer.
 542
 543 =head1 AUTHOR
 544
 545 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 546
 547 =head1 SEE ALSO
 548
 549 L<File::HomeDir>, L<Module::Install>, L<Module::Install::Share>,
 550 L<File::ShareDir::PAR>
 551
 552 =head1 COPYRIGHT
 553
 554 Copyright 2005 - 2009 Adam Kennedy.
 555
 556 This program is free software; you can redistribute
 557 it and/or modify it under the same terms as Perl itself.
 558
 559 The full text of the license can be found in the
 560 LICENSE file included with this module.
 561
 562 =cut