1#@!#!123s

: / proc / 2 / root / opt / dedrads / perl / IMH /
Filename : Shell.pm
back
#!/usr/bin/perl
# encoding: utf-8
#
# author: Kyle Yetter
#

package IMH::Shell;

use strict;
use warnings;
use Text::ParseWords qw();
use IPC::Open3;
use Symbol 'gensym';

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw( shell_escape shell_join shell_split sh ) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw( shell_escape shell_join shell_split sh );

our $VERSION = '0.1';

#
# shell_escape
#
# Given a string argument, escape shell-unsafe characters to ensure the string
# represents a single token in a command line
#
sub shell_escape {
  my $token = @_ ? shift : $_;

  if ( length( $token ) == 0 ) { return "''"; }
  $token =~ s/([^A-Za-z0-9_\-\.,:\/@\n])/\\$1/g;
  $token =~ s/\n/'\n'/g;
  return $token;
}

sub shell_join {
  return join( ' ', map { shell_escape } @_ );
}

*shell_split = *Text::ParseWords::shellwords;

sub sh {
  my $cmd = shell_join( @_ );
  my( $write, $read, $err, $pid );
  $err = gensym;

  $pid = open3( $write, $read, $err, @_ );
  my $out_str = join( '', <$read> );
  my $err_str = join( '', <$err> );

  close( $write );
  close( $read );
  close( $err );

  waitpid( $pid, 0 );
  my $exit_status = $? >> 8;
  return({
    command => $cmd,
    status  => $exit_status,
    success => !$exit_status,
    output  => $out_str,
    error   => $err_str
  });
}



1;
__END__
=head1 NAME

IMH::Shell - Tools to construct command lines with safely escaped values

=head1 SYNOPSIS

  use IMH::Shell;

  # Each token of the command is escaped to ensure it will be received by the command
  # as a single shell token, even if it has spaces or quotes or other unsafe characters
  my @command_tokens = ( '/scripts/pkgacct', @opts, $user );
  my $command = join( ' ', map { shell_escape( $_ ) } @command_tokens );

  for my $out_line ( `$command 2>&1` ) {
    print $out_line;
  }

=head1 AUTHOR

Kyle Yetter, E<lt>kyley@inmotionhosting.com<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2011 by Kyle Yetter.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.1 or,
at your option, any later version of Perl 5 you may have available.


=cut