File::ShareDir::PAR - File::ShareDir with PAR support

  use File::SharedDir::PAR ':ALL';
  # exact same interface as the normal File::ShareDir:

  # Where are distribution-level shared data files kept
  $dir = dist_dir('File-ShareDir');

  # Where are module-level shared data files kept
  $dir = module_dir('File::ShareDir');

  # Find a specific file in our dist/module shared dir
  $file = dist_file(  'File-ShareDir',  'file/name.txt');
  $file = module_file('File::ShareDir', 'file/name.txt');

  # Like module_file, but search up the inheritance tree
  $file = class_file( 'Foo::Bar', 'file/name.txt' );

  use File::ShareDir::PAR 'global';

package File::ShareDir::PAR;

use 5.005;
use strict;
use base 'Exporter';
use Carp             'croak';
use File::ShareDir   ();
use File::Spec       ();
use Class::Inspector ();
use Config           ();
use File::Path       ();

use vars qw{$VERSION @EXPORT_OK %EXPORT_TAGS %CLEANUP_DIRS};
BEGIN {
  $VERSION     = '0.06';
  @EXPORT_OK   = qw{dist_dir dist_file module_dir module_file class_file};
  %EXPORT_TAGS = (
    ALL => [ @EXPORT_OK ],
  );
}

use constant IS_MACOS => !!($^O eq 'MacOS');

# cleanup temporary extraction dirs.
# should be handled by PAR, but since we're
# abusing it to extract full .par's to inc/,
# we'd better take care!
END {
  foreach my $directory (keys %CLEANUP_DIRS) {
    File::Path::rmtree($directory) if -d $directory;
  }
}

# This isn't nice: Breaking PAR encapsulation.
# finds the specified file in the loaded .par's
# and returns the zip member, zip file, and zip handle
# on success
{
  my $ver          = $Config::Config{version};
  my $arch         = $Config::Config{archname};
  sub _par_find_zip_member {
    my $files = shift;
    $files = [$files] if not ref $files;

    require PAR;

    s/\/+$// for @$files;

    my @files =
      map {s{\\}{/}g; $_}
      map {
        my $file = $_;
        ( $file, "lib/$file", "arch/$file", "$arch/$file", "$ver/$file", "$ver/$arch/$file" )
      }
      @$files;

    my $files_regexp = '^(?:' . join(')|(?:', map {quotemeta($_)} @files) . ')/?';
    foreach my $zipkey (keys %PAR::LibCache) {
      my $zip = $PAR::LibCache{$zipkey};
      my $member = PAR::_first_member_matching($zip, $files_regexp) or next;
      return($member, $zipkey, $zip);
    }

    return;
  }
}

sub _par_in_use {
  return() unless exists $INC{"PAR.pm"};
  return() unless @PAR::LibCache;
  return 1;
}

sub _search_and_unpar {
  my $zippaths = shift;
  $zippaths = [$zippaths] if not ref $zippaths;

  my ($member, $zipkey, $zip) = _par_find_zip_member($zippaths);
  if ($member) {
    if (exists $PAR::ArchivesExtracted{$zip->fileName()} or $PAR::ArchivesExtracted{$zipkey}) {
      my $inc = $PAR::ArchivesExtracted{$zip->fileName()};
      return $inc;
    }
    else {
      # watch out: breaking PAR encapsulation
      my $inc_existed = -d "$PAR::SetupTemp::PARTemp/inc" ? 1 : 0;
      my $inc = PAR::_extract_inc($zip, 'force');
      $PAR::ArchivesExtracted{$zip->fileName()} = $inc;
      if (defined $inc and not $inc_existed) {
        $CLEANUP_DIRS{$inc} = 1;
        return $inc;
      }
      return();
    }
  }
  return();
}


#####################################################################
# Interface Functions

my $orig_dist_dir = \&File::ShareDir::dist_dir; # save original
sub dist_dir {
  my @args = @_;
  if (_par_in_use()) {
    my $dist = File::ShareDir::_DIST(shift);

    # Create the subpath
    my $zip_paths = [
      join (
        '/',
        'auto', split( /-/, $dist )
      ),
      join (
        '/',
        'auto', 'share', 'dist', split( /-/, $dist )
      )
    ];

    _search_and_unpar($zip_paths);
  }

  # hide from croak  
  @_ = @args;
  goto &$orig_dist_dir;
}


my $orig_module_dir = \&File::ShareDir::module_dir; # save original
sub module_dir {
  my @args = @_;
  my $module = File::ShareDir::_MODULE(shift);

  my $short  = Class::Inspector->filename($module);
  if (_par_in_use()) {
    my $inc = _search_and_unpar($short);
    if (defined $inc) {
      # Holy shit, I'm so evil. Somebody will find out I did this.
      $INC{$short} = Class::Inspector->resolved_filename($module);
    }
  }

  # hide from croak  
  @_ = @args;
  goto &$orig_module_dir;
}


my $orig_dist_file = \&File::ShareDir::dist_file; # save original
sub dist_file {
  my @args = @_;
  my $dist = File::ShareDir::_DIST(shift);
  my $file = File::ShareDir::_FILE(shift);

  # Create the subpath
  my $zippath = join (
    '/',
    'auto', split( /-/, $dist ), File::Spec->splitdir($file)
  );

  _search_and_unpar($zippath) if _par_in_use();

  # hide from croak  
  @_ = @args;
  goto &$orig_dist_file;
}


my $orig_module_file = \&File::ShareDir::module_file; # save original
sub module_file {
  my @args = @_;
  my $module = File::ShareDir::_MODULE($_[0]);
  my $dir    = module_dir($module);
  @_ = @args;
  goto &$orig_module_file;
}


my $orig_class_file = \&File::ShareDir::class_file; # save original
sub class_file {
  my @args = @_;
  my $module = File::ShareDir::_MODULE(shift);

  # This had to be copied from File::ShareDir.
  ### BEGIN VERBATIM COPY ###
        # 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"} );
        }
  ### END VERBATIM COPY ###

  foreach my $class ( @path ) {
    eval { module_dir($class); };
  }

  # hide from croak
  @_ = @args;
  goto &$orig_class_file;
}

sub import {
  my $class = shift;
  my @opt = grep { $_ ne 'global' } @_;
  if (@opt < @_) { # included 'global' option
    no warnings 'redefine';
    *File::ShareDir::class_file  = \&class_file;
    *File::ShareDir::module_file = \&module_file;
    *File::ShareDir::dist_file   = \&dist_file;
    *File::ShareDir::module_dir  = \&module_dir;
    *File::ShareDir::dist_dir    = \&dist_dir;
  }
  $class->export_to_level(1, $class, @opt);
}

1;