X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2Flocal-lib.git;a=blobdiff_plain;f=lib%2Flocal%2Flib.pm;h=216426be0e9014cb38f4b3a76333430bdbc6535e;hp=5f9045633600c8c3f53361776df389fd87352c4e;hb=1730f48f02f596ea214aab12466dd6471a2990d7;hpb=73c9a8add20f699a4aa29bf814ddad0b5cfd440c diff --git a/lib/local/lib.pm b/lib/local/lib.pm index 5f90456..216426b 100644 --- a/lib/local/lib.pm +++ b/lib/local/lib.pm @@ -3,32 +3,25 @@ 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 5.006; use File::Spec (); -use File::Path (); use Config; -our $VERSION = '1.008_020'; # 1.8.20 development release +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 =~ /−/) { @@ -41,521 +34,550 @@ 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 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 =~ /^--/) { + elsif ( $arg eq '--deactivate-all' ) { + push @steps, ['deactivate_all']; + } + 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); -} -=begin testing + $args{extra} = { $self->installer_options_for(undef) }; -#:: 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); - - # 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[-1] 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'); + + if (!defined $value) { + return qq{unset $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/; + + qq{${name}="$value";\nexport ${name};\n} } sub build_csh_env_declaration { - my $class = shift; - my($name, $value) = @_; - return defined($value) ? qq{setenv ${name} "${value}"\n} : qq{unsetenv ${name}\n}; -} + my ($class, $name, $args) = @_; + my ($value, @vars) = $class->_interpolate($args, '$%s', '"', '"\\%s"'); + if (!defined $value) { + return qq{unsetenv $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}; -} + my $out = ''; + for my $var (@vars) { + $out .= qq{if ! \$?$name setenv $name '';\n}; + } -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; + 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_environment_vars_for { - my ($class, $path, $deactivating, $interpolate) = @_; +sub build_cmd_env_declaration { + my ($class, $name, $args) = @_; + my $value = $class->_interpolate($args, '%%%s%%', qr([()!^"<>&|]), '^%s'); + if (!$value) { + return qq{\@set $name=\n}; + } - if ($deactivating == DEACTIVATE_ONE) { - return $class->build_deactivate_environment_vars_for($path, $interpolate); - } elsif ($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 = ''; + 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%"=="" }; } + $out .= qq{\@set $name=$value_without\n}; + return $out; } -# 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}; -} +sub build_powershell_env_declaration { + my ($class, $name, $args) = @_; + my $value = $class->_interpolate($args, '$env:%s', '"', '`%s'); -sub build_activate_environment_vars_for { - my ($class, $path, $interpolate) = @_; - return ( - PERL_LOCAL_LIB_ROOT => - _env_list_value( - { interpolate => $interpolate, exists => 0, empty => '' }, - \'PERL_LOCAL_LIB_ROOT', - $path, - ), - PERL_MB_OPT => "--install_base ${path}", - PERL_MM_OPT => "INSTALL_BASE=${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', - ), - ) -} + if (!$value) { + return qq{Remove-Item -ErrorAction 0 Env:\\$name;\n}; + } -sub active_paths { - my ($class) = @_; + 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 () unless defined $ENV{PERL_LOCAL_LIB_ROOT}; + qq{\$env:$name = \$("$value");\n}; +} +sub wrap_powershell_output { + my ($class, $out) = @_; + return $out || " \n"; +} - 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 +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[-1] eq $path) { - my $new_top = $active_lls[-2]; - $env{PERL_MB_OPT} = defined($new_top) ? "--install_base ${new_top}" : undef; - $env{PERL_MM_OPT} = defined($new_top) ? "INSTALL_BASE=${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 @@ -584,9 +606,13 @@ From the shell - $ 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 @@ -603,12 +629,18 @@ By default local::lib installs itself and the CPAN modules into ~/perl5. Windows users must also see L. -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 @@ -620,33 +652,40 @@ to specify the name of the directory when you call bootstrap, as follows: 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. +=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: @@ -666,6 +705,12 @@ installation to install modules in different directories directly this way: 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 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): @@ -706,14 +751,14 @@ C, you can use this: 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. The "~" is translated to the user's profile directory (the directory named for @@ -722,6 +767,13 @@ the user under "Documents and Settings" (Windows XP or earlier) or "Users" 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 cmdlet. + + Invoke-Expression "$(perl -Mlocal::lib)" + =head1 RATIONALE The version of a Perl package on your machine is not always the version you @@ -772,10 +824,12 @@ values: =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 @@ -784,7 +838,7 @@ See L for one way to do this - but note that 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 import besides the directory to use. They are specified as C @@ -800,7 +854,18 @@ was added by C, instead of adding it. Remove all directories that were added to search paths by C 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, C, +C, or C. + +=head2 --no-create + +Prevents C from creating directories when activating dirs. This is +likely to cause issues on Win32 systems. + +=head1 CLASS METHODS =head2 ensure_dir_structure_for @@ -832,9 +897,9 @@ given path as the base directory. =over 4 -=item Arguments: $path, $interpolate +=item Arguments: $path -=item Return value: \%environment_vars +=item Return value: %environment_vars =back @@ -882,20 +947,19 @@ Returns a path describing where to install the Perl modules for this local library installation. Appends the directories C and C 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 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 @@ -908,8 +972,20 @@ C<$Config{archname}>. =back Returns a path describing where to install the executable programs for this -local library installation. Based on the L method's -return value, and appends the directory C. +local library installation. Appends the directory C 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 @@ -968,6 +1044,141 @@ L, which then has its result passed to L. The result of this final call is returned from L. +=head1 OBJECT INTERFACE + +=head2 new + +=over 4 + +=item Arguments: %attributes + +=item Return value: $local_lib + +=back + +Constructs a new C object, representing the current state of +C<@INC> and the relevant environment variables. + +=head1 ATTRIBUTES + +=head2 roots + +An arrayref representing active C 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 and +C) + +=head2 no_create + +If set, C 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 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 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, 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. + +=head2 setup_local_lib + +Constructs the C<%ENV> hash using L, and set up C<@INC>. + =head1 A WARNING ABOUT UNINST=1 Be careful about using local::lib in combination with "make install UNINST=1". @@ -982,32 +1193,48 @@ install UNINST=1" and local::lib if you understand these possible consequences. =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 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 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 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. When used to set shell variables, +this isn't a problem. When used inside a perl script, any L +version inside the local::lib will be ignored. A workaround for this is using +C inside the script instead of using +C directly. + +=item * Conflicts with L's C option. +C uses the C option, as it has more predictable and +sane behavior. If something attempts to use the C option when running +a F, L will refuse to run, as the two +options conflict. This can be worked around by temporarily unsetting the +C environment variable. + +=item * Conflicts with L'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 +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 @@ -1068,8 +1295,8 @@ Patches to correctly output commands for csh style shells, as well as some documentation additions, contributed by Christopher Nehren . Doc patches for a custom local::lib directory, more cleanups in the english -documentation and a L contributed by Torsten Raudssus -. +documentation and a L contributed by +Torsten Raudssus . Hans Dieter Pearcey sent in some additional tests for ensuring things will install properly, submitted a fix for the bug causing problems with @@ -1091,17 +1318,21 @@ Mark Stosberg provided the code for the now deleted Documentation patches to make win32 usage clearer by David Mertens (run4flat). -Brazilian L and minor doc patches contributed by Breno -G. de Oliveira . +Brazilian L and minor doc +patches contributed by Breno G. de Oliveira . Improvements to stacking multiple local::lib dirs and removing them from the environment later on contributed by Andrew Rodland . -Patch for Carp version mismatch contributed by Hakim Cassimally . +Patch for Carp version mismatch contributed by Hakim Cassimally +. + +Rewrite of internals and numerous bug fixes and added features contributed by +Graham Knop . =head1 COPYRIGHT -Copyright (c) 2007 - 2010 the local::lib L and L as +Copyright (c) 2007 - 2013 the local::lib L and L as listed above. =head1 LICENSE @@ -1110,5 +1341,3 @@ This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut - -1;