File Coverage

blib/lib/Term/ShellKit/Commands.pm

Criterion	Covered	Total	%
statement	7	45	15.5
branch	0	28	0.0
condition	0	2	0.0
subroutine	3	11	27.2
pod	7	8	87.5
total	17	94	18.0

package Term::ShellKit::Commands;

require Term::ShellKit;

######################################################################

sub eval ($) {
  my $input = shift;
  my @results = eval "package $Term::ShellKit::CurrentPackage; no strict qw( refs vars subs ); $input";
  die $@ if $@;
  ! scalar( @results ) ? '' :
  scalar( @results == 1 ) ? (
      ( ! defined $results[0] ) ? 'undef' : "$results[0]"
    ) :
      join(', ', map {
      ( ! defined ) ? 'undef' : ( ref $_ ) ? "$_" : "'$_'"
    } @results );
}

sub package ($) {
  my $input = shift;
  $input =~ s/\;\s*$//;
  $Term::ShellKit::CurrentPackage = $input;
}

sub exit {
  exit;
}

sub kit {
  die "No kit name provided" unless ( scalar @_ );
  map { Term::ShellKit::load_kit( $_ ) } @_;
}

######################################################################

sub execute ($) {
  my $command = shift;
  qx{$command};
}

######################################################################

sub echo (;$) {
  shift;
}

######################################################################

use vars qw( $PODViewer );
$PODViewer ||= "Pod::Text" || "Pod::Text::TermCap";

sub help (;$) {
  my $topic = shift || 'Term::ShellKit::Commands';

  $topic =~ s/kit /Term::ShellKit::/;
  if ( $topic =~ /^[\w\:]+$/ ) {
    (my $lib = $topic . '.pm' ) =~ s|::|/|go;
    if ( ! $::INC{$lib} ) { eval { local $SIG{__DIE__}; require $lib } }
    $topic = $::INC{$lib} if ( $::INC{$lib} );
  }

  Term::ShellKit::require_package( $PODViewer );
  $PODViewer->new()->parse_from_file( $topic );
  return;
}

######################################################################

use vars qw( %CommandAliases );
%CommandAliases = (
  '"' => 'echo',
  '$' => 'eval',
  '!' => 'execute',
  'q' => 'exit',
  'quit' => 'exit',
  '?' => 'help',
);

sub alias {
  if ( scalar @_ ) {
    my $cmd = shift;
    if ( scalar @_ ) {
      $CommandAliases{ $cmd } = join ' ', @_;
      return;
    } else {
     $CommandAliases{ $cmd };
    }
  } else {
    map "$_: $CommandAliases{ $_ }", sort keys %CommandAliases;
  }
}

sub _shell_rewrite {
  my $input = shift;

  $input =~ s/\A\s+//;
  my ($command, $args) = split(' ', $input, 2);
  my $alias = $CommandAliases{ $command }
      or return;

  return $alias . ( length($args) ? " $args" : '' );
}

######################################################################

1;

__END__