# -*- mode: perl; coding: euc-jp; -*-
package Fork;
require 5.005;
require Exporter;
use IO::Handle;
use IO::Pipe;
use POSIX qw/ EAGAIN WNOHANG /;
use strict;
use vars qw/ @ISA @EXPORT_OK $TIMEOUT $RETRY $VERSION /;
@ISA       = qw/ Exporter /;
@EXPORT_OK = qw/ $TIMEOUT $RETRY /;

=head1 NAME

Fork - 非同期に実行される子プロセスを生成する

=head1 SYNOPSIS

 use Fork;
 $p = new Fork( "sort" );
 $p->print( "abc\n", "def\n", "ace\n" );
 $p->close;
 while( $_ = $p->getline ){
     print;
 }

=head1 DESCRIPTION

C<Fork> は，指定されたコマンドを fork して子プロセスとして実行し，その
標準入力への書き込みと，標準出力及び標準エラー出力からの読み出しを行う
ためのモジュールである．

=cut

# バージョン番号
$VERSION = sprintf("%d.%02d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/);

# デフォルトのタイムアウト時間
$TIMEOUT = 60;

# fork に失敗した場合に再試行する回数
$RETRY = 5;

=head1 CONSTRUCTOR

=over 4

=item new ( COMMAND [,ARGV] )

C<Fork> オブジェクトを生成する．

子プロセスとして実行するコマンドを第1引数に指定し，第2引数以降にそのコ
マンドに対するコマンドラインオプションを指定する．

Example:

   $p = new Fork( "cat" "-n" );

=cut
sub new {
    my( $class, @argv ) = @_;
    ( @argv >= 1 ) || die 'Usage: $p = new Fork( command, [arguments...] )';

    # 子プロセスと通信するためのパイプを生成する
    my $read  = new IO::Pipe;
    my $write = new IO::Pipe;

    # 子プロセスを fork する
    for( my $i; $i<$RETRY; $i++ ){
	if( my $pid = fork ){
	    # 親プロセス側の処理
	    $read->reader;
	    $write->writer;
	    my $this = {
			PID     => $pid,
			READ    => $read,
			WRITE   => $write,
			TIMEOUT => $TIMEOUT,
		       };
	    bless $this, $class;
	    return $this;
	} elsif( defined $pid ){
	    # 子プロセス側の処理
	    $write->reader;
	    $read->writer;
	    $read->autoflush(1);
	    STDOUT->fdopen( $read, "w" );
	    STDERR->fdopen( $read, "w" );
	    STDIN->fdopen( $write, "r" );
	    exec @argv;
	    exit 0; # Not reach.
	} elsif( $! == &EAGAIN ){
	    sleep 5;
	    next;
	} else {
	    warn sprintf( "Can't fork(%s): $!\n", join( ' ', @argv ) );
	    return undef;
	}
    }
    warn sprintf( "Can't fork(%s): Retry conter exceeded.\n", join( ' ', @argv ) );
    undef;
}

=back

=head1 METHODS

=over 4

=item print( [STR,] )

子プロセスの標準入力に対して，指定された文字列を出力する．

=cut
sub print {
    my $this = shift;
    ( $this->{WRITE}->print( @_ ), $this->flush )[$[];
}

=item printf( FORMAT [,ARG] )

子プロセスの標準入力に対して，書式付き出力を行う．

=cut
sub printf {
    my $this = shift;
    ( $this->print( sprintf( shift @_, @_ ) ), $this->flush )[$[];
}

=item flush

子プロセスの標準入力と連結されているパイプを flush する．

=cut
sub flush {
    my( $this ) = @_;
    $this->{WRITE}->flush;
}

=item close

子プロセスの標準入力と連結されているパイプを閉じる．

=cut
sub close {
    my( $this ) = @_;
    $this->{WRITE}->close;
}

=item timeout( VAL )

子プロセスの出力を C<getline> メソッドによって取り出す場合のタイムアウ
ト時間を設定する．このメソッドによって特に設定されなければ，タイムアウ
ト時間には変数 C<$Fork::TIMEOUT> の値が使われる．

=cut
sub timeout {
    my( $this, $timeout ) = @_;
    $this->{TIMEOUT} = eval $timeout;
}

=item getline

子プロセスの標準出力及び標準エラー出力から1行分のデータを取り出す．
C<timeout> メソッドによって設定された時間以内に読み出されなければ，
C<undef> を返す．

=cut
sub getline {
    my( $this ) = @_;
    my $buf;
    local $SIG{ALRM} = sub { die "SIGALRM is received\n"; };
    eval {
	alarm $this->{TIMEOUT};
	$buf = $this->{READ}->getline;
	alarm 0;
    };
    ( $@ =~ /SIGALRM is received/ ) ? undef : $buf;
}

=item getlines

子プロセスの標準出力及び標準エラー出力から全てのデータを取り出す．
C<timeout> メソッドによって設定された時間以内に読み出されなければ，
空リストを返す．

=cut
sub getlines {
    my( $this ) = @_;
    my @buf;
    local $SIG{ALRM} = sub { die "SIGALRM is received\n"; };
    eval {
	alarm $this->{TIMEOUT};
	@buf = $this->{READ}->getlines;
	alarm 0;
    };
    ( $@ =~ /SIGALRM is received/ ) ? ( wantarray ? () : 0 ) : @buf;
}

=item pid

子プロセスの PID を返す．

=cut
sub pid {
    my( $this ) = @_;
    $this->{PID};
}

=item alive

子プロセスが残っているか調べる．

=cut
sub alive {
    my( $this ) = @_;
    ( waitpid( $this->{PID},&WNOHANG ) == 0 ) && ( $? == -1 );
}

=item kill

子プロセスを強制終了(kill)する．

=cut
sub kill {
    my( $this ) = @_;
    $this->close;
    sleep 1;
    kill 15, $this->{PID};
    sleep 1;
    kill 9, $this->{PID};
    $this->alive();			# To avoid zombie.
    $this->{PID} = 0;
    1;
}

=back

=head1 AUTHOR

=over 4

=item TSUCHIYA Masatoshi <tsuchiya@namazu.org>

=back

=head1 COPYRIGHT

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, you can either send email to this
program's maintainer or write to: The Free Software Foundation,
Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.

Last Update: $Date: 2003/06/23 11:27:09 $

=cut

1;