my @steps;
my %opts;
+ my $shelltype;
while (@args) {
my $arg = shift @args;
DEATH
}
elsif ($arg eq '--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";
+ 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_all'];
}
elsif ( $arg =~ /^--shelltype(?:=(.*))?$/ ) {
- my $shell = defined $1 ? $1 : shift @args;
- $opts{shelltype} = $shell;
+ $shelltype = defined $1 ? $1 : shift @args;
}
elsif ( $arg eq '--no-create' ) {
$opts{no_create} = 1;
}
if ($0 eq '-') {
- $self->print_environment_vars_for;
+ print $self->environment_vars_string($shelltype);
exit 0;
}
else {
- $self->setup_local_lib_for;
+ $self->setup_local_lib;
}
}
sub installer_options_for {
my ($class, $path) = @_;
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,
+ PERL_MM_OPT =>
+ defined $path ? "INSTALL_BASE="._mm_escape_path($path) : undef,
+ PERL_MB_OPT =>
+ defined $path ? "--install_base "._mb_escape_path($path) : undef,
};
}
my ($self, $path) = @_;
$self = $self->new unless ref $self;
$path = $self->resolve_path($path);
+ $path = $self->normalize_path($path);
my @active_lls = $self->active_paths;
}
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)) ],
+ 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) ],
);
$self->ensure_dir_structure_for($path)
unless $self->no_create;
- $path = ( Win32::GetShortPathName($path) || $path )
- if $^O eq 'MSWin32';
+ $path = $self->normalize_path($path);
my @active_lls = $self->active_paths;
$self->clone(%args);
}
-sub _legacy {
+sub normalize_path {
my ($self, $path) = @_;
- $self = $self->new unless ref $self;
- if (defined $path) {
- $self = $self->activate($path);
- }
- $self;
+ $path = ( Win32::GetShortPathName($path) || $path )
+ if $^O eq 'MSWin32';
+ return $path;
}
sub build_environment_vars_for {
- my ($self) = _legacy(@_);
+ 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)),
}
sub setup_local_lib_for {
- my ($self) = _legacy(@_);
- $self->setup_env_hash_for;
+ my $self = $_[0]->new->activate($_[1]);
+ $self->setup_local_lib;
+}
+
+sub setup_local_lib {
+ my $self = shift;
+ $self->setup_env_hash;
@INC = @{$self->inc};
}
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 %env = $self->build_environment_vars;
for my $key (keys %env) {
if (defined $env{$key}) {
$ENV{$key} = $env{$key};
}
sub print_environment_vars_for {
- my $self = shift;
- print $self->environment_vars_string_for(@_);
+ print $_[0]->environment_vars_string_for(@_[1..$#_]);
}
sub environment_vars_string_for {
- my $self = _legacy(@_);
+ my $self = $_[0]->new->activate($_[1]);
+ $self->environment_vars_string;
+}
+sub environment_vars_string {
+ my ($self, $shelltype) = @_;
- my $build_method = 'build_' . $self->shelltype . '_env_declaration';
+ $shelltype ||= $self->guess_shelltype;
+
+ my $build_method = "build_${shelltype}_env_declaration";
my @envs = (
PATH => $self->bins,
sub build_bourne_env_declaration {
my ($class, $name, $args) = @_;
- my $value = $class->_interpolate($args);
- my $joined;
- for (@$value) {
- if (!defined $joined) {
- $joined = $_;
- }
- elsif ($_ eq "\$$name") {
- $joined .= "\${$name+$Config{path_sep}}$_";
- }
- else {
- $joined .= "$Config{path_sep}$_";
- }
+ my $value = $class->_interpolate($args, '$%s', '"', '\\%s');
+
+ if (!defined $value) {
+ return qq{unset $name;\n};
}
- defined $value
- ? qq{export ${name}="$joined";\n}
- : 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{export ${name}="$value";\n}
}
+
sub build_csh_env_declaration {
my ($class, $name, $args) = @_;
- my ($value, @vars) = $class->_interpolate($args, undef, undef, '"', qq{"\\"});
+ my ($value, @vars) = $class->_interpolate($args, '$%s', '"', '"\\%s"');
+ if (!defined $value) {
+ return qq{unsetenv $name;\n};
+ }
my $out = '';
- if (@vars) {
- $out = qq{if \$?$name };
+ for my $var (@vars) {
+ $out .= qq{if ! \$?$name setenv $name '';\n};
}
- $out .= defined $value ? qq{setenv $name "}.join($Config{path_sep},@$value).qq{";\n} : qq{unsetenv $name;\n};
- if (@vars) {
- my $no_var = $class->_interpolate([ grep { !ref } @$args ], undef, undef, '"', qq{"\\"});
- if (defined $no_var) {
- $out .= qq{if ! \$?$name setenv $name "}.join($Config{path_sep},@$no_var).qq{";\n};
- }
+
+ 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;
+ $out .= qq{setenv $name "$value_without";\n};
+ return $out;
}
+
sub build_cmd_env_declaration {
my ($class, $name, $args) = @_;
- my $value = $class->_interpolate($args, '%', '%', qr([()!^"<>&|]), '^');
- defined $value
- ? qq{\@set $name=}.join($Config{path_sep},@$value).qq{\n}
- : qq{\@set $name=\n};
+ my $value = $class->_interpolate($args, '%%%s%%', qr([()!^"<>&|]), '^%s');
+ if (!$value) {
+ return qq{\@set $name=\n};
+ }
+
+ 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;
}
+
sub build_powershell_env_declaration {
my ($class, $name, $args) = @_;
- my $value = $class->_interpolate($args, '$env:', '', '"', '`');
- defined $value
- ? qq{\$env:$name = "}.join($Config{path_sep},@$value).qq{";\n}
- : "Remove-Item Env:\\$name;\n";
+ my $value = $class->_interpolate($args, '$env:%s', '"', '`%s');
+
+ if (!$value) {
+ return qq{Remove-Item Env:\\$name;\n};
+ }
+
+ 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+"/;
+
+ qq{\$env:$name = \$("$value");\n};
}
sub wrap_powershell_output {
my ($class, $out) = @_;
return $out || " \n";
}
-
sub _interpolate {
- my ($class, $args, $start, $end, $escape, $escape_char) = @_;
+ my ($class, $args, $var_pat, $escape, $escape_pat) = @_;
return
unless defined $args;
- $args = [ $args ]
- unless ref $args;
+ my @args = ref $args ? @$args : $args;
return
- unless @$args;
- $start = '$' unless defined $start;
- $end = '' unless defined $end;
- $escape = '"' unless defined $escape;
- $escape_char = "\\" unless defined $escape_char;
- my @vars;
- my $string = [ map {
- if (ref $_ && ref $_ eq 'SCALAR') {
- push @vars, $$_;
- $start.$$_.$end;
- }
- else {
- my $str = $_;
- $str =~ s/($escape)/$escape_char$1/g;
- $str;
- }
- } @$args ];
- return wantarray ? ($string, @vars) : $string;
+ 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;
}
sub pipeline;
projects / p5sagit/local-lib.git / blobdiff