package Process;

use 5.008008;
use strict 'refs';
use strict 'subs';
use strict 'vars';
use warnings;
use POSIX qw(:unistd_h :sys_wait_h); # For Using WNOHANG and isatty functions
use Fcntl; # For checking file handle contants.
use IO::Handle;
use IO::Pty;
use IO::Tty;
use Exporter;

our @ISA = qw(IO::Pty Exporter);

our $VERSION = '0.01';
our %SUPPORTED_SIGNALS ;

BEGIN {
	%SUPPORTED_SIGNALS = (
		SIGHUP    => 1,
		SIGINT    => 2,
		SIGQUIT   => 3,
		SIGILL    => 4,
		SIGTRAP   => 5,
		SIGABRT   => 6,
		SIGBUS    => 7,
		SIGFPE    => 8,
		SIGKILL   => 9,
		SIGUSR1   => 10,
		SIGSEGV   => 11,
		SIGUSR2   => 12,
		SIGPIPE   => 13,
		SIGALRM   => 14,
		SIGTERM   => 15,
		SIGSTKFLT => 16,
		SIGCHLD   => 17,
		SIGCONT   => 18,
		SIGSTOP   => 19,
		SIGTSTP   => 20,
		SIGTTIN   => 21,
		SIGTTOU   => 22,
		SIGURG    => 23,
		SIGXCPU   => 24,
		SIGXFSZ   => 25,
		SIGVTALRM => 26,
		SIGPROF   => 27,
		SIGWINCH  => 28,
		SIGIO     => 29,
		SIGPWR    => 30,
		SIGSYS    => 31
	);
}

sub new() {
	my $_this = shift;
	my $_self = new IO::Pty;
	bless $_self => $_this;
	$_self->autoflush(1);
	return $_self;
}

sub createProcess() {
	my $class  = shift;
	my $_this;
	if (ref($class)) {
		$_this = $class;
	}
	else {
	       $_this = $class->new();
	}
	my $_signal = shift or return -1;
	my $_cmd;
	if ( !exists $SUPPORTED_SIGNALS{$_signal} ) {
		$_cmd    = $_signal;
		$_signal = "SIGSTOP";
	}
	else {
		$_cmd = shift;
	}
	my @_args = @_;
	my $_pid  = undef;

	# set up pipe to detect childs exec error
	pipe(FROM_CHILD, TO_PARENT) or die "Cannot open pipe: $!";
	pipe(FROM_PARENT, TO_CHILD) or die "Cannot open pipe: $!";
	TO_PARENT->autoflush(1);
	TO_CHILD->autoflush(1);
	eval {
		fcntl(TO_PARENT, Fcntl::F_SETFD, Fcntl::FD_CLOEXEC);
	};

	defined( $_pid = fork() ) or die("Could not fork() \"$_cmd\" process");
	if ( !$_pid ) {
		close FROM_CHILD;
		close TO_CHILD;
		if ($_this->make_slave_controlling_terminal()!=1){
			die "Cannot make slave controlling terminal: $!\n";
		}
		my $slv = $_this->slave() or die "Cannot get slave: $!";

		#$slv->set_raw() if $_this->raw_pty;
		$slv->set_raw();
		close($_this);
		# wait for parent before we detach
		my $buffer;
		my $errstatus = sysread(FROM_PARENT, $buffer, 256);
		die "Cannot sync with parent: $!" if not defined $errstatus;
		close FROM_PARENT;

		close(STDIN);
		open(STDIN,"<&". $slv->fileno()) or die "Couldn't reopen STDIN for reading, $!\n";
		close(STDOUT);
		open(STDOUT,">&". $slv->fileno()) or die "Couldn't reopen STDOUT for writing, $!\n";
		close(STDERR);
		open(STDERR,">&". $slv->fileno()) or die "Couldn't reopen STDERR for writing, $!\n";
		exec( "$_cmd", @_args ) or die("Cannot exec($_cmd): $!\n");
		#exit(127);
	}

	close TO_PARENT;
	close FROM_PARENT;
	$_this->close_slave();
	#$_this->set_raw() if $_this->raw_pty and isatty($_this);
	$_this->set_raw() if isatty($_this);
	close TO_CHILD; # so child gets EOF and can go ahead

	# now wait for child exec (eof due to close-on-exit) or exec error
	my $errno;
	my $errstatus = sysread(FROM_CHILD, $errno, 256);
	die "Cannot sync with child: $!" if not defined $errstatus;
	close FROM_CHILD;

	if ( kill( "$_signal", $_pid ) == 1 ) {
		${*_this}{STATUS}->{$_pid} = 0;
	}
	return $_pid;
}

