view release on metacpan or  search on metacpan

lib/local/lib.pm  view on Meta::CPAN

}
sub environment_vars_string {
  my ($self, $shelltype) = @_;

  $shelltype ||= $self->guess_shelltype;

  my $extra = $self->extra;
  my @envs = (
    PATH                => $self->bins,
    PERL5LIB            => $self->libs,
    PERL_LOCAL_LIB_ROOT => $self->roots,
    map { $_ => $extra->{$_} } sort keys %$extra,
  );
  $self->_build_env_string($shelltype, \@envs);
}

sub _build_env_string {
  my ($self, $shelltype, $envs) = @_;
  my @envs = @$envs;

  my $build_method = "build_${shelltype}_env_declaration";

  my $out = '';
  while (@envs) {
    my ($name, $value) = (shift(@envs), shift(@envs));
    if (
        ref $value
        && @$value == 1
        && ref $value->[0]
        && ref $value->[0] eq 'SCALAR'
        && ${$value->[0]} eq $name) {
      next;
    }
    $out .= $self->$build_method($name, $value);
  }
  my $wrap_method = "wrap_${shelltype}_output";
  if ($self->can($wrap_method)) {
    return $self->$wrap_method($out);
  }
  return $out;
}

sub build_bourne_env_declaration {
  my ($class, $name, $args) = @_;
  my $value = $class->_interpolate($args, '${%s:-}', qr/["\\\$!`]/, '\\%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"; export ${name};\n}
}

sub build_csh_env_declaration {
  my ($class, $name, $args) = @_;
  my ($value, @vars) = $class->_interpolate($args, '${%s}', qr/["\$]/, '"\\%s"');
  if (!defined $value) {
    return qq{unsetenv $name;\n};
  }

  my $out = '';
  for my $var (@vars) {
    $out .= qq{if ! \$?$name setenv $name '';\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 .= qq{setenv $name "$value_without";\n};
  return $out;
}

sub build_cmd_env_declaration {
  my ($class, $name, $args) = @_;
  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:%s', qr/["\$]/, '`%s');

  if (!$value) {
    return qq{Remove-Item -ErrorAction 0 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 build_fish_env_declaration {
  my ($class, $name, $args) = @_;
  my $value = $class->_interpolate($args, '$%s', qr/[\\"'$ ]/, '\\%s');
  if (!defined $value) {
    return qq{set -e $name;\n};
  }

  # fish has special handling for PATH, CDPATH, and MANPATH.  They are always
  # treated as arrays, and joined with ; when storing the environment.  Other
  # env vars can be arrays, but will be joined without a separator.  We only
  # really care about PATH, but might as well make this routine more general.
  if ($name =~ /^(?:CD|MAN)?PATH$/) {
    $value =~ s/$_path_sep/ /g;
    my $silent = $name =~ /^(?:CD)?PATH$/ ? " 2>"._devnull : '';
    return qq{set -x $name $value$silent;\n};
  }

  my $out = '';
  my $value_without = $value;
  if ($value_without =~ s/(?:^|$_path_sep)\$$name(?:$_path_sep|$)//g) {
    $out .= qq{set -q $name; and set -x $name $value;\n};