view release on metacpan or  search on metacpan

Async.pm  view on Meta::CPAN

		my $buf;
		my $nr = read $self->{'PIPE'}, $buf, 8192;
		if ( $nr ) {
			$self->{'DATA'} .= $buf;
		} elsif ( defined $nr ) { # EOF
			$self->{'FINISHED'} = 1;
			return 1;
		} else {
			$self->{'ERROR'} = "Read error: $!";
			$self->{'FINISHED'} = 1;
			return 1;
		}
	}

	return 0;
}

# Return error message if an error occurred
# Return false if no error occurred
sub error { $_[0]{'ERROR'} }

# Return resulting data if async process is complete
# return undef if it is incopmplete
# a true $force argument waits for the process to complete before returning
sub result {
	my ( $self, $force ) = ( shift, @_ );
	if ( $self->{'FINISHED'} ) {
		$self->{'DATA'};
	} elsif ( $force ) {
		$self->ready( $force );
		$self->{'DATA'};
	} else {
		return;
	}
}

sub DESTROY {
	my $self = shift;
	return if $self->{'PPID'} != $$; # created in a different process
	my $pid = $self->{'PID'};
	local ( $., $@, $!, $^E, $? );
	kill 9, $pid; # I don't care.
	waitpid $pid, 0;
}

package AsyncTimeout;
our $VERSION = '0.14';

our @ISA = 'Async';

sub new {
	my ( $class, $task, $timeout, $msg ) = ( shift, @_ );
	$msg = "Timed out\n" unless defined $msg;
	my $newtask = sub {
		local $SIG{'ALRM'} = sub { die "TIMEOUT\n" };
		alarm $timeout;
		my $s = eval { $task->() };
		return $msg if not defined $s and $@ eq "TIMEOUT\n";
		return $s;
	};
	$class->SUPER::new( $newtask );
}

package AsyncData;
our $VERSION = '0.14';

our @ISA = 'Async';

sub new {
	require Storable;
	my ( $class, $task ) = ( shift, @_ );
	my $newtask = sub {
		my $v = $task->();
		return Storable::freeze( $v );
	};
	$class->SUPER::new( $newtask );
}

sub result {
	require Storable;
	my $self = shift;
	my $rc = $self->SUPER::result( @_ );
	return defined $rc ? Storable::thaw( $rc ) : $rc;
}

1;

__END__

=head1 NAME

Async - Asynchronous evaluation of Perl code (with optional timeouts)

=head1 SYNOPSIS

  my $proc = Async->new( sub { any perl code you want executed } );

  if ( $proc->ready ) {
    # the code has finished executing
    if ( $proc->error ) {
      # something went wrong
    } else {
      $result = $proc->result; # The return value of the code
    }
  }

  # or:
  $result = $proc->result( 'force completion' ); # wait for it to finish

=head1 DESCRIPTION

This module runs some code in a separate process and retrieves its
result. Since the code is running in a separate process, your main
program can continue with whatever it was doing while the separate
code is executing. This separate code is called an I<asynchronous
computation>.

=head1 INTERFACE

To check if the asynchronous computation is complete you can call
the C<ready()>
method, which returns true if so, and false if it is still running.

After the asynchronous computation is complete, you should call the
C<error()> method to make sure that everything went all right.
C<error()> will return C<undef> if the computation completed normally,
and an error message otherwise.

Data returned by the computation can be retrieved with the C<result()>
method. The data must be a single string; any non-string value
returned by the computation will be stringified. (See AsyncData below
for how to avoid this.) If the computation has not completed yet,
C<result()> will return an undefined value.

C<result()> takes an optional parameter, C<$force>. If C<$force> is
true, then the calling process will wait until the asynchronous
computation is complete before returning.

=head2 C<AsyncTimeout>

  use Async;
  $proc = AsyncTimeout->new( sub { ... }, $timeout, $special );