1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289
|
package File::ShareDir::Dist;
use strict;
use warnings;
use 5.008001;
use base qw( Exporter );
use File::Spec;
our @EXPORT_OK = qw( dist_share dist_config );
# ABSTRACT: Locate per-dist shared files
our $VERSION = '0.07'; # VERSION
# TODO: Works with PAR
our %over;
sub dist_share ($)
{
my($dist_name) = @_;
$dist_name =~ s/::/-/g;
local $over{$1} = $2
if defined $ENV{PERL_FILE_SHAREDIR_DIST} && $ENV{PERL_FILE_SHAREDIR_DIST} =~ /^(.*?)=(.*)$/;
return File::Spec->rel2abs($over{$dist_name}) if $over{$dist_name};
my @pm = split /-/, $dist_name;
$pm[-1] .= ".pm";
foreach my $inc (@INC)
{
my $pm = File::Spec->catfile( $inc, @pm );
if(-f $pm)
{
my $share = File::Spec->catdir( $inc, qw( auto share dist ), $dist_name );
if(-d $share)
{
return File::Spec->rel2abs($share);
}
if(!File::Spec->file_name_is_absolute($inc))
{
my($v,$dir) = File::Spec->splitpath( File::Spec->rel2abs($inc), 1 );
my @dirs = File::Spec->splitdir($dir);
if(defined $dirs[-1] && $dirs[-1] eq 'lib')
{
pop @dirs; # pop off the 'lib';
# put humpty dumpty back together again
my $share = File::Spec->catdir(
File::Spec->catpath($v,
File::Spec->catdir(@dirs),
'',
),
'share',
);
if(-d $share)
{
return $share;
}
}
}
last;
}
}
return;
}
sub dist_config
{
my($dist_name) = @_;
my $dir = dist_share $dist_name;
return {} unless defined $dir && -d $dir;
my $fn = File::Spec->catfile($dir, 'config.pl');
return {} unless -f $fn;
my $fh;
open($fh, '<', $fn) || die "unable to read $fn $!";
my $pl = do { local $/; <$fh> };
close $fh;
my $config = eval $pl;
die $@ if $@;
$config;
}
sub import
{
my($class, @args) = @_;
my @modify;
foreach my $arg (@args)
{
if($arg =~ /^-(.*?)=(.*)$/)
{
$over{$1} = $2;
}
else
{
push @modify, $arg;
}
}
@_ = ($class, @modify);
goto \&Exporter::import;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
File::ShareDir::Dist - Locate per-dist shared files
=head1 VERSION
version 0.07
=head1 SYNOPSIS
use File::ShareDir::Dist qw( dist_share );
my $dir = dist_share 'Foo-Bar-Baz';
=head1 DESCRIPTION
L<File::ShareDir::Dist> finds share directories for distributions. It is similar to L<File::ShareDir>
with a few differences:
=over 4
=item Only supports distribution directories.
It doesn't support perl modules or perl class directories. I have never really needed anything
other than a per-dist share directory.
=item Doesn't compute filenames.
Doesn't compute files in the share directory for you. This is what L<File::Spec> or L<Path::Tiny>
are for.
=item Doesn't support old style shares.
For some reason there are two types. I have never seen or needed the older type.
=item Hopefully doesn't find the wrong directory.
It doesn't blindly go finding the first share directory in @INC that matches the dist name. It actually
checks to see that it matches the .pm file that goes along with it.
That does mean that you need to have a .pm that corresponds to your dist name. This is not
always the case for some older historical distributions, but it has been the recommended convention
for quite some time.
=item No non-core dependencies.
L<File::ShareDir> only has L<Class::Inspector>, but since we are only doing per-dist share
directories we don't even need that.
The goal of this project is to have no non-core dependencies for the two most recent production
versions of Perl. As of this writing that means Perl 5.26 and 5.24. In the future, we C<may> add
dependencies on modules that are not part of the Perl core on older Perls.
=item Works in your development tree.
Uses the heuristic, for determining if you are in a development tree, and if so, uses the common
convention to find the directory named C<share>. If you are using a relative path in C<@INC>,
if the directory C<share> is a sibling of that relative entry in C<@INC> and if the last element
in that relative path is C<lib>.
Example, if you have the directory structure:
lib/Foo/Bar/Baz.pm
share/data
and you invoke perl with
% perl -Ilib -MFoo::Bar::Baz -MFile::ShareDir::Dist=dist_share -E 'say dist_share("Foo-Bar-Baz")'
C<dist_share> will return the (absolute) path to ./share/data. If you invoked it with:
% export PERL5LIB `pwd`/lib
perl -MFoo::Bar::Baz -MFile::ShareDir::Dist=dist_share -E 'say dist_share("Foo-Bar-Baz")'
it would not. For me this covers most of my needs when developing a Perl module with a share
directory.
L<prove> foils this heuristic by making C<@INC> absolute paths. To get around that you can use
L<App::Prove::Plugin::ShareDirDist>.
=item Built in override.
The hash C<%File::ShareDir::Dist::over> can be used to override what C<dist_share> returns.
You can also override behavior on the command line using a dash followed by a key value pair
joined by the equal sign. In other words:
% perl -MFile::ShareDir::Dist=-Foo-Bar-Baz=./share -E 'say File::ShareDir::Dist::dist_share("Foo-Bar-Baz")'
/.../share
If neither of those work then you can set PERL_FILE_SHAREDIR_DIST to a dist name, directory pair
% env PERL_FILE_SHAREDIR_DIST=Foo-Bar-Baz=`pwd`/share perl -MFile::ShareDir::Dist -E 'say File::ShareDir::Dist::dist_share("Foo-Bar-Baz")'
For L<File::ShareDir> you have to either mock the C<dist_dir> function or install
L<File::ShareDir::Override>. For testing you can use L<Test::File::ShareDir>. I have never
understood why such a simple concept needs three modules to do all of this.
=back
=head1 FUNCTIONS
Functions must be explicitly exported. They are not exported by default.
=head2 dist_share
my $dir = dist_share $dist_name;
my $dir = dist_share $module_name;
Returns the absolute path to the share directory of the given distribution.
As a convenience you can also use the "main" module name associated with the
distribution. That means if you want the share directory for the dist
C<Foo-Bar-Baz> you may use either C<Foo-Bar-Baz> or C<Foo::Bar::Baz> to find
it.
Returns nothing if no share directory could be found.
=head2 dist_config
[version 0.07]
my $config = dist_config $dist_name;
Returns the config at runtime as created by L<File::ShareDir::Dist::Install> and install time.
=head1 ENVIRONMENT
=over 4
=item PERL_FILE_SHAREDIR_DIST
Can be used to set a single dist directory override.
=back
=head1 CAVEATS
All the stuff that is in L<File::ShareDir> but not in this module could be considered either
caveats or features depending on your perspective I suppose.
=head1 SEE ALSO
=over
=item L<File::ShareDir::Dist::Install>
=item L<App::Prove::Plugin::ShareDirDist>
=item L<App::Yath::Plugin::ShareDirDist>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Yanick Champoux (yanick)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017,2018 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|