view release on metacpan or  search on metacpan

lib/AnyEvent/Run.pm  view on Meta::CPAN

package AnyEvent::Run;

use strict;
use base 'AnyEvent::Handle';

use AnyEvent ();
use AnyEvent::Util ();
use Carp;
use POSIX ();

our $VERSION = 0.01;

our $FD_MAX = eval { POSIX::sysconf(&POSIX::_SC_OPEN_MAX) - 1 } || 1023;

BEGIN {
    if ( AnyEvent::WIN32 ) {
        eval { require Win32 };
        die "Win32 failed to load:\n$@" if $@;
        
        eval { require Win32::Console };
        die "Win32::Console failed to load:\n$@" if $@;
        Win32::Console->import();
        
        eval { require Win32API::File };
        die "Win32API::File failed to load:\n$@" if $@;
        Win32API::File->import('FdGetOsFHandle');
        
        eval { require Win32::Job };
        die "Win32::Job failed to load:\n$@" if $@;
    }
};

sub new {
    my ( $class, %args ) = @_;
    
    my $cls = $args{class};
    my $cmd = $args{cmd};
    
    unless ( $cls || $cmd ) {
        croak "mandatory argument cmd or class is missing";
    }
    
    if ( $cls ) {
        my $method = $args{method} || 'main';
        # double quotes around -e needed on Windows for some reason
        $cmd = "$^X -M$cls -I" . join( ' -I', @INC ) . " -e \"${cls}::${method}()\"";
    }
    
    $args{args} ||= [];
    
    my ($parent, $child) = AnyEvent::Util::portable_socketpair
        or croak "unable to create AnyEvent::Run socketpair: $!";
        
    $args{fh} = $child;
    
    my $self = $class->SUPER::new(%args);

    my $pid = fork;
    
    if ( $pid == 0 ) {
        # child
        
        close $child;
                
        # Stdio should not be tied.
        if (tied *STDOUT) {
            carp "Cannot redirect into tied STDOUT.  Untying it";
            untie *STDOUT;
        }
        if (tied *STDERR) {
            carp "Cannot redirect into tied STDERR.  Untying it";
            untie *STDERR;
        }
        
        # Set priority if requested
        if ( $args{priority} && $args{priority} =~ /^-?\d+$/ ) {
            $self->_set_priority();
        }
        
        # Redirect STDIN from the read end of the stdin pipe.
        close STDIN if AnyEvent::WIN32;
        open STDIN, "<&" . fileno($parent)
            or croak "can't redirect STDIN in child pid $$: $!";

        # Redirect STDOUT
        close STDOUT if AnyEvent::WIN32;
        open STDOUT, ">&" . fileno($parent)
            or croak "can't redirect stdout in child pid $$: $!";

        # Redirect STDERR
        close STDERR if AnyEvent::WIN32;
        open STDERR, ">&" . fileno($parent) 
            or die "can't redirect stderr in child: $!";
        
        # Make STDOUT and STDERR auto-flush.
        select STDERR; $| = 1;
        select STDOUT; $| = 1;
        
        if ( AnyEvent::WIN32 )  {
            # The Win32 pseudo fork sets up the std handles in the child
            # based on the true win32 handles For the exec these get
            # remembered, so manipulation of STDIN/OUT/ERR is not enough.
            # Only necessary for the exec, as Perl CODE subroutine goes
            # through 0/1/2 which are correct.  But of course that coderef
            # might invoke exec, so better do it regardless.
            # HACK: Using Win32::Console as nothing else exposes SetStdHandle
            Win32::Console::_SetStdHandle(
                STD_INPUT_HANDLE(),
                FdGetOsFHandle(fileno($parent))
            );
            Win32::Console::_SetStdHandle(
                STD_OUTPUT_HANDLE(),
                FdGetOsFHandle(fileno($parent))
            );
            Win32::Console::_SetStdHandle(
                STD_ERROR_HANDLE(),

lib/AnyEvent/Run.pm  view on Meta::CPAN

    # parent
    close $parent;
    
    $self->{child_pid} = $pid;
    
    return $self;
}

sub _set_priority {
    my $self = shift;
    
    my $pri = $self->{priority};
    
    if ( AnyEvent::WIN32 ) {
        eval { require Win32::API };
        die "Win32::API failed to load:\n$@" if $@;
        
        eval { require Win32::Process };
        die "Win32::Process failed to load:\n$@" if $@;
        
        # ABOVE_NORMAL_PRIORITY_CLASS and BELOW_NORMAL_PRIORITY_CLASS aren't
        # provided by Win32::Process so their values have been hardcoded.
        $pri = $pri <= -16 ? Win32::Process::HIGH_PRIORITY_CLASS()
             : $pri <= -6  ? 0x00008000 # ABOVE_NORMAL
             : $pri <= 4   ? Win32::Process::NORMAL_PRIORITY_CLASS()
             : $pri <= 14  ? 0x00004000 # BELOW_NORMAL
             :               Win32::Process::IDLE_PRIORITY_CLASS();
        
        my $getCurrentProcess = Win32::API->new('kernel32', 'GetCurrentProcess', ['V'], 'N');
        my $setPriorityClass  = Win32::API->new('kernel32', 'SetPriorityClass',  ['N', 'N'], 'N');
        
        my $processHandle = eval { $getCurrentProcess->Call(0) };
        
        if ( !$processHandle || $@ ) {
            carp "Can't get process handle ($^E) [$@]";
            return;
        }
        
        eval { $setPriorityClass->Call($processHandle, $pri) };
        
        if ( $@ ) {
            carp "Couldn't set priority to $pri ($^E) [$@]";
        }
    }
    else {
        eval {
            unless ( setpriority( 0, $$, $pri ) ) {
                die "unable to set child priority to $pri\n";
            }
        };
        carp $@ if $@;
    }
}

sub DESTROY {
    my $self = shift;
    
    # XXX: doesn't play nice with linger option, so clear wbuf
    $self->{wbuf} = '';
    
    $self->SUPER::DESTROY(@_);
    
    if ( $self->{child_pid} ) {
        kill 9 => $self->{child_pid};
        waitpid $self->{child_pid}, 0;
    }
}

1;
__END__

=head1 NAME

AnyEvent::Run - Run a process or coderef asynchronously

=head1 SYNOPSIS

    use AnyEvent;
    use AnyEvent::Run;
    
    my $cv = AnyEvent->condvar;

    my $handle = AnyEvent::Run->new(
        cmd      => [ 'ls', '-l' ],
        priority => 19,              # optional nice value 
        on_read  => sub {
            my $handle = shift;
            ...
            $cv->send;
        },
        on_error  => sub {
            my ($handle, $fatal, $msg) = @_;
            ...
            $cv->send;
        },
    );
    
    # Send data to the process's STDIN
    $handle->push_write($data);

    $cv->recv;

=head1 DESCRIPTION

AnyEvent::Run is a subclass of L<AnyEvent::Handle>, so reading it's
documentation first is recommended.

This module is designed to run a child process, using an explicit
command line, a class name, or a coderef.  It should work on any
Unix system as well as Windows 2000 and higher.

For an alternate way of running a coderef in a forked process using
AnyEvent, see L<AnyEvent::Util>'s fork_call function.

=head1 METHODS

=head2 $handle = new( %args )

Creates and returns a new AnyEvent::Run object.  The process forks and either
execs (Unix) or launches a new process (Windows).  If using a coderef, the
coderef is run in the forked process.