use 5.006;
use File::Spec ();
-use File::Path ();
use Config;
-our $VERSION = '1.008026'; # 1.8.26
+our $VERSION = '2.000004'; # 2.0.4
$VERSION = eval $VERSION;
-our @KNOWN_FLAGS = qw(--self-contained --deactivate --deactivate-all);
-
-sub DEACTIVATE_ONE () { 1 }
-sub DEACTIVATE_ALL () { 2 }
-
-sub INTERPOLATE_ENV () { 1 }
-sub LITERAL_ENV () { 0 }
-
sub import {
my ($class, @args) = @_;
+ push @args, @ARGV
+ if $0 eq '-';
- # Remember what PERL5LIB was when we started
- my $perl5lib = $ENV{PERL5LIB} || '';
+ my @steps;
+ my %opts;
+ my $shelltype;
- my %arg_store;
- for my $arg (@args) {
+ while (@args) {
+ my $arg = shift @args;
# check for lethal dash first to stop processing before causing problems
# the fancy dash is U+2212 or \xE2\x88\x92
if ($arg =~ /\xE2\x88\x92/ or $arg =~ /−/) {
dashes with normal minus signs.
DEATH
}
- elsif(grep { $arg eq $_ } @KNOWN_FLAGS) {
- (my $flag = $arg) =~ s/--//;
- $arg_store{$flag} = 1;
+ elsif ($arg eq '--self-contained') {
+ die <<'DEATH';
+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 misunderstandings and potentially broken builds. The local::lib authors
+recommend that you look at the lib::core::only module shipped with this
+distribution in order to create a more robust environment that is equivalent to
+what --self-contained provided (although quite possibly not what you originally
+thought it provided due to the poor quality of the documentation, for which we
+apologise).
+DEATH
+ }
+ elsif( $arg =~ /^--deactivate(?:=(.*))?$/ ) {
+ my $path = defined $1 ? $1 : shift @args;
+ push @steps, ['deactivate', $path];
+ }
+ elsif ( $arg eq '--deactivate-all' ) {
+ push @steps, ['deactivate_all'];
}
- elsif($arg =~ /^--/) {
+ elsif ( $arg =~ /^--shelltype(?:=(.*))?$/ ) {
+ $shelltype = defined $1 ? $1 : shift @args;
+ }
+ elsif ( $arg eq '--no-create' ) {
+ $opts{no_create} = 1;
+ }
+ elsif ( $arg =~ /^--/ ) {
die "Unknown import argument: $arg";
}
else {
- # assume that what's left is a path
- $arg_store{path} = $arg;
+ push @steps, ['activate', $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 misunderstandings and potentially broken builds. The local::lib authors recommend that you look at the lib::core::only module shipped with this distribution in order to create a more robust environment that is equivalent to what --self-contained provided (although quite possibly not what you originally thought it provided due to the poor quality of the documentation, for which we apologise).\n";
- }
-
- my $deactivating = 0;
- if ($arg_store{deactivate}) {
- $deactivating = DEACTIVATE_ONE;
- }
- if ($arg_store{'deactivate-all'}) {
- $deactivating = DEACTIVATE_ALL;
+ if (!@steps) {
+ push @steps, ['activate', undef];
}
- $arg_store{path} = $class->resolve_path($arg_store{path});
- $class->setup_local_lib_for($arg_store{path}, $deactivating);
+ my $self = $class->new(%opts);
- for (@INC) { # Untaint @INC
- next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc.
- m/(.*)/ and $_ = $1;
+ for (@steps) {
+ my ($method, @args) = @$_;
+ $self = $self->$method(@args);
}
-}
-
-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(@_);
- };
+ if ($0 eq '-') {
+ print $self->environment_vars_string($shelltype);
+ exit 0;
+ }
+ else {
+ $self->setup_local_lib;
}
}
-=begin testing
+sub new {
+ my $class = shift;
+ bless {@_}, $class;
+}
-#:: test pipeline
+sub clone {
+ my $self = shift;
+ bless {%$self, @_}, ref $self;
+}
-package local::lib;
+sub inc { $_[0]->{inc} ||= \@INC }
+sub libs { $_[0]->{libs} ||= [ \'PERL5LIB' ] }
+sub bins { $_[0]->{bins} ||= [ \'PATH' ] }
+sub roots { $_[0]->{roots} ||= [ \'PERL_LOCAL_LIB_ROOT' ] }
+sub extra { $_[0]->{extra} ||= {} }
+sub shelltype { $_[0]->{shelltype} ||= $_[0]->guess_shelltype }
+sub no_create { $_[0]->{no_create} }
+
+my $_archname = $Config{archname};
+my $_version = $Config{version};
+my @_inc_version_list = reverse split / /, $Config{inc_version_list};
+my $_path_sep = $Config{path_sep};
+
+sub _as_list {
+ my $list = shift;
+ grep length, map {
+ !(ref $_ && ref $_ eq 'SCALAR') ? $_ : (
+ defined $ENV{$$_} ? split(/\Q$_path_sep/, $ENV{$$_})
+ : ()
+ )
+ } ref $list ? @$list : $list;
+}
+sub _remove_from {
+ my ($list, @remove) = @_;
+ return @$list
+ if !@remove;
+ my %remove = map { $_ => 1 } @remove;
+ grep !$remove{$_}, _as_list($list);
+}
-{ package Foo; sub foo { -$_[1] } sub bar { $_[1]+2 } sub baz { $_[1]+3 } }
-my $foo = bless({}, 'Foo');
-Test::More::ok($foo->${pipeline qw(foo bar baz)}(10) == -15);
+my @_lib_subdirs = (
+ [$_version, $_archname],
+ [$_version],
+ [$_archname],
+ (@_inc_version_list ? \@_inc_version_list : ()),
+ [],
+);
-=end testing
+sub install_base_bin_path {
+ my ($class, $path) = @_;
+ return File::Spec->catdir($path, 'bin');
+}
+sub install_base_perl_path {
+ my ($class, $path) = @_;
+ return File::Spec->catdir($path, 'lib', 'perl5');
+}
+sub install_base_arch_path {
+ my ($class, $path) = @_;
+ File::Spec->catdir($class->install_base_perl_path($path), $_archname);
+}
-=cut
+sub lib_paths_for {
+ my ($class, $path) = @_;
+ my $base = $class->install_base_perl_path($path);
+ return map { File::Spec->catdir($base, @$_) } @_lib_subdirs;
+}
-sub _uniq {
- my %seen;
- grep { ! $seen{$_}++ } @_;
+sub _mm_escape_path {
+ my $path = shift;
+ $path =~ s/\\/\\\\\\\\/g;
+ if ($path =~ s/ /\\ /g) {
+ $path = qq{"\\"$path\\""};
+ }
+ return $path;
}
-sub resolve_path {
- my ($class, $path) = @_;
- $class->${pipeline qw(
- resolve_relative_path
- resolve_home_path
- resolve_empty_path
- )}($path);
+sub _mb_escape_path {
+ my $path = shift;
+ $path =~ s/\\/\\\\/g;
+ return qq{"$path"};
}
-sub resolve_empty_path {
+sub installer_options_for {
my ($class, $path) = @_;
- if (defined $path) {
- $path;
- } else {
- '~/perl5';
- }
+ return (
+ PERL_MM_OPT =>
+ defined $path ? "INSTALL_BASE="._mm_escape_path($path) : undef,
+ PERL_MB_OPT =>
+ defined $path ? "--install_base "._mb_escape_path($path) : undef,
+ );
}
-=begin testing
+sub active_paths {
+ my ($self) = @_;
+ $self = ref $self ? $self : $self->new;
-#:: test classmethod setup
+ return grep {
+ # screen out entries that aren't actually reflected in @INC
+ my $active_ll = $self->install_base_perl_path($_);
+ grep { $_ eq $active_ll } @{$self->inc};
+ } _as_list($self->roots);
+}
-my $c = 'local::lib';
-=end testing
+sub deactivate {
+ my ($self, $path) = @_;
+ $self = $self->new unless ref $self;
+ $path = $self->resolve_path($path);
+ $path = $self->normalize_path($path);
-=begin testing
+ my @active_lls = $self->active_paths;
-#:: test classmethod
+ if (!grep { $_ eq $path } @active_lls) {
+ warn "Tried to deactivate inactive local::lib '$path'\n";
+ return $self;
+ }
-is($c->resolve_empty_path, '~/perl5');
-is($c->resolve_empty_path('foo'), 'foo');
+ my %args = (
+ bins => [ _remove_from($self->bins,
+ $self->install_base_bin_path($path)) ],
+ libs => [ _remove_from($self->libs,
+ $self->install_base_perl_path($path)) ],
+ inc => [ _remove_from($self->inc,
+ $self->lib_paths_for($path)) ],
+ roots => [ _remove_from($self->roots, $path) ],
+ );
-=end testing
+ $args{extra} = { $self->installer_options_for($args{roots}[0]) };
-=cut
+ $self->clone(%args);
+}
-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) {
- require Carp;
- Carp::croak(
- "Couldn't resolve homedir for "
- .(defined $user ? $user : 'current user')
- .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
+sub deactivate_all {
+ my ($self) = @_;
+ $self = $self->new unless ref $self;
+
+ my @active_lls = $self->active_paths;
+
+ my %args;
+ if (@active_lls) {
+ %args = (
+ bins => [ _remove_from($self->bins,
+ map $self->install_base_bin_path($_), @active_lls) ],
+ libs => [ _remove_from($self->libs,
+ map $self->install_base_perl_path($_), @active_lls) ],
+ inc => [ _remove_from($self->inc,
+ map $self->lib_paths_for($_), @active_lls) ],
+ roots => [ _remove_from($self->roots, @active_lls) ],
);
}
- $path =~ s/^~[^\/]*/$homedir/;
- $path;
-}
-sub resolve_relative_path {
- my ($class, $path) = @_;
- $path = File::Spec->rel2abs($path);
-}
+ $args{extra} = { $self->installer_options_for(undef) };
-=begin testing
-
-#:: test classmethod
+ $self->clone(%args);
+}
-local *File::Spec::rel2abs = sub { shift; 'FOO'.shift; };
-is($c->resolve_relative_path('bar'),'FOObar');
+sub activate {
+ my ($self, $path) = @_;
+ $self = $self->new unless ref $self;
+ $path = $self->resolve_path($path);
+ $self->ensure_dir_structure_for($path)
+ unless $self->no_create;
-=end testing
+ $path = $self->normalize_path($path);
-=cut
+ my @active_lls = $self->active_paths;
-sub setup_local_lib_for {
- my ($class, $path, $deactivating) = @_;
-
- my $interpolate = LITERAL_ENV;
- my @active_lls = $class->active_paths;
-
- $class->ensure_dir_structure_for($path)
- unless $deactivating;
-
- # On Win32 directories often contain spaces. But some parts of the CPAN
- # toolchain don't like that. To avoid this, GetShortPathName() gives us
- # an alternate representation that has none.
- # This only works if the directory already exists.
- $path = Win32::GetShortPathName($path) if $^O eq 'MSWin32';
-
- if (! $deactivating) {
- if (@active_lls && $active_lls[0] eq $path) {
- exit 0 if $0 eq '-';
- return; # Asked to add what's already at the top of the stack
- } elsif (grep { $_ eq $path} @active_lls) {
- # Asked to add a dir that's lower in the stack -- so we remove it from
- # where it is, and then add it back at the top.
- $class->setup_env_hash_for($path, DEACTIVATE_ONE);
- # Which means we can no longer output "PERL5LIB=...:$PERL5LIB" stuff
- # anymore because we're taking something *out*.
- $interpolate = INTERPOLATE_ENV;
- }
+ if (grep { $_ eq $path } @active_lls[1 .. $#active_lls]) {
+ $self = $self->deactivate($path);
}
- if ($0 eq '-') {
- $class->print_environment_vars_for($path, $deactivating, $interpolate);
- exit 0;
- } else {
- $class->setup_env_hash_for($path, $deactivating);
- my $arch_dir = $Config{archname};
- @INC = _uniq(
- (
- # Inject $path/$archname for each path in PERL5LIB
- map { ( File::Spec->catdir($_, $arch_dir), $_ ) }
- split($Config{path_sep}, $ENV{PERL5LIB})
- ),
- @INC
+ my %args;
+ if (!@active_lls || $active_lls[0] ne $path) {
+ %args = (
+ bins => [ $self->install_base_bin_path($path), @{$self->bins} ],
+ libs => [ $self->install_base_perl_path($path), @{$self->libs} ],
+ inc => [ $self->lib_paths_for($path), @{$self->inc} ],
+ roots => [ $path, @{$self->roots} ],
);
}
-}
-sub install_base_bin_path {
- my ($class, $path) = @_;
- File::Spec->catdir($path, 'bin');
+ $args{extra} = { $self->installer_options_for($path) };
+
+ $self->clone(%args);
}
-sub install_base_perl_path {
- my ($class, $path) = @_;
- File::Spec->catdir($path, 'lib', 'perl5');
+sub normalize_path {
+ my ($self, $path) = @_;
+ $path = ( Win32::GetShortPathName($path) || $path )
+ if $^O eq 'MSWin32';
+ return $path;
}
-sub install_base_arch_path {
- my ($class, $path) = @_;
- File::Spec->catdir($class->install_base_perl_path($path), $Config{archname});
+sub build_environment_vars_for {
+ my $self = $_[0]->new->activate($_[1]);
+ $self->build_environment_vars;
+}
+sub build_environment_vars {
+ my $self = shift;
+ (
+ PATH => join($_path_sep, _as_list($self->bins)),
+ PERL5LIB => join($_path_sep, _as_list($self->libs)),
+ PERL_LOCAL_LIB_ROOT => join($_path_sep, _as_list($self->roots)),
+ %{$self->extra},
+ );
}
-sub ensure_dir_structure_for {
- my ($class, $path) = @_;
- unless (-d $path) {
- warn "Attempting to create directory ${path}\n";
- }
- File::Path::mkpath($path);
- return
+sub setup_local_lib_for {
+ my $self = $_[0]->new->activate($_[1]);
+ $self->setup_local_lib;
}
-sub guess_shelltype {
- my $shellbin = 'sh';
- if(defined $ENV{'SHELL'}) {
- my @shell_bin_path_parts = File::Spec->splitpath($ENV{'SHELL'});
- $shellbin = $shell_bin_path_parts[-1];
- }
- my $shelltype = do {
- local $_ = $shellbin;
- if(/csh/) {
- 'csh'
- } else {
- 'bourne'
- }
- };
+sub setup_local_lib {
+ my $self = shift;
+ $self->setup_env_hash;
+ @INC = @{$self->inc};
+}
- # Both Win32 and Cygwin have $ENV{COMSPEC} set.
- if (defined $ENV{'COMSPEC'} && $^O ne 'cygwin') {
- my @shell_bin_path_parts = File::Spec->splitpath($ENV{'COMSPEC'});
- $shellbin = $shell_bin_path_parts[-1];
- $shelltype = do {
- local $_ = $shellbin;
- if(/command\.com/) {
- 'win32'
- } elsif(/cmd\.exe/) {
- 'win32'
- } elsif(/4nt\.exe/) {
- 'win32'
- } else {
- $shelltype
- }
- };
+sub setup_env_hash_for {
+ my $self = $_[0]->new->activate($_[1]);
+ $self->setup_env_hash;
+}
+sub setup_env_hash {
+ my $self = shift;
+ my %env = $self->build_environment_vars;
+ for my $key (keys %env) {
+ if (defined $env{$key}) {
+ $ENV{$key} = $env{$key};
+ }
+ else {
+ delete $ENV{$key};
+ }
}
- return $shelltype;
}
sub print_environment_vars_for {
- my ($class, $path, $deactivating, $interpolate) = @_;
- print $class->environment_vars_string_for($path, $deactivating, $interpolate);
+ print $_[0]->environment_vars_string_for(@_[1..$#_]);
}
sub environment_vars_string_for {
- my ($class, $path, $deactivating, $interpolate) = @_;
- my @envs = $class->build_environment_vars_for($path, $deactivating, $interpolate);
- my $out = '';
+ my $self = $_[0]->new->activate($_[1]);
+ $self->environment_vars_string;
+}
+sub environment_vars_string {
+ my ($self, $shelltype) = @_;
- # rather basic csh detection, goes on the assumption that something won't
- # call itself csh unless it really is. also, default to bourne in the
- # pathological situation where a user doesn't have $ENV{SHELL} defined.
- # note also that shells with funny names, like zoid, are assumed to be
- # bourne.
+ $shelltype ||= $self->guess_shelltype;
- my $shelltype = $class->guess_shelltype;
+ my $build_method = "build_${shelltype}_env_declaration";
+ my @envs = (
+ PATH => $self->bins,
+ PERL5LIB => $self->libs,
+ PERL_LOCAL_LIB_ROOT => $self->roots,
+ %{$self->extra},
+ );
+ my $out = '';
while (@envs) {
my ($name, $value) = (shift(@envs), shift(@envs));
- $value =~ s/(\\")/\\$1/g if defined $value;
- $out .= $class->${\"build_${shelltype}_env_declaration"}($name, $value);
+ if (
+ ref $value
+ && @$value == 1
+ && ref $value->[0]
+ && ref $value->[0] eq 'SCALAR'
+ && ${$value->[0]} eq $name) {
+ next;
+ }
+ if (
+ !ref $value
+ and defined $value
+ ? (defined $ENV{$name} && $value eq $ENV{$name})
+ : !defined $ENV{$name}
+ ) {
+ next;
+ }
+ $out .= $self->$build_method($name, $value);
+ }
+ my $wrap_method = 'wrap_' . $self->shelltype . '_output';
+ if ($self->can($wrap_method)) {
+ return $self->$wrap_method($out);
}
return $out;
}
-# simple routines that take two arguments: an %ENV key and a value. return
-# strings that are suitable for passing directly to the relevant shell to set
-# said key to said value.
sub build_bourne_env_declaration {
- my $class = shift;
- my($name, $value) = @_;
- return defined($value) ? qq{export ${name}="${value}";\n} : qq{unset ${name};\n};
-}
+ my ($class, $name, $args) = @_;
+ my $value = $class->_interpolate($args, '$%s', '"', '\\%s');
-sub build_csh_env_declaration {
- my $class = shift;
- my($name, $value) = @_;
- return defined($value) ? qq{setenv ${name} "${value}";\n} : qq{unsetenv ${name};\n};
-}
+ if (!defined $value) {
+ return qq{unset $name;\n};
+ }
-sub build_win32_env_declaration {
- my $class = shift;
- my($name, $value) = @_;
- return defined($value) ? qq{set ${name}=${value}\n} : qq{set ${name}=\n};
-}
+ $value =~ s/(^|\G|$_path_sep)\$$name$_path_sep/$1\$$name\${$name+$_path_sep}/g;
+ $value =~ s/$_path_sep\$$name$/\${$name+$_path_sep}\$$name/;
-sub setup_env_hash_for {
- my ($class, $path, $deactivating) = @_;
- my %envs = $class->build_environment_vars_for($path, $deactivating, INTERPOLATE_ENV);
- @ENV{keys %envs} = values %envs;
+ qq{${name}="$value";\nexport ${name};\n}
}
-sub build_environment_vars_for {
- my ($class, $path, $deactivating, $interpolate) = @_;
+sub build_csh_env_declaration {
+ my ($class, $name, $args) = @_;
+ my ($value, @vars) = $class->_interpolate($args, '$%s', '"', '"\\%s"');
+ if (!defined $value) {
+ return qq{unsetenv $name;\n};
+ }
- if ($deactivating && $deactivating == DEACTIVATE_ONE) {
- return $class->build_deactivate_environment_vars_for($path, $interpolate);
- } elsif ($deactivating && $deactivating == DEACTIVATE_ALL) {
- return $class->build_deact_all_environment_vars_for($path, $interpolate);
- } else {
- return $class->build_activate_environment_vars_for($path, $interpolate);
+ my $out = '';
+ for my $var (@vars) {
+ $out .= qq{if ! \$?$name setenv $name '';\n};
}
-}
-# Build an environment value for a variable like PATH from a list of paths.
-# References to existing variables are given as references to the variable name.
-# Duplicates are removed.
-#
-# options:
-# - interpolate: INTERPOLATE_ENV/LITERAL_ENV
-# - exists: paths are included only if they exist (default: interpolate == INTERPOLATE_ENV)
-# - filter: function to apply to each path do decide if it must be included
-# - empty: the value to return in the case of empty value
-my %ENV_LIST_VALUE_DEFAULTS = (
- interpolate => INTERPOLATE_ENV,
- exists => undef,
- filter => sub { 1 },
- empty => undef,
-);
-sub _env_list_value {
- my $options = shift;
- die(sprintf "unknown option '$_' at %s line %u\n", (caller)[1..2])
- for grep { !exists $ENV_LIST_VALUE_DEFAULTS{$_} } keys %$options;
- my %options = (%ENV_LIST_VALUE_DEFAULTS, %{ $options });
- $options{exists} = $options{interpolate} == INTERPOLATE_ENV
- unless defined $options{exists};
-
- my %seen;
-
- my $value = join($Config{path_sep}, map {
- ref $_ ? ($^O eq 'MSWin32' ? "%${$_}%" : "\$${$_}") : $_
- } grep {
- ref $_ || (defined $_
- && length($_) > 0
- && !$seen{$_}++
- && $options{filter}->($_)
- && (!$options{exists} || -e $_))
- } map {
- if (ref $_ eq 'SCALAR' && $options{interpolate} == INTERPOLATE_ENV) {
- defined $ENV{${$_}} ? (split /\Q$Config{path_sep}/, $ENV{${$_}}) : ()
- } else {
- $_
- }
- } @_);
- return length($value) ? $value : $options{empty};
+ my $value_without = $value;
+ if ($value_without =~ s/(?:^|$_path_sep)\$$name(?:$_path_sep|$)//g) {
+ $out .= qq{if "\$$name" != '' setenv $name "$value";\n};
+ $out .= qq{if "\$$name" == '' };
+ }
+ $out .= qq{setenv $name "$value_without";\n};
+ return $out;
}
-sub build_activate_environment_vars_for {
- my ($class, $path, $interpolate) = @_;
- return (
- PERL_LOCAL_LIB_ROOT =>
- _env_list_value(
- { interpolate => $interpolate, exists => 0, empty => '' },
- $path,
- \'PERL_LOCAL_LIB_ROOT',
- ),
- PERL_MB_OPT => "--install_base " . _mb_escape_path($path),
- PERL_MM_OPT => "INSTALL_BASE=" . _mm_escape_path($path),
- PERL5LIB =>
- _env_list_value(
- { interpolate => $interpolate, exists => 0, empty => '' },
- $class->install_base_perl_path($path),
- \'PERL5LIB',
- ),
- PATH => _env_list_value(
- { interpolate => $interpolate, exists => 0, empty => '' },
- $class->install_base_bin_path($path),
- \'PATH',
- ),
- )
-}
+sub build_cmd_env_declaration {
+ my ($class, $name, $args) = @_;
+ my $value = $class->_interpolate($args, '%%%s%%', qr([()!^"<>&|]), '^%s');
+ if (!$value) {
+ return qq{\@set $name=\n};
+ }
-sub _mm_escape_path {
- my $path = shift;
- $path =~ s/\\/\\\\\\\\/g;
- if ($path =~ s/ /\\ /g) {
- $path = qq{"\\"$path\\""};
+ my $out = '';
+ my $value_without = $value;
+ if ($value_without =~ s/(?:^|$_path_sep)%$name%(?:$_path_sep|$)//g) {
+ $out .= qq{\@if not "%$name%"=="" set $name=$value\n};
+ $out .= qq{\@if "%$name%"=="" };
}
- return $path;
+ $out .= qq{\@set $name=$value_without\n};
+ return $out;
}
-sub _mb_escape_path {
- my $path = shift;
- $path =~ s/\\/\\\\/g;
- return qq{"$path"};
-}
+sub build_powershell_env_declaration {
+ my ($class, $name, $args) = @_;
+ my $value = $class->_interpolate($args, '$env:%s', '"', '`%s');
-sub active_paths {
- my ($class) = @_;
+ if (!$value) {
+ return qq{Remove-Item -ErrorAction 0 Env:\\$name;\n};
+ }
- return () unless defined $ENV{PERL_LOCAL_LIB_ROOT};
+ my $maybe_path_sep = qq{\$(if("\$env:$name"-eq""){""}else{"$_path_sep"})};
+ $value =~ s/(^|\G|$_path_sep)\$env:$name$_path_sep/$1\$env:$name"+$maybe_path_sep+"/g;
+ $value =~ s/$_path_sep\$env:$name$/"+$maybe_path_sep+\$env:$name+"/;
- return grep {
- # screen out entries that aren't actually reflected in @INC
- my $active_ll = $class->install_base_perl_path($_);
- grep { $_ eq $active_ll } @INC
+ qq{\$env:$name = \$("$value");\n};
+}
+sub wrap_powershell_output {
+ my ($class, $out) = @_;
+ return $out || " \n";
+}
+
+sub build_fish_env_declaration {
+ my ($class, $name, $args) = @_;
+ my $value = $class->_interpolate($args, '$%s', '"', '\\%s');
+ if (!defined $value) {
+ return qq{set -e $name;\n};
}
- grep { $_ ne '' }
- split /\Q$Config{path_sep}\E/, $ENV{PERL_LOCAL_LIB_ROOT};
+ $value =~ s/$_path_sep/ /g;
+ qq{set -x $name $value;\n};
}
-sub build_deactivate_environment_vars_for {
- my ($class, $path, $interpolate) = @_;
+sub _interpolate {
+ my ($class, $args, $var_pat, $escape, $escape_pat) = @_;
+ return
+ unless defined $args;
+ my @args = ref $args ? @$args : $args;
+ return
+ unless @args;
+ my @vars = map { $$_ } grep { ref $_ eq 'SCALAR' } @args;
+ my $string = join $_path_sep, map {
+ ref $_ eq 'SCALAR' ? sprintf($var_pat, $$_) : do {
+ s/($escape)/sprintf($escape_pat, $1)/ge; $_;
+ };
+ } @args;
+ return wantarray ? ($string, \@vars) : $string;
+}
- my @active_lls = $class->active_paths;
+sub pipeline;
- if (!grep { $_ eq $path } @active_lls) {
- warn "Tried to deactivate inactive local::lib '$path'\n";
- return ();
+sub pipeline {
+ my @methods = @_;
+ my $last = pop(@methods);
+ if (@methods) {
+ \sub {
+ my ($obj, @args) = @_;
+ $obj->${pipeline @methods}(
+ $obj->$last(@args)
+ );
+ };
+ } else {
+ \sub {
+ shift->$last(@_);
+ };
}
+}
- my $perl_path = $class->install_base_perl_path($path);
- my $arch_path = $class->install_base_arch_path($path);
- my $bin_path = $class->install_base_bin_path($path);
-
-
- my %env = (
- PERL_LOCAL_LIB_ROOT => _env_list_value(
- {
- exists => 0,
- },
- grep { $_ ne $path } @active_lls
- ),
- PERL5LIB => _env_list_value(
- {
- exists => 0,
- filter => sub {
- $_ ne $perl_path && $_ ne $arch_path
- },
- },
- \'PERL5LIB',
- ),
- PATH => _env_list_value(
- {
- exists => 0,
- filter => sub { $_ ne $bin_path },
- },
- \'PATH',
- ),
- );
+sub resolve_path {
+ my ($class, $path) = @_;
- # If removing ourselves from the "top of the stack", set install paths to
- # correspond with the new top of stack.
- if ($active_lls[0] eq $path) {
- my $new_top = $active_lls[1];
- $env{PERL_MB_OPT} = defined($new_top) ? "--install_base "._mb_escape_path($new_top) : undef;
- $env{PERL_MM_OPT} = defined($new_top) ? "INSTALL_BASE="._mm_escape_path($new_top) : undef;
- }
+ $path = $class->${pipeline qw(
+ resolve_relative_path
+ resolve_home_path
+ resolve_empty_path
+ )}($path);
- return %env;
+ $path;
}
-sub build_deact_all_environment_vars_for {
- my ($class, $path, $interpolate) = @_;
-
- my @active_lls = $class->active_paths;
-
- my %perl_paths = map { (
- $class->install_base_perl_path($_) => 1,
- $class->install_base_arch_path($_) => 1
- ) } @active_lls;
- my %bin_paths = map { (
- $class->install_base_bin_path($_) => 1,
- ) } @active_lls;
-
- my %env = (
- PERL_LOCAL_LIB_ROOT => undef,
- PERL_MM_OPT => undef,
- PERL_MB_OPT => undef,
- PERL5LIB => _env_list_value(
- {
- exists => 0,
- filter => sub {
- ! scalar grep { exists $perl_paths{$_} } $_[0]
- },
- },
- \'PERL5LIB'
- ),
- PATH => _env_list_value(
- {
- exists => 0,
- filter => sub {
- ! scalar grep { exists $bin_paths{$_} } $_[0]
- },
- },
- \'PATH'
- ),
- );
-
- return %env;
+sub resolve_empty_path {
+ my ($class, $path) = @_;
+ if (defined $path) {
+ $path;
+ } else {
+ '~/perl5';
+ }
}
-=begin testing
-
-#:: test classmethod
+sub resolve_home_path {
+ my ($class, $path) = @_;
+ return $path unless ($path =~ /^~/);
+ my ($user) = ($path =~ /^~([^\/]+)/); # can assume ^~ so undef for 'us'
+ my $homedir = do {
+ if (!defined $user && defined $ENV{HOME}) {
+ $ENV{HOME}
+ }
+ else {
+ require File::Glob;
+ File::Glob::bsd_glob("~$user", File::Glob::GLOB_TILDE());
+ }
+ };
+ unless (defined $homedir) {
+ require Carp;
+ Carp::croak(
+ "Couldn't resolve homedir for "
+ .(defined $user ? $user : 'current user')
+ );
+ }
+ $path =~ s/^~[^\/]*/$homedir/;
+ $path;
+}
-File::Path::rmtree('t/var/splat');
+sub resolve_relative_path {
+ my ($class, $path) = @_;
+ $path = File::Spec->rel2abs($path);
+}
-$c->ensure_dir_structure_for('t/var/splat');
+sub ensure_dir_structure_for {
+ my ($class, $path) = @_;
+ unless (-d $path) {
+ warn "Attempting to create directory ${path}\n";
+ }
+ require File::Basename;
+ my @dirs;
+ while(!-d $path) {
+ push @dirs, $path;
+ $path = File::Basename::dirname($path);
+ }
+ mkdir $_ for reverse @dirs;
+ return;
+}
-ok(-d 't/var/splat');
+sub guess_shelltype {
+ my $shellbin
+ = defined $ENV{SHELL}
+ ? (File::Spec->splitpath($ENV{SHELL}))[-1]
+ : ( $^O eq 'MSWin32' && exists $ENV{'!EXITCODE'} )
+ ? 'bash'
+ : ( $^O eq 'MSWin32' && $ENV{PROMPT} && $ENV{COMSPEC} )
+ ? (File::Spec->splitpath($ENV{COMSPEC}))[-1]
+ : ( $^O eq 'MSWin32' && !$ENV{PROMPT} )
+ ? 'powershell.exe'
+ : 'sh';
+
+ for ($shellbin) {
+ return
+ /csh$/ ? 'csh'
+ : /fish/ ? 'fish'
+ : /command(?:\.com)?$/i ? 'cmd'
+ : /cmd(?:\.exe)?$/i ? 'cmd'
+ : /4nt(?:\.exe)?$/i ? 'cmd'
+ : /powershell(?:\.exe)?$/i ? 'powershell'
+ : 'bourne';
+ }
+}
-=end testing
+1;
+__END__
=encoding utf8
$ perl -Mlocal::lib
export PERL_MB_OPT='--install_base /home/username/perl5'
export PERL_MM_OPT='INSTALL_BASE=/home/username/perl5'
- export PERL5LIB='/home/username/perl5/lib/perl5/i386-linux:/home/username/perl5/lib/perl5'
+ export PERL5LIB="/home/username/perl5/lib/perl5"
export PATH="/home/username/perl5/bin:$PATH"
+From a .bashrc file -
+
+ [ $SHLVL -eq 1 ] && eval "$(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)"
+
=head2 The bootstrapping technique
A typical way to install local::lib is using what is known as the
Windows users must also see L</Differences when using this module under Win32>.
-1. Download and unpack the local::lib tarball from CPAN (search for "Download"
+=over 4
+
+=item 1.
+
+Download and unpack the local::lib tarball from CPAN (search for "Download"
on the CPAN page about local::lib). Do this as an ordinary user, not as root
or administrator. Unpack the file in your home directory or in any other
convenient location.
-2. Run this:
+=item 2.
+
+Run this:
perl Makefile.PL --bootstrap
perl Makefile.PL --bootstrap=~/foo
-3. Run this: (local::lib assumes you have make installed on your system)
+=item 3.
+
+Run this: (local::lib assumes you have make installed on your system)
make test && make install
-4. Now we need to setup the appropriate environment variables, so that Perl
+=item 4.
+
+Now we need to setup the appropriate environment variables, so that Perl
starts using our newly generated lib/ directory. If you are using bash or
any other Bourne shells, you can add this to your shell startup script this
way:
- echo 'eval $(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)' >>~/.bashrc
+ echo '[ $SHLVL -eq 1 ] && eval "$(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)"' >>~/.bashrc
If you are using C shell, you can do this as follows:
/bin/csh
echo $SHELL
/bin/csh
- perl -I$HOME/perl5/lib/perl5 -Mlocal::lib >> ~/.cshrc
+ echo 'eval `perl -I$HOME/perl5/lib/perl5 -Mlocal::lib`' >> ~/.cshrc
-If you passed to bootstrap a directory other than default, you also need to give that as
-import parameter to the call of the local::lib module like this way:
+If you passed to bootstrap a directory other than default, you also need to
+give that as import parameter to the call of the local::lib module like this
+way:
- echo 'eval $(perl -I$HOME/foo/lib/perl5 -Mlocal::lib=$HOME/foo)' >>~/.bashrc
+ echo '[ $SHLVL -eq 1 ] && eval "$(perl -I$HOME/foo/lib/perl5 -Mlocal::lib=$HOME/foo)"' >>~/.bashrc
After writing your shell configuration file, be sure to re-read it to get the
changed settings into your current shell's environment. Bourne shells use
C<. ~/.bashrc> for this, whereas C shells use C<source ~/.cshrc>.
+=back
+
If you're on a slower machine, or are operating under draconian disk space
limitations, you can disable the automatic generation of manpages from POD when
installing modules by using the C<--no-manpages> argument when bootstrapping:
cd ../mydir2
... REPEAT ...
+When used in a C<.bashrc> file, it is recommended that you protect against
+re-activating a directory in a sub-shell. This can be done by checking the
+C<$SHLVL> variable as shown in synopsis. Without this, sub-shells created by
+the user or other programs will override changes made to the parent shell's
+environment.
+
If you are working with several C<local::lib> environments, you may want to
remove some of them from the current environment without disturbing the others.
You can deactivate one environment like this (using bourne sh):
C:\>perl -Mlocal::lib
set PERL_MB_OPT=--install_base C:\DOCUME~1\ADMINI~1\perl5
set PERL_MM_OPT=INSTALL_BASE=C:\DOCUME~1\ADMINI~1\perl5
- set PERL5LIB=C:\DOCUME~1\ADMINI~1\perl5\lib\perl5;C:\DOCUME~1\ADMINI~1\perl5\lib\perl5\MSWin32-x86-multi-thread
+ set PERL5LIB=C:\DOCUME~1\ADMINI~1\perl5\lib\perl5
set PATH=C:\DOCUME~1\ADMINI~1\perl5\bin;%PATH%
### To set the environment for this shell alone
C:\>perl -Mlocal::lib > %TEMP%\tmp.bat && %TEMP%\tmp.bat && del %TEMP%\tmp.bat
### instead of $(perl -Mlocal::lib=./)
-If you want the environment entries to persist, you'll need to add then to the
+If you want the environment entries to persist, you'll need to add them to the
Control Panel's System applet yourself or use L<App::local::lib::Win32Helper>.
The "~" is translated to the user's profile directory (the directory named for
directory is translated to a short name (which means the directory must exist)
and the subdirectories are created.
+=head3 PowerShell
+
+local::lib also supports PowerShell, and can be used with the
+C<Invoke-Expression> cmdlet.
+
+ Invoke-Expression "$(perl -Mlocal::lib)"
+
=head1 RATIONALE
The version of a Perl package on your machine is not always the version you
=item PATH
-PATH is appended to, rather than clobbered.
+=item PERL_LOCAL_LIB_ROOT
=back
+When possible, these will be appended to instead of overwritten entirely.
+
These values are then available for reference by any code after import.
=head1 CREATING A SELF-CONTAINED SET OF MODULES
there are a number of caveats, and the best approach is always to perform a
build against a clean perl (i.e. site and vendor as close to empty as possible).
-=head1 OPTIONS
+=head1 IMPORT OPTIONS
Options are values that can be passed to the C<local::lib> import besides the
directory to use. They are specified as C<use local::lib '--option'[, path];>
Remove all directories that were added to search paths by C<local::lib> from the
search paths.
-=head1 METHODS
+=head2 --shelltype
+
+Specify the shell type to use for output. By default, the shell will be
+detected based on the environment. Should be one of: C<bourne>, C<csh>,
+C<cmd>, or C<powershell>.
+
+=head2 --no-create
+
+Prevents C<local::lib> from creating directories when activating dirs. This is
+likely to cause issues on Win32 systems.
+
+=head1 CLASS METHODS
=head2 ensure_dir_structure_for
=over 4
-=item Arguments: $path, $interpolate
+=item Arguments: $path
-=item Return value: \%environment_vars
+=item Return value: %environment_vars
=back
library installation. Appends the directories C<lib> and C<perl5> to the given
path.
-=head2 install_base_arch_path
+=head2 lib_paths_for
=over 4
=item Arguments: $path
-=item Return value: $install_base_arch_path
+=item Return value: @lib_paths
=back
-Returns a path describing where to install the architecture-specific Perl
-modules for this local library installation. Based on the
-L</install_base_perl_path> method's return value, and appends the value of
-C<$Config{archname}>.
+Returns the list of paths perl will search for libraries, given a base path.
+This includes the base path itself, the architecture specific subdirectory, and
+perl version specific subdirectories. These paths may not all exist.
=head2 install_base_bin_path
=back
Returns a path describing where to install the executable programs for this
-local library installation. Based on the L</install_base_perl_path> method's
-return value, and appends the directory C<bin>.
+local library installation. Appends the directory C<bin> to the given path.
+
+=head2 installer_options_for
+
+=over 4
+
+=item Arguments: $path
+
+=item Return value: %installer_env_vars
+
+=back
+
+Returns a hash of environment variables that should be set to cause
+installation into the given path.
=head2 resolve_empty_path
L</resolve_relative_path>. The result of this final call is returned from
L</resolve_path>.
+=head1 OBJECT INTERFACE
+
+=head2 new
+
+=over 4
+
+=item Arguments: %attributes
+
+=item Return value: $local_lib
+
+=back
+
+Constructs a new C<local::lib> object, representing the current state of
+C<@INC> and the relevant environment variables.
+
+=head1 ATTRIBUTES
+
+=head2 roots
+
+An arrayref representing active C<local::lib> directories.
+
+=head2 inc
+
+An arrayref representing C<@INC>.
+
+=head2 libs
+
+An arrayref representing the PERL5LIB environment variable.
+
+=head2 bins
+
+An arrayref representing the PATH environment variable.
+
+=head2 extra
+
+A hashref of extra environment variables (e.g. C<PERL_MM_OPT> and
+C<PERL_MB_OPT>)
+
+=head2 no_create
+
+If set, C<local::lib> will not try to create directories when activating them.
+
+=head1 OBJECT METHODS
+
+=head2 clone
+
+=over 4
+
+=item Arguments: %attributes
+
+=item Return value: $local_lib
+
+=back
+
+Constructs a new C<local::lib> object based on the existing one, overriding the
+specified attributes.
+
+=head2 activate
+
+=over 4
+
+=item Arguments: $path
+
+=item Return value: $new_local_lib
+
+=back
+
+Constructs a new instance with the specified path active.
+
+=head2 deactivate
+
+=over 4
+
+=item Arguments: $path
+
+=item Return value: $new_local_lib
+
+=back
+
+Constructs a new instance with the specified path deactivated.
+
+=head2 deactivate_all
+
+=over 4
+
+=item Arguments: None
+
+=item Return value: $new_local_lib
+
+=back
+
+Constructs a new instance with all C<local::lib> directories deactivated.
+
+=head2 environment_vars_string
+
+=over 4
+
+=item Arguments: [ $shelltype ]
+
+=item Return value: $shell_env_string
+
+=back
+
+Returns a string to set up the C<local::lib>, meant to be run by a shell.
+
+=head2 build_environment_vars
+
+=over 4
+
+=item Arguments: None
+
+=item Return value: %environment_vars
+
+=back
+
+Returns a hash with the variables listed above, properly set to use the
+given path as the base directory.
+
+=head2 setup_env_hash
+
+=over 4
+
+=item Arguments: None
+
+=item Return value: None
+
+=back
+
+Constructs the C<%ENV> keys for the given path, by calling
+L</build_environment_vars>.
+
+=head2 setup_local_lib
+
+Constructs the C<%ENV> hash using L</setup_env_hash>, and set up C<@INC>.
+
=head1 A WARNING ABOUT UNINST=1
Be careful about using local::lib in combination with "make install UNINST=1".
=over 4
-=item * The perl toolchain is unable to handle directory names with spaces in it,
-so you can't put your local::lib bootstrap into a directory with spaces. What
-you can do is moving your local::lib to a directory with spaces B<after> you
-installed all modules inside your local::lib bootstrap. But be aware that you
-can't update or install CPAN modules after the move.
+=item * Directory names with spaces in them are not well supported by the perl
+toolchain and the programs it uses. Pure-perl distributions should support
+spaces, but problems are more likely with dists that require compilation. A
+workaround you can do is moving your local::lib to a directory with spaces
+B<after> you installed all modules inside your local::lib bootstrap. But be
+aware that you can't update or install CPAN modules after the move.
=item * Rather basic shell detection. Right now anything with csh in its name is
assumed to be a C shell or something compatible, and everything else is assumed
to be Bourne, except on Win32 systems. If the C<SHELL> environment variable is
not set, a Bourne-compatible shell is assumed.
-=item * Bootstrap is a hack and will use CPAN.pm for ExtUtils::MakeMaker even if you
-have CPANPLUS installed.
-
-=item * Kills any existing PERL5LIB, PERL_MM_OPT or PERL_MB_OPT.
+=item * Kills any existing PERL_MM_OPT or PERL_MB_OPT.
=item * Should probably auto-fixup CPAN config if not already done.
+=item * local::lib loads L<File::Spec>. When used to set shell variables,
+this isn't a problem. When used inside a perl script, any L<File::Spec>
+version inside the local::lib will be ignored. A workaround for this is using
+C<use lib "$ENV{HOME}/perl5/lib/perl5";> inside the script instead of using
+C<local::lib> directly.
+
+=item * Conflicts with L<ExtUtils::MakeMaker>'s C<PREFIX> option.
+C<local::lib> uses the C<INSTALL_BASE> option, as it has more predictable and
+sane behavior. If something attempts to use the C<PREFIX> option when running
+a F<Makefile.PL>, L<ExtUtils::MakeMaker> will refuse to run, as the two
+options conflict. This can be worked around by temporarily unsetting the
+C<PERL_MM_OPT> environment variable.
+
+=item * Conflicts with L<Module::Build>'s C<--prefix> option. Similar to the
+previous limitation, but any C<--prefix> option specified will be ignored.
+This can be worked around by temporarily unsetting the C<PERL_MB_OPT>
+environment variable.
+
=back
Patches very much welcome for any of the above.
=over 4
-=item * On Win32 systems, does not have a way to write the created environment variables
-to the registry, so that they can persist through a reboot.
+=item * On Win32 systems, does not have a way to write the created environment
+variables to the registry, so that they can persist through a reboot.
=back
documentation additions, contributed by Christopher Nehren <apeiron@cpan.org>.
Doc patches for a custom local::lib directory, more cleanups in the english
-documentation and a L<german documentation|POD2::DE::local::lib> contributed by Torsten Raudssus
-<torsten@raudssus.de>.
+documentation and a L<german documentation|POD2::DE::local::lib> contributed by
+Torsten Raudssus <torsten@raudssus.de>.
Hans Dieter Pearcey <hdp@cpan.org> sent in some additional tests for ensuring
things will install properly, submitted a fix for the bug causing problems with
Documentation patches to make win32 usage clearer by
David Mertens <dcmertens.perl@gmail.com> (run4flat).
-Brazilian L<portuguese translation|POD2::PT_BR::local::lib> and minor doc patches contributed by Breno
-G. de Oliveira <garu@cpan.org>.
+Brazilian L<portuguese translation|POD2::PT_BR::local::lib> and minor doc
+patches contributed by Breno G. de Oliveira <garu@cpan.org>.
Improvements to stacking multiple local::lib dirs and removing them from the
environment later on contributed by Andrew Rodland <arodland@cpan.org>.
-Patch for Carp version mismatch contributed by Hakim Cassimally <osfameron@cpan.org>.
+Patch for Carp version mismatch contributed by Hakim Cassimally
+<osfameron@cpan.org>.
+
+Rewrite of internals and numerous bug fixes and added features contributed by
+Graham Knop <haarg@haarg.org>.
=head1 COPYRIGHT
-Copyright (c) 2007 - 2010 the local::lib L</AUTHOR> and L</CONTRIBUTORS> as
+Copyright (c) 2007 - 2013 the local::lib L</AUTHOR> and L</CONTRIBUTORS> as
listed above.
=head1 LICENSE
the same terms as the Perl 5 programming language system itself.
=cut
-
-1;
projects / p5sagit/local-lib.git / blobdiff