File Coverage

lib/Proc/Command.pm

Criterion	Covered	Total	%
statement	30	41	73.1
branch	8	22	36.3
condition	1	3	33.3
subroutine	7	7	100.0
pod	0	1	0.0
total	46	74	62.1

#!perl
#
# The copyright notice and plain old documentation (POD)
# are at the end of this file.
#
package  Proc::Command;

use strict;
use 5.001;
use warnings;
use warnings::register;


#####
# Connect up with the event log.
#
use vars qw( $VERSION $DATE $FILE);
$VERSION = '1.05';
$DATE = '2003/07/27';
$FILE = __FILE__;

use vars qw(@ISA @EXPORT_OK);
require Exporter;
@ISA=('Exporter');
@EXPORT_OK = qw(&command);

######
# backtick that does not use the shell for Perl under Windows
#
#
sub command
{

    shift @_ if $_[0] eq 'Proc::Command' || ref($_[0]);  # drop self on object call
    my ($command, $trys, $sleep) = @_;

    $trys = 1 unless $trys;
    $sleep = 2 unless $sleep;

    my ($i, @response);
    for( $i=0; $i<$trys; $i++ ) {

        #######
        # This form does not use the shell to execute the command.
        #
        # Having the shell pop-up in middle of a long run, just ... bad.
        #
        $command = "MCR $command" if $^O eq 'VMS';
        unless (open (CMD, '-|', $command)) {
            unless( $i < $trys ) {
                warn "Cannot fork $command\n";
                return undef;
            }
            last unless $i < $trys;
            sleep( $sleep );
            next;
        }
        @response = ;
        unless( close CMD ) {
            unless( $i < $trys ) {
                warn "Error $? forking $command\n";
                return undef;
            }
            sleep( $sleep );
            next;
        }

   }
   @response = () unless @response;
   return wantarray ? @response : (join '',@response);

}

1

__END__