File Coverage

blib/lib/File/ShareDir/Dist.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	14	16	87.5
condition	3	6	50.0
subroutine	7	7	100.0
pod	1	1	100.0
total	69	74	93.2

package File::ShareDir::Dist;

use strict;
use warnings;
use 5.008001;
use base qw( Exporter );
use File::Spec;

our @EXPORT_OK = qw( dist_share );

# ABSTRACT: Locate per-dist shared files
our $VERSION = '0.05'; # 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 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__