view release on metacpan or  search on metacpan

bin/cpant  view on Meta::CPAN

  1;
LIB_CORE_ONLY

$fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
  use strict;
  use warnings;
  
  package local::lib;
  
  use 5.008001; # probably works with earlier versions but I'm not supporting them
                # (patches would, of course, be welcome)
  
  use File::Spec ();
  use File::Path ();
  use Carp ();
  use Config;
  
  our $VERSION = '1.008001'; # 1.8.1
  
  our @KNOWN_FLAGS = qw(--self-contained);
  
  sub import {
    my ($class, @args) = @_;
  
    # Remember what PERL5LIB was when we started
    my $perl5lib = $ENV{PERL5LIB} || '';
  
    my %arg_store;
    for my $arg (@args) {
      # check for lethal dash first to stop processing before causing problems
      if ($arg =~ /−/) {
        die <<'DEATH';
  WHOA THERE! It looks like you've got some fancy dashes in your commandline!
  These are *not* the traditional -- dashes that software recognizes. You
  probably got these by copy-pasting from the perldoc for this module as
  rendered by a UTF8-capable formatter. This most typically happens on an OS X
  terminal, but can happen elsewhere too. Please try again after replacing the
  dashes with normal minus signs.
  DEATH
      }
      elsif(grep { $arg eq $_ } @KNOWN_FLAGS) {
        (my $flag = $arg) =~ s/--//;
        $arg_store{$flag} = 1;
      }
      elsif($arg =~ /^--/) {
        die "Unknown import argument: $arg";
      }
      else {
        # assume that what's left is a path
        $arg_store{path} = $arg;
      }
    }
  
    if($arg_store{'self-contained'}) {
      die "FATAL: The local::lib --self-contained flag has never worked reliably and the original author, Mark Stosberg, was unable or unwilling to maintain it. As such, this flag has been removed from the local::lib codebase in order to prevent misu...
    }
  
    $arg_store{path} = $class->resolve_path($arg_store{path});
    $class->setup_local_lib_for($arg_store{path});
  
    for (@INC) { # Untaint @INC
      next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc.
      m/(.*)/ and $_ = $1;
    }
  }
  
  sub pipeline;
  
  sub pipeline {
    my @methods = @_;
    my $last = pop(@methods);
    if (@methods) {
      \sub {
        my ($obj, @args) = @_;
        $obj->${pipeline @methods}(
          $obj->$last(@args)
        );
      };
    } else {
      \sub {
        shift->$last(@_);
      };
    }
  }
  
  sub _uniq {
      my %seen;
      grep { ! $seen{$_}++ } @_;
  }
  
  sub resolve_path {
    my ($class, $path) = @_;
    $class->${pipeline qw(
      resolve_relative_path
      resolve_home_path
      resolve_empty_path
    )}($path);
  }
  
  sub resolve_empty_path {
    my ($class, $path) = @_;
    if (defined $path) {
      $path;
    } else {
      '~/perl5';
    }
  }
  
  sub resolve_home_path {
    my ($class, $path) = @_;
    return $path unless ($path =~ /^~/);
    my ($user) = ($path =~ /^~([^\/]+)/); # can assume ^~ so undef for 'us'
    my $tried_file_homedir;
    my $homedir = do {
      if (eval { require File::HomeDir } && $File::HomeDir::VERSION >= 0.65) {
        $tried_file_homedir = 1;
        if (defined $user) {
          File::HomeDir->users_home($user);
        } else {
          File::HomeDir->my_home;
        }