my ($class, @args) = @_;
my @steps;
+ my %opts;
while (@args) {
my $arg = shift @args;
elsif ( $arg eq '--deactivate-all' ) {
push @steps, ['deactivate_all'];
}
+ elsif ( $arg =~ /^--shelltype(?:=(.*))?$/ ) {
+ my $shell = defined $1 ? $1 : shift @args;
+ $opts{shelltype} = $shell;
+ }
+ elsif ( $arg eq '--no-create' ) {
+ $opts{no_create} = 1;
+ }
elsif ( $arg =~ /^--/ ) {
die "Unknown import argument: $arg";
}
push @steps, ['activate', undef];
}
- my $self = $class->new;
+ my $self = $class->new(%opts);
for (@steps) {
my ($method, @args) = @$_;
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};
}
sub _remove_from {
my ($list, @remove) = @_;
+ return @$list
+ if !@remove;
my %remove = map { $_ => 1 } @remove;
grep !$remove{$_}, _as_list($list);
}
if (!grep { $_ eq $path } @active_lls) {
warn "Tried to deactivate inactive local::lib '$path'\n";
- return;
+ return $self;
}
my %args = (
my @active_lls = $self->active_paths;
- my %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) ],
- );
+ 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) ],
+ );
+ }
$args{extra} = $self->installer_options_for(undef);
my ($self, $path) = @_;
$self = $self->new unless ref $self;
$path = $self->resolve_path($path);
- $self->ensure_dir_structure_for($path);
+ $self->ensure_dir_structure_for($path)
+ unless $self->no_create;
+
+ $path = ( Win32::GetShortPathName($path) || $path )
+ if $^O eq 'MSWin32';
my @active_lls = $self->active_paths;
}
sub _legacy {
- my ($self, $path, $deactivating) = @_;
+ my ($self, $path) = @_;
$self = $self->new unless ref $self;
- $self = $self->${\($deactivating ? 'deactivate' : 'activate')}($path) if defined $path;
+ if (defined $path) {
+ $self = $self->activate($path);
+ }
$self;
}
&& ${$value->[0]} eq $name) {
next;
}
+ if (!ref $value
+ && defined $value ? $value eq $ENV{$name} : !defined $ENV{$name}
+ ) {
+ next;
+ }
$out .= $self->$build_method($name, $value);
}
return $out;
sub build_bourne_env_declaration {
my ($class, $name, $args) = @_;
my $value = $class->_interpolate($args);
- $value =~ s/"/\\"/g
- if defined $value;
- return defined($value) ? qq{export ${name}="${value}"\n} : qq{unset ${name}\n};
+ defined $value
+ ? qq{export ${name}="${value}";\n}
+ : qq{unset ${name};\n};
}
sub build_csh_env_declaration {
my ($class, $name, $args) = @_;
- my ($value, @vars) = $class->_interpolate($args);
- @vars = grep { $_ ne $name || defined $value } @vars;
- $value =~ s/"/"\\""/g
- if defined $value;
- join '',
- (map qq{if ! \$?$_ setenv $_ "";\n}, @vars),
- (defined($value)
+ my ($value, @vars) = $class->_interpolate($args, undef, undef, '"', qq{"\\"});
+ (join '', map qq{if ! \$?$_ setenv $_ "";\n}, @vars)
+ . defined $value
? qq{setenv $name "$value";\n}
- : qq{unsetenv $name;\n});
+ : qq{unsetenv $name;\n};
}
sub build_cmd_env_declaration {
my ($class, $name, $args) = @_;
- my $value = $class->_interpolate($args, '%', '%');
- $value =~ s/"/\\"/g
- if defined $value;
- return defined($value) ? qq{set ${name} "${value}"\n} : qq{set ${name}=\n};
+ my $value = $class->_interpolate($args, '%', '%', qr([()!^"<>&|]), '^');
+ defined $value
+ ? qq{set $name=$value\n}
+ : qq{set $name=\n};
+}
+sub build_powershell_env_declaration {
+ my ($class, $name, $args) = @_;
+ my $value = $class->_interpolate($args, '$env:', '', '"', '`');
+ defined $value
+ ? qq{\$env:$name = "$value"\n}
+ : "Remove-Item Env:\\$name\n";
}
+
sub _interpolate {
- my ($class, $args, $start, $end) = @_;
+ my ($class, $args, $start, $end, $escape, $escape_char) = @_;
return
unless defined $args;
return $args
unless @$args;
$start = '$' unless defined $start;
$end = '' unless defined $end;
+ $escape = '"' unless defined $escape;
+ $escape_char = "\\" unless defined $escape_char;
my @vars;
my $string = join($Config{path_sep}, map {
- (ref $_ && ref $_ eq 'SCALAR') ? do { push @vars, $$_; $start.$$_.$end }
- : $_
+ 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;
}
resolve_empty_path
)}($path);
- $path = Win32::GetShortPathName($path)
- if $^O eq 'MSWin32';
-
$path;
}
=cut
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'
- }
- };
-
- # 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/) {
- 'cmd'
- } elsif(/cmd\.exe/) {
- 'cmd'
- } elsif(/4nt\.exe/) {
- 'cmd'
- } else {
- $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'
+ : /command\.com/ ? 'cmd'
+ : /cmd\.exe/ ? 'cmd'
+ : /4nt\.exe/ ? 'cmd'
+ : /powershell\.exe/ ? 'powershell'
+ : 'bourne';
}
- return $shelltype;
}
1;
Remove all directories that were added to search paths by C<local::lib> from the
search paths.
+=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 METHODS
=head2 ensure_dir_structure_for
=over 4
-=item Arguments: $path, $interpolate
+=item Arguments: $path
=item Return value: %environment_vars