# -*- perl -*-
#
# Test::AutoBuild::Command::Local
#
# Daniel Berrange <dan@berrange.com>
#
# Copyright (C) 2007 Daniel Berrange
#
# 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 of the License, 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, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# $Id: Local.pm,v 1.4 2007/12/11 05:01:11 danpb Exp $

=pod

=head1 NAME

Test::AutoBuild::Command - A locally executed command

=head1 SYNOPSIS

  use Test::AutoBuild::Command::Local;

  my $cmd = Test::AutoBuild::Command::Local->new(cmd => \@cmd, dir => $path);

  # Execute the command
  my $status = $counter->run($stdout, $stderr)

=head1 METHODS

=over 4

=cut

package Test::AutoBuild::Command::Local;

use warnings;
use strict;
use Log::Log4perl;
use POSIX;
use Symbol qw(gensym);
#use Cwd;

use base qw(Test::AutoBuild::Command);


=item my $status = $cmd->run($stdout, $stderr);

Execute the command sending its STDOUT to <$stdout> and its STDERR
to C<$stderr>. The C<$stdout> and C<$stderr> parameters can either
contain file paths into which output will be written; be instances
of C<IO::Handle> to which output will be written, or simply be scalar
references to collect the data in memory. If they are undef, then
the output will be discarded. The returned C<$status> is the command
exit status, typically zero for success, non-zero for failure.

=cut


sub run {
    my $self = shift;
    my $stdout = shift;
    my $stderr = shift;

    my $log = Log::Log4perl->get_logger();

    my $cwd = getcwd;
    if ($self->dir) {
	die "cannot change into " . $self->dir . ": $!" unless chdir $self->dir;
    }

    $log->debug("running: '" . join("' '", $self->cmd) . "' in /" . getcwd  . "'");

    local %ENV = %ENV;
    my %env = $self->env;
    foreach my $key (keys %env) {
	$log->debug("Set env $key to " . $env{$key});
	$ENV{$key} = $env{$key};
    }

    my $status;
    eval {
	my @cmd = $self->cmd;
	$status = $self->_run($stdout, $stderr);
    };
    my $err = $@;
    if ($self->dir) {
	die "cannot change into $cwd: $!" unless chdir $cwd;
    }
    die $err if $err;
    return $status;
}

sub _run {
    my $self = shift;
    my $stdout = shift;
    my $stderr = shift;

    my $stdoutfh;
    my $stderrfh;
    if (defined $stdout) {
	if (ref($stdout)) {
	    if (UNIVERSAL::isa($stdout, "IO::Handle")) {
		$stdoutfh = $stdout;
	    }
	} else {
	    $stdoutfh = IO::File->new($stdout, "w+");
	    die "cannot open $stdout" unless $stdoutfh;
	}
    }
    if (defined $stderr) {
	if (ref($stderr)) {
	    if (UNIVERSAL::isa($stderr, "IO::Handle")) {
		$stderrfh = $stderr;
	    }
	} else {
	    if (defined $stdout && !ref($stdout) && $stderr eq $stdout) {
		$stderrfh = $stdoutfh;
	    } else {
		$stderrfh = IO::File->new($stderr, "w+");
		die "cannot open $stderr" unless $stderrfh;
	    }
	}
    }

    my ($kid, $kidout, $kiderr) = $self->_execute();
    eval {
	while (1) {
	    my ($r,$w,$e) = ('','','');
	    vec($r, fileno($kidout), 1) = 1 if $kidout;
	    vec($r, fileno($kiderr), 1) = 1 if $kiderr;
	    my ($n, $ignore) = select($r, $w, $e, undef);

	    if ($kidout && vec($r, fileno($kidout), 1)) {
		my $data;
		my $bytes = POSIX::read fileno($kidout), $data, 1024;

		if (!$bytes || $bytes == 0) {
		    close ($kidout);
		    $kidout = undef;
		} else {
		    if ($stdoutfh) {
			POSIX::write fileno($stdoutfh), $data, $bytes;
		    } elsif (defined $stdout &&
			     ref($stdout)) {
			${$stdout} .= $data;
		    }
		}
	    }
	    if ($kiderr && vec($r, fileno($kiderr), 1)) {
		my $data;
		my $bytes = POSIX::read fileno($kiderr), $data, 1024;

		if (!$bytes || $bytes == 0) {
		    close ($kiderr);
		    $kiderr = undef;
		} else {
		    if ($stderrfh) {
			POSIX::write fileno($stderrfh), $data, $bytes;
		    } elsif (defined $stderr &&
			     ref($stderr)) {
			${$stderr} .= $data;
		    }
		}
	    }
	    last unless $kiderr || $kidout;
	}
    };
    my $err = $@;

    my $pid = waitpid $kid, 0;
    die "got unexpected child $pid instead of $kid" if $pid != $kid;
    my $status = ($? >> 8);

    close $kidout if $kidout;
    close $kiderr if $kiderr;
    close $stdoutfh if $stdoutfh;
    close $stderrfh if $stderrfh;

    die $err if $err;

    return $status;
}


sub _execute {
    my $self = shift;

    my ($dadr,$dadw,$dade) = (gensym, gensym, gensym);
    my ($kidr,$kidw,$kide) = (gensym, gensym, gensym);

    pipe $kidr, $dadr or die "cannot create pipe for stdin:$!";
    pipe $dadw, $kidw or die "cannot create pipe for stdout:$!";
    pipe $dade, $kide or die "cannot create pipe for stderr:$!";

    my $kid = fork();

    die "cannot fork child:$!" unless defined $kid;

    if ($kid) {
	close $kidr;
	close $kidw;
	close $kide;

	close $dadr;

	return ($kid, $dadw, $dade);
    } else {
	close $dadr;
	close $dadw;
	close $dade;

	open \*STDIN, "<&=" . fileno($kidr) or die "cannot dup stdin: $!";
	close($kidr);
	open \*STDOUT, ">&=" . fileno($kidw) or die "cannot dup stdout: $!";
	close($kidw);
	open \*STDERR, ">&=" . fileno($kide) or die "cannot dup stderr: $!";
	close($kide);

	exec $self->cmd;

	die "cannot execute child: $!";
    }
}

1 # So that the require or use succeeds.

__END__

=back

=head1 AUTHORS

Daniel Berrange <dan@berrange.com>,

=head1 COPYRIGHT

Copyright (C) 2007 Daniel Berrange

=head1 SEE ALSO

C<perl(1)>, L<Test::AutoBuild>, L<Test::AutoBuild::Runtime>, L<Test::AutoBuild::Command>

=cut