Hi, libfile-sharedir-perl has a currently a grave bug because the directory layout used to store data has changed. This means the package is unusable for Perl distributions whose name contains a "-" and a recent Module::Install (>= 0.76, released on 17 Jul 2008 and included in Lenny), see #496122.
This was fixed in version 0.99_01 (also released as 1.00 without changes), which was released coordinated with Module::Install on Jul 17th. Besides updating tests and the build system (new version of Module:Install) there are only two non-bugfix changes in the new upstream release: * A new function `class_file' that will look for data files in the namespaces of parent classes (36 lines long), and * the other `*_file' functions will allow searching for any kind of path, not only regular files (changes some tests for (regular) files to tests if path exists) As these other changes are not very large, I would like to know if the release team would accept the new upstream release for Lenny instead of backporting the fixes and updates to tests. Regards, Ansgar Links to upstream tarballs: 0.05 - http://search.cpan.org/CPAN/authors/id/A/AD/ADAMK/File-ShareDir-0.05.tar.gz 1.00 - http://search.cpan.org/CPAN/authors/id/A/AD/ADAMK/File-ShareDir-1.00.tar.gz Full changelog for upstream changes: 1.00 Thu 17 Jul 2008 - Everything appears ok, release prod 0.99_01 Thu 10 Jul 2009 - Updating tests a little - Adding the class_file function - Allow *_file to find any kind of path, not just files (hdp) - Localising $@ during evals - Implementing the new sharedir model Diffstat between 0.05 and 1.00: Changes | 10 MANIFEST | 7 META.yml | 27 + Makefile.PL | 22 - README | 41 ++ foo/test_file.txt | 1 inc/Module/Install.pm | 437 ++++++++++++++++----------- inc/Module/Install/Base.pm | 6 inc/Module/Install/Can.pm | 2 inc/Module/Install/Fetch.pm | 2 inc/Module/Install/Makefile.pm | 333 +++++++++++---------- inc/Module/Install/Metadata.pm | 650 +++++++++++++++++++++++++---------------- inc/Module/Install/Share.pm | 45 ++ inc/Module/Install/Win32.pm | 13 inc/Module/Install/WriteAll.pm | 55 +-- lib/File/ShareDir.pm | 253 ++++++++++++++- share/subdir/sample.txt | 7 t/01_compile.t | 13 t/02_main.t | 52 +-- t/97_meta.t | 27 + t/98_pod.t | 32 ++ t/99_pmv.t | 27 + t/99_pod.t | 36 -- t/lib/ShareDir.pm | 11 24 files changed, 1385 insertions(+), 724 deletions(-) Changes to lib/File/ShareDir.pm (minus documentation only hunks): The internal function _dist_packfile is not used anywhere. --- File-ShareDir-0.05/lib/File/ShareDir.pm 2006-09-04 02:52:56.000000000 +0200 +++ File-ShareDir-1.00/lib/File/ShareDir.pm 2008-07-17 09:58:40.000000000 +0200 @@ -104,22 +107,29 @@ use 5.005; use strict; -use base 'Exporter'; use Carp 'croak'; +use Config (); +use Exporter (); use File::Spec (); use Params::Util '_CLASS'; use Class::Inspector (); -use vars qw{$VERSION $IS_MACOS @EXPORT_OK %EXPORT_TAGS}; +use vars qw{$VERSION @ISA @EXPORT_OK %EXPORT_TAGS}; BEGIN { - $VERSION = '0.05'; - $IS_MACOS = $^O eq 'MacOS'; - @EXPORT_OK = qw{dist_dir dist_file module_dir module_file}; + $VERSION = '1.00'; + @ISA = qw{ Exporter }; + @EXPORT_OK = qw{ + dist_dir dist_file + module_dir module_file + class_dir class_file + }; %EXPORT_TAGS = ( ALL => [ @EXPORT_OK ], - ); + ); } +use constant IS_MACOS => !!($^O eq 'MacOS'); + The C<dist_dir> function takes a single parameter of the name of an @@ -145,11 +155,49 @@ sub dist_dir { my $dist = _DIST(shift); + my $dir; + + # Try the new version + $dir = _dist_dir_new( $dist ); + return $dir if defined $dir; + + # Fall back to the legacy version + $dir = _dist_dir_old( $dist ); + return $dir if defined $dir; + + # Ran out of options + croak("Failed to find share dir for dist '$dist'"); +} + +sub _dist_dir_new { + my $dist = shift; + + # Create the subpath + my $path = File::Spec->catdir( + 'auto', 'share', 'dist', $dist, + ); + + # Find the full dir withing @INC + foreach my $inc ( @INC ) { + next unless defined $inc and ! ref $inc; + my $dir = File::Spec->catdir( $inc, $path ); + next unless -d $dir; + unless ( -r $dir ) { + croak("Found directory '$dir', but no read permissions"); + } + return $dir; + } + + return undef; +} + +sub _dist_dir_old { + my $dist = shift; # Create the subpath my $path = File::Spec->catdir( 'auto', split( /-/, $dist ), - ); + ); # Find the full dir withing @INC foreach my $inc ( @INC ) { @@ -157,13 +205,12 @@ my $dir = File::Spec->catdir( $inc, $path ); next unless -d $dir; unless ( -r $dir ) { - croak("Directory '$dir', no read permissions"); + croak("Found directory '$dir', but no read permissions"); } return $dir; } - # Couldn't find it - croak("Failed to find share dir for dist '$dist'"); + return undef; } =pod @@ -187,11 +234,46 @@ sub module_dir { my $module = _MODULE(shift); + my $dir; + + # Try the new version + $dir = _module_dir_new( $module ); + return $dir if defined $dir; + + # Fall back to the legacy version + return _module_dir_old( $module ); +} + +sub _module_dir_new { + my $module = shift; + + # Create the subpath + my $path = File::Spec->catdir( + 'auto', 'share', 'module', + _module_subdir( $module ), + ); + + # Find the full dir withing @INC + foreach my $inc ( @INC ) { + next unless defined $inc and ! ref $inc; + my $dir = File::Spec->catdir( $inc, $path ); + next unless -d $dir; + unless ( -r $dir ) { + croak("Found directory '$dir', but no read permissions"); + } + return $dir; + } + + return undef; +} + +sub _module_dir_old { + my $module = shift; my $short = Class::Inspector->filename($module); my $long = Class::Inspector->loaded_filename($module); - $short =~ tr{/} {:} if $IS_MACOS; + $short =~ tr{/}{:} if IS_MACOS; substr( $short, -3, 3, '' ); - $long =~ m{^(.*)\Q$short\E\.pm\z}s or die("Failed to find base dir"); + $long =~ m/^(.*)\Q$short\E\.pm\z/s or die("Failed to find base dir"); my $dir = File::Spec->catdir( "$1", 'auto', $short ); unless ( -d $dir ) { croak("Directory '$dir', does not exist"); @@ -199,7 +281,7 @@ unless ( -r $dir ) { croak("Directory '$dir', no read permissions"); } - return $dir; + return $dir; } =pod @@ -226,16 +308,48 @@ my $dist = _DIST(shift); my $file = _FILE(shift); + # Try the new version first + my $path = _dist_file_new( $dist, $file ); + return $path if defined $path; + + # Hand off to the legacy version + return _dist_file_old( $dist, $file );; +} + +sub _dist_file_new { + my $dist = shift; + my $file = shift; + + # If it exists, what should the path be + my $dir = _dist_dir_new( $dist ); + my $path = File::Spec->catfile( $dir, $file ); + + # Does the file exist + return undef unless -e $path; + unless ( -f $path ) { + croak("Found dist_file '$path', but not a file"); + } + unless ( -r $path ) { + croak("File '$path', no read permissions"); + } + + return $path; +} + +sub _dist_file_old { + my $dist = shift; + my $file = shift; + # Create the subpath - my $path = File::Spec->catdir( + my $path = File::Spec->catfile( 'auto', split( /-/, $dist ), $file, - ); + ); # Find the full dir withing @INC foreach my $inc ( @INC ) { next unless defined $inc and ! ref $inc; my $full = File::Spec->catdir( $inc, $path ); - next unless -f $full; + next unless -e $full; unless ( -r $full ) { croak("Directory '$full', no read permissions"); } @@ -274,7 +388,7 @@ my $file = _FILE(shift); my $dir = module_dir($module); my $path = File::Spec->catfile($dir, $file); - unless ( -e $path and -f _ ) { + unless ( -e $path ) { croak("File '$file' does not exist in module dir"); } unless ( -r $path ) { @@ -283,6 +397,71 @@ $path; } +=pod + +=head2 class_file + + # Find a file in our module shared dir, or in our parent class + my $dir = class_file('My::Module', 'file/name.txt'); + +The C<module_file> function takes two params of the module name +and file name. It locates the module dir, and then finds the file within +it, verifying that the file actually exists, and that it is readable. + +In order to find the directory, the module B<must> be loaded when +calling this function. + +The filename should be a relative path in the format of your local +filesystem. It will simply added to the directory using L<File::Spec>'s +C<catfile> method. + +If the file is NOT found for that module, C<class_file> will scan up +the module's @ISA tree, looking for the file in all of the parent +classes. + +This allows you to, in effect, "subclass" shared files. + +Returns the file path as a string, or dies if the file or the dist's +directory cannot be located, or the file is not readable. + +=cut + +sub class_file { + my $module = _MODULE(shift); + my $file = _FILE(shift); + + # Get the super path ( not including UNIVERSAL ) + # Rather than using Class::ISA, we'll use an inlined version + # that implements the same basic algorithm. + my @path = (); + my @queue = ( $module ); + my %seen = ( $module => 1 ); + while ( my $cl = shift @queue ) { + push @path, $cl; + no strict 'refs'; + unshift @queue, grep { ! $seen{$_}++ } + map { s/^::/main::/; s/\'/::/g; $_ } + ( @{"${cl}::ISA"} ); + } + + # Search up the path + foreach my $class ( @path ) { + local $@; + my $dir = eval { + module_dir($class); + }; + next if $@; + my $path = File::Spec->catfile($dir, $file); + unless ( -e $path ) { + next; + } + unless ( -r $path ) { + croak("File '$file' cannot be read, no read permissions"); + } + return $path; + } + croak("File '$file' does not exist in class or parent shared files"); +} @@ -290,6 +469,35 @@ ##################################################################### # Support Functions +sub _module_subdir { + my $module = shift; + $module =~ s/::/-/g; + return $module; +} + +sub _dist_packfile { + my $module = shift; + my @dirs = grep { -e } ( $Config::Config{archlibexp}, $Config::Config{sitearchexp} ); + my $file = File::Spec->catfile( + 'auto', split( /::/, $module), '.packlist', + ); + + foreach my $dir ( @dirs ) { + my $path = File::Spec->catfile( $dir, $file ); + next unless -f $path; + + # Load the file + my $packlist = ExtUtils::Packlist->new($path); + unless ( $packlist ) { + die "Failed to load .packlist file for $module"; + } + + die "CODE INCOMPLETE"; + } + + die "CODE INCOMPLETE"; +} + # Matches a valid distribution name ### This is a total guess at this point sub _DIST { -- PGP: 1024D/595FAD19 739E 2D09 0969 BEA9 9797 B055 DDB0 2FF7 595F AD19 -- To UNSUBSCRIBE, email to [EMAIL PROTECTED] with a subject of "unsubscribe". Trouble? Contact [EMAIL PROTECTED]
