File Coverage

blib/lib/Shell/Config/Generate.pm

Criterion	Covered	Total	%
statement	116	191	60.7
branch	43	86	50.0
condition	14	30	46.6
subroutine	22	30	73.3
pod	16	16	100.0
total	211	353	59.7

package Shell::Config::Generate;

use strict;
use warnings;
use 5.008001;
use Shell::Guess;
use Carp qw( croak );
use Exporter ();

# ABSTRACT: Portably generate config for any shell
our $VERSION = '0.32_01'; # TRIAL VERSION
$VERSION = eval $VERSION;


sub new
{
  my($class) = @_;
  bless { commands => [], echo_off => 0 }, $class;
}


sub set
{
  my($self, $name, $value) = @_;

  push @{ $self->{commands} }, ['set', $name, $value];

  $self;
}


sub set_path
{
  my($self, $name, @list) = @_;

  push @{ $self->{commands} }, [ 'set_path', $name, @list ];

  $self;
}


sub append_path
{
  my($self, $name, @list) = @_;

  push @{ $self->{commands} }, [ 'append_path', $name, @list ]
    if @list > 0;

  $self;
}


sub prepend_path
{
  my($self, $name, @list) = @_;

  push @{ $self->{commands} }, [ 'prepend_path', $name, @list ]
    if @list > 0;

  $self;
}


sub comment
{
  my($self, @comments) = @_;

  push @{ $self->{commands} }, ['comment', $_] for @comments;

  $self;
}


sub shebang
{
  my($self, $location) = @_;
  $self->{shebang} = $location;
  $self;
}


sub echo_off
{
  my($self) = @_;
  $self->{echo_off} = 1;
  $self;
}


sub echo_on
{
  my($self) = @_;
  $self->{echo_off} = 0;
  $self;
}

