view release on metacpan or  search on metacpan

bin/cpant  view on Meta::CPAN

  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;
        }
      } else {
        if (defined $user) {
          (getpwnam $user)[7];
        } else {
          if (defined $ENV{HOME}) {
            $ENV{HOME};
          } else {
            (getpwuid $<)[7];
          }
        }
      }
    };
    unless (defined $homedir) {
      Carp::croak(
        "Couldn't resolve homedir for "
        .(defined $user ? $user : 'current user')
        .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
      );
    }
    $path =~ s/^~[^\/]*/$homedir/;
    $path;
  }
  
  sub resolve_relative_path {
    my ($class, $path) = @_;
    $path = File::Spec->rel2abs($path);
  }
  
  sub setup_local_lib_for {
    my ($class, $path) = @_;
    $path = $class->ensure_dir_structure_for($path);
    if ($0 eq '-') {
      $class->print_environment_vars_for($path);
      exit 0;
    } else {
      $class->setup_env_hash_for($path);
      @INC = _uniq(split($Config{path_sep}, $ENV{PERL5LIB}), @INC);
    }
  }
  
  sub install_base_bin_path {
    my ($class, $path) = @_;
    File::Spec->catdir($path, 'bin');
  }
  
  sub install_base_perl_path {
    my ($class, $path) = @_;
    File::Spec->catdir($path, 'lib', 'perl5');
  }
  
  sub install_base_arch_path {
    my ($class, $path) = @_;
    File::Spec->catdir($class->install_base_perl_path($path), $Config{archname});
  }
  
  sub ensure_dir_structure_for {
    my ($class, $path) = @_;
    unless (-d $path) {
      warn "Attempting to create directory ${path}\n";
    }
    File::Path::mkpath($path);
    # Need to have the path exist to make a short name for it, so
    # converting to a short name here.
    $path = Win32::GetShortPathName($path) if $^O eq 'MSWin32';
  
    return $path;
  }