view release on metacpan or  search on metacpan

lib/App/cpanminus/fatscript.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}', '"', '"\\%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', '"', '`%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};
    }
    $value =~ s/$_path_sep/ /g;
    qq{set -x $name $value;\n};
  }
  
  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; $_;