sub _value_escape_csh
{
  my $value = shift() . '';
  $value =~ s/([\n!])/\\$1/g;
  $value =~ s/(')/'"$1"'/g;
  $value;
}

sub _value_escape_fish
{
  my $value = shift() . '';
  $value =~ s/([\n])/\\$1/g;
  $value =~ s/(')/'"$1"'/g;
  $value;
}

sub _value_escape_sh
{
  my $value = shift() . '';
  $value =~ s/(')/'"$1"'/g;
  $value;
}

sub _value_escape_win32
{
  my $value = shift() . '';
  $value =~ s/%/%%/g;
  $value =~ s/([&^|<>()])/^$1/g;
  $value =~ s/\n/^\n\n/g;
  $value;
}

#   `0  Null
#   `a  Alert bell/beep
#   `b  Backspace
#   `f  Form feed (use with printer output)
#   `n  New line
#   `r  Carriage return
# `r`n  Carriage return + New line
#   `t  Horizontal tab
#   `v  Vertical tab (use with printer output)

my %ps = ( # microsoft would have to be different
  "\0" => '`0',
  "\a" => '`a',
  "\b" => '`b',
  "\f" => '`f',
  "\r" => '`r',
  "\n" => '`n',
  "\t" => '`t',
  #"\v" => '`v',
);

sub _value_escape_powershell
{
  my $value = shift() . '';
  $value =~ s/(["'`\$#()])/`$1/g;
  $value =~ s/([\0\a\b\f\r\n\t])/$ps{$1}/eg;
  $value;
}


sub set_alias
{
  my($self, $alias, $command) = @_;

  push @{ $self->{commands} }, ['alias', $alias, $command];
}


sub set_path_sep
{
  my($self, $sep) = @_;
  push @{ $self->{commands} }, ['set_path_sep', $sep];
}


sub generate
{
  my($self, $shell) = @_;

  if(defined $shell)
  {
    if(ref($shell) eq '')
    {
      my $method = join '_', $shell, 'shell';
      if(Shell::Guess->can($method))
      {
        $shell = Shell::Guess->$method;
      }
      else
      {
        croak("unknown shell type: $shell");
      }
    }
  }
  else
  {
    $shell = Shell::Guess->running_shell;
  }

  $self->_generate($shell);
}

sub _generate
{
  my($self, $shell) = @_;

  my $buffer = '';
  my $sep    = $shell->is_win32 ? ';' : ':';

  if(exists $self->{shebang} && $shell->is_unix)
  {
    if(defined $self->{shebang})
    { $buffer .= "#!" . $self->{shebang} . "\n" }
    else
    { $buffer .= "#!" . $shell->default_location . "\n" }
  }

  if($self->{echo_off} && ($shell->is_cmd || $shell->is_command))
  {
    $buffer .= '@echo off' . "\n";
  }

  foreach my $args (map { [@$_] } @{ $self->{commands} })
  {
    my $command = shift @$args;

    if($command eq 'set_path_sep')
    {
      $sep = shift @$args;
      next;
    }

    # rewrite set_path as set
    if($command eq 'set_path')
    {
      $command = 'set';
      my $name = shift @$args;
      $args = [$name, join $sep, @$args];
    }

    if($command eq 'set')
    {
      my($name, $value) = @$args;
      if($shell->is_c)
      {
        $value = _value_escape_csh($value);
        $buffer .= "setenv $name '$value';\n";
      }
      elsif($shell->is_fish)
      {
        $value = _value_escape_fish($value);
        $buffer .= "set -x $name '$value';\n";
      }
      elsif($shell->is_bourne)
      {
        $value = _value_escape_sh($value);
        $buffer .= "$name='$value';\n";
        $buffer .= "export $name;\n";
      }
      elsif($shell->is_cmd || $shell->is_command)
      {
        $value = _value_escape_win32($value);
        $buffer .= "set $name=$value\n";
      }
      elsif($shell->is_power)
      {
        $value = _value_escape_powershell($value);
        $buffer .= "\$env:$name = \"$value\"\n";
      }
      else
      {
        croak 'don\'t know how to "set" with ' . $shell->name;
      }
    }

    elsif($command eq 'append_path' || $command eq 'prepend_path')
    {
      my($name, @values) = @$args;
      if($shell->is_c)
      {
        my $value = join $sep, map { _value_escape_csh($_) } @values;
        $buffer .= "test \"\$?$name\" = 0 && setenv $name '$value' || ";
        if($command eq 'prepend_path')
        { $buffer .= "setenv $name '$value$sep'\"\$$name\"" }
        else
        { $buffer .= "setenv $name \"\$$name\"'$sep$value'" }
        $buffer .= ";\n";
      }
      elsif($shell->is_bourne)
      {
        my $value = join $sep, map { _value_escape_sh($_) } @values;
        $buffer .= "if [ -n \"\$$name\" ] ; then\n";
        if($command eq 'prepend_path')
        { $buffer .= "  $name='$value$sep'\$$name;\n  export $name;\n" }
        else
        { $buffer .= "  $name=\$$name'$sep$value';\n  export $name\n" }
        $buffer .= "else\n";
        $buffer .= "  $name='$value';\n  export $name;\n";
        $buffer .= "fi;\n";
      }
      elsif($shell->is_fish)
      {
        my $value = join ' ', map { _value_escape_fish($_) } @values;
        $buffer .= "if [ \"\$$name\" == \"\" ]; set -x $name $value; else; ";
        if($command eq 'prepend_path')
        { $buffer .= "set -x $name $value \$$name;" }
        else
        { $buffer .= "set -x $name \$$name $value;" }
        $buffer .= "end\n";
      }
      elsif($shell->is_cmd || $shell->is_command || $shell->is_power)
      {
        my $value = join $sep, map { $shell->is_power ? _value_escape_powershell($_) : _value_escape_win32($_) } @values;
        if($shell->is_power)
        {
          $buffer .= "if(\$env:$name) { ";
          if($command eq 'prepend_path')
          { $buffer .= "\$env:$name = \"$value$sep\" + \$env:$name" }
          else
          { $buffer .= "\$env:$name = \$env:$name + \"$sep$value\"" }
          $buffer .= " } else { \$env:$name = \"$value\" }\n";
        }
        else
        {
          $buffer .= "if defined $name (set ";
          if($command eq 'prepend_path')
          { $buffer .= "$name=$value$sep%$name%" }
          else
          { $buffer .= "$name=%$name%$sep$value" }
          $buffer .=") else (set $name=$value)\n";
        }
      }
      else
      {
        croak 'don\'t know how to "append_path" with ' . $shell->name;
      }
    }

    elsif($command eq 'comment')
    {
      if($shell->is_unix || $shell->is_power)
      {
        $buffer .= "# $_\n" for map { split /\n/, } @$args;
      }
      elsif($shell->is_cmd || $shell->is_command)
      {
        $buffer .= "rem $_\n" for map { split /\n/, } @$args;
      }
      else
      {
        croak 'don\'t know how to "comment" with ' . $shell->name;
      }
    }

    elsif($command eq 'alias')
    {
      if($shell->is_bourne)
      {
        $buffer .= "alias $args->[0]=\"$args->[1]\";\n";
      }
      elsif($shell->is_c)
      {
        $buffer .= "alias $args->[0] $args->[1];\n";
      }
      elsif($shell->is_cmd || $shell->is_command)
      {
        $buffer .= "DOSKEY $args->[0]=$args->[1] \$*\n";
      }
      elsif($shell->is_power)
      {
        $buffer .= sprintf("function %s { %s \$args }\n", $args->[0], _value_escape_powershell($args->[1]));
      }
      elsif($shell->is_fish)
      {
        $buffer .= "alias $args->[0] '$args->[1]';\n";
      }
      else
      {
        croak 'don\'t know how to "alias" with ' . $shell->name;
      }
    }
  }

  $buffer;
}


sub generate_file
{
  my($self, $shell, $filename) = @_;
  my $fh;
  open($fh, '>', $filename) or die "cannot open $filename: $!";
  print $fh $self->generate($shell) or die "cannot write $filename: $!";
  close $fh or die "error closing $filename: $!";
}

*import = \&Exporter::import;

our @EXPORT_OK = qw( win32_space_be_gone cmd_escape_path powershell_escape_path );


*_win_to_posix_path = $^O =~ /^(cygwin|msys)$/ ? \&Cygwin::win_to_posix_path : sub { $_[0] };
*_posix_to_win_path = $^O =~ /^(cygwin|msys)$/ ? \&Cygwin::posix_to_win_path : sub { $_[0] };

sub win32_space_be_gone
{
  return @_ if $^O !~ /^(MSWin32|cygwin|msys)$/;
  map { /\s/ ? _win_to_posix_path(Win32::GetShortPathName(_posix_to_win_path($_))) : $_ } @_;
}


sub cmd_escape_path
{
  my $path = shift() . '';
  $path =~ s/%/%%/g;
  $path =~ s/([&^|<>])/^$1/g;
  $path =~ s/\n/^\n\n/g;
  "\"$path\"";
}


sub powershell_escape_path
{
  map { my $p = _value_escape_powershell($_); $p =~ s/ /` /g; $p } @_;
}

1;

__END__