view release on metacpan or  search on metacpan

lib/Async/Simple/Task/ForkTmpFile.pm  view on Meta::CPAN

        my ( $data ) = @_; # source data for task
        ... your task code ...
        return( $result );
    }

=cut


=head2 answer

Result of current task

=cut


=head2 has_answer

has_answer is true, if the task has been finished and result has been ready

=cut


=head2 timeout

timeout - positive numeric value = seconds between checking for result.

inherited from Async::Simple::Task.

=cut


=head2 kill_on_exit

Kills process from parent in case of object desctuction

=cut


=head2 new()

    my $task = Async::Simple::Task::ForkTmpFile->new( %all_optional_params );


Possible keys for %all_optional_params:

    task         => coderef, function, called for each "data" passed to child process via $task->put( $data );

    timeout      => timeout in seconds between child checkings for new data passed. default 0.01

    kill_on_exit => kill (1) or not (0) subprocess on object destroy (1 by default).

=cut

=head2 tmp_dir

    Path, that used for store tomporary files.
    This path must be writable.
    It can be empty; in this case ( File::Spec->tmpdir() || $ENV{TEMP} ) will be used

    By default:
    During taint -T mode always writes files to current directory ( path = '' )
    Windows outside taint -T mode writes files by default to C:\TEMP or C:\TMP
    Unix    outside taint -T mode writes files by default to /var/tmp/

=cut

has tmp_dir => (
    is       => 'ro',
    isa      => 'Str',
    lazy     => 1,
    builder  => 'make_tmp_dir',
);

sub make_tmp_dir {
    my ( $self ) = @_;

    my $tmp_dir = File::Spec->tmpdir() || '';

    # For WIN taint mode calculated path starts with '\'. Remove it and stay at current(empty) dir
    $tmp_dir = '' if $tmp_dir =~ /^\\$/;

    # TEMP = C:\Users\XXXXXX~1\AppData\Local\Temp
    $tmp_dir ||= $ENV{TEMP} // '';

    # Untaint ENV: fallback, if File::Spec->tmpdir failed
    return [ $tmp_dir =~ /^(.+)$/ ]->[0];
};


=head2 BUILD

internal. Some tricks here:)

    1. Master process called $task->new with fork() inside
    2. After forking done we have two processes:
    2.1. Master gets one side of reader/writer tmp file handlers and pid of child
    2.2. Child - another side of tmp file handlers and extra logic with everlasting loop

=cut

#  Writable pipe between parent and child.
#  Each of them has pair of handlers, for duplex communication.
has writer => (
    is       => 'rw',
    isa      => 'Str',
);


#   Readable pipe between parent and child.
#   Each of them has pair of handlers, for duplex communication.
has reader => (
    is       => 'rw',
    isa      => 'Str',
);


=head2 fork_child

Makes child process and returns pid of child process to parent or 0 to child process

=cut

sub fork_child {
    my ( $self ) = @_;

    my( $randname, $parent_writer_fname, $parent_reader_fname );
    $randname = sub {
        my @x = ( 'a'..'z', 'A'..'Z', 0..9 );
        join( "", map { $x[ int( rand @x - 0.01 ) ] } 1 .. 64 )
    };

    for ( 1..10 ) {
    	$parent_writer_fname = File::Spec->catfile( $self->tmp_dir, '_pw_tmp_' . $randname->() );
    	$parent_reader_fname = File::Spec->catfile( $self->tmp_dir, '_pr_tmp_' . $randname->() );

  	next if -f $parent_writer_fname || -f $parent_reader_fname;
	last;
    };

    die 'Can`t obtain unique fname'  if -f $parent_writer_fname || -f $parent_reader_fname;

    my $pid = fork() // die "fork() failed: $!";

    # With taint mode we use current directory as temp,
    # Otherwise - default writable temp directory from File::Spec->tmpdir();

    # child
    unless ( $pid ) {
        $self->writer( $parent_reader_fname );
        $self->reader( $parent_writer_fname );

        # Important!
        # Just after that we trap into BUILD
        # with the infinitive loop for child process (pid=0)
        return 0;
    }

    # parent
    $self->writer( $parent_writer_fname );
    $self->reader( $parent_reader_fname );

    return $pid;
};


=head2 get

Reads from task, if something can be readed or returns undef after timeout.

    my $result = $task->get;

Please note! If your function can return an undef value, then you shoud check

    $task->has_result.

=cut

sub get {
    my ( $self ) = @_;

    # Try to read "marker" into data within timeout
    # Each pack starts with an empty line and serialized string of useful data.
    open( my $fh, '<', $self->reader ) or return;

    my $data = <$fh>;

    return unless defined $data;
    return unless $data =~ /\n/;

    close( $fh );

    # In case, when reader still opened for writing
    # We are not allowed to remove file, so we should wait
    for ( 1..10 ) {
        last  if unlink $self->reader;
	sleep $self->timeout;
    }

    my $answer = $data
        ? eval{ $self->serializer->deserialize( $data )->[0] }
        : undef;

    $self->answer( $answer );
};