File: Dist.pm

package info (click to toggle)
libfile-sharedir-dist-perl 0.07-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 248 kB
  • sloc: perl: 239; makefile: 2
file content (289 lines) | stat: -rw-r--r-- 7,262 bytes parent folder | download
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