view release on metacpan or  search on metacpan

lib/File/AddInc.pm  view on Meta::CPAN

  $pack->declare_these_libdirs($opts, '', [dirname => "local/lib/perl5"]);
}

sub add_inc_if_necessary {
  my ($pack, @libdir) = @_;

  if (my @necessary = grep {

    my $dir = $_;
    -d $dir and not grep {$dir eq $_} @INC;

  } @libdir) {

    print STDERR "# use lib ", join(", ", map(qq{'$_'}, @necessary))
      , "\n" if DEBUG;

    lib->import(@necessary);

  } else {

    print STDERR "# No need to add libs: ", join(", ", map(qq{'$_'}, @libdir))
      , "\n" if DEBUG;
  }
}

sub declare_libdir_var {
  (my $pack, my Opts $opts, my $varname) = @_;

  my $libdir = $pack->get_libdir($opts);

  $varname =~ s/^\$//;

  my $fullvarname = join("::", $opts->{callpack}, $varname);

  my $glob = do {no strict qw/refs/; \*{$fullvarname}};

  print STDERR "# set \$$fullvarname = '$libdir'\n" if DEBUG;

  *$glob = \$libdir;
}

sub declare_these_libdirs {
  (my $pack, my Opts $opts, my @dirSpec) = @_;

  my $libdir = $pack->get_libdir($opts);

  my @libdir = map {
    if (ref $_) {

      my ($kind, @rest) = @$_;

      my $sub = $pack->can("libdir_to_$kind")
        or Carp::croak "Unknown libdir spec: $kind";

      my $realPrefix = $sub->($pack, $libdir);

      File::Spec->catfile($realPrefix, map {split(m{/}, $_)} @rest);

    }
    # elsif (/\%s/) {
    #   File::Spec->catfile(split m{/}, sprintf($_, $libdir));
    # }
    else {

      File::Spec->catfile($libdir, split(m{/}, $_));
    }
  } @dirSpec;

  add_inc_if_necessary($pack, @libdir);
}

sub libdir_to_libdir {
  my ($pack, $libdir) = @_;
  $libdir;
}

sub libdir_to_dirname {
  my ($pack, $libdir) = @_;
  dirname($libdir);
}

sub libdir {
  my ($pack, @caller) = @_;

  my ($callpack, $filename) = @caller ? @caller : caller;

  (my $packfn = $callpack) =~ s,::,/,g;
  $packfn .= ".pm";

  my $realFn = -l $filename
    ? resolve_symlink($pack, $filename)
    : $filename;

  if ($^O eq 'MSWin32') {
    $packfn =~ s#/#\\#g;
  }

  my $absfn = File::Spec->rel2abs($realFn);

  $absfn =~ /\Q$packfn\E\z/
    or Carp::croak("Can't handle this case! absfn=$absfn; packfn=$packfn");

  substr($absfn, 0, length($absfn) - length($packfn) - 1);
}

sub resolve_symlink {
  my ($pack, $filePath) = @_;

  print STDERR "# resolve_symlink($filePath)...\n" if DEBUG;

  (undef, my ($realDir)) = fileparse($filePath);

  while (defined (my $linkText = readlink $filePath)) {
    ($filePath, $realDir) = resolve_symlink_1($pack, $linkText, $realDir);
    print STDERR "# => $filePath (realDir=$realDir)\n" if DEBUG;
  }

  return $filePath;
}

sub resolve_symlink_1 {