sub run() {
	my $_this   = shift;
	my @_pids   = @_;
	my $counter = @_pids;
	my $cnt     = 0;
	if ( @_pids == 0 ) {
		die(
			qq{
			\n\t****Which process to start?******
			\n\t****Process ID is undefined****\n}
		);
	}
	if ( ( $cnt = kill( "SIGCONT", @_pids ) ) != $counter ) {
		return 111;
	}
	return $cnt;
}

sub runAll() {
	my $_this = shift;
	foreach ( keys %{ ${*_this}{STATUS} } ) {
		return 111 if !kill( "SIGCONT", $_ ) == 1;
	}
	return keys %{ ${*_this}{STATUS} };
}

sub getAllChildProcesses() {
	my $_this = shift;
	return keys( %{ ${*_this}{STATUS} } );
}

sub getProcessStatus() {
	my $_this   = shift;
	my @_pids   = @_;
	my %_status = ();

	foreach (@_pids) {
		$_status{$_} = ${*_this}{STATUS}->{$_};
	}
	return %_status;
}

sub waitForAll() {
	my $_this   = shift;
	my $_pCount = $_this->getAllChildProcesses();
	for ( my $i = 0 ; $i < $_pCount ; $i++ ) {
		my $retPid = wait();
		${*_this}{STATUS}->{$retPid} = ( $? >> 8 );
	}
	return ${*_this}{STATUS};
}

sub waitFor() {
	my $_this  = shift;
	my $_pid   = shift;
	my $retPid = waitpid( $_pid, 0 );
	${*_this}{STATUS}->{$retPid} = ( $? >> 8 );
	return ${*_this}{STATUS};
}

END {

}

1;

__END__

=head1 NAME

Process - Perl extension for synchronized process creation in background and store their return status in object

=head1 SYNOPSIS

  use Process;
  $p = new Process();
   
  $pid = $p->createProcess( "SIGSTOP", "sleep", "100" );
     # or
  $pid = $p->createProcess( "sleep", "50" );
   
  $p->runAll();  #runs all the processes which were created using the createProcess()
     # or
  $p->run($pid); #runs all the process given as its argument(@pid or $pid)
   
  $p->waitForAll(); # waits for all the processes created by the createProcess();
     # or
  $p->waitFor($pid); #waits all the process given as its argument(@pid or $pid)

=head1 DESCRIPTION

  This module creates the separate process in background for synchronized child creation control and keeping 
  track of those children.

=head1 EXIT CODES and RETURN VALUES

   createProcess()
   	Returns the process id.
   
   run()
   	Returns 111 if the created process is not started.
   
   runAll()
   	Returns 111 if the created process is not started.
   
   getAllChildProcesses()
   	Returns the list of process id which are created by the object.
   
   getProcessStatus()
   	Returns the list of return status of all the processes created by the object if process
   	is not finished, it's return status is zero.
   
   waitFor()
   	Returns the status of the finished process which is given as its argument.
   
   waitForAll()
   	Returns the status of the all processes created by the object.

=head1 BUGS

Please report bugs.

=head1 AUTHOR

Kamal Mehta, E<lt>kamal@cpan.org<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010 by Kamal Mehta

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.


=cut