package IMPL::Test::Straps;
use strict;
use warnings;

use base qw(Test::Harness::Straps IMPL::Object IMPL::Object::Autofill IMPL::Object::Serializable);
use IMPL::Class::Property;

__PACKAGE__->PassThroughArgs;

BEGIN {
    public property Executors => prop_all | prop_list;
}

sub new {
    my $class = shift;
    my $this = $class->Test::Harness::Straps::new();
    
    $this->callCTOR(@_);
    
    return $this;
}

sub surrogate {
    my $class = shift;
    return $class->Test::Harness::Straps::new();
}

sub analyze_file {
    my($self, $file) = @_;

    unless( -e $file ) {
        $self->{error} = "$file does not exist";
        return;
    }

    unless( -r $file ) {
        $self->{error} = "$file is not readable";
        return;
    }
    
    # *sigh* this breaks under taint, but open -| is unportable.
    my $h = $self->ExecuteFile($file);
    unless ($h) {
        print "can't run $file. $!\n";
        return;
    }

    my $results = $self->analyze_fh($file, $h);
    my $exit    = close $h;

    $results->set_wait($?);
    if ( $? && $self->{_is_vms} ) {
        $results->set_exit($?);
    }
    else {
        $results->set_exit( Test::Harness::Straps::_wait2exit($?) );
    }
    $results->set_passing(0) unless $? == 0;

    $self->_restore_PERL5LIB();

    return $results;
}

sub SelectExecutor {
    my ($this,$file) = @_;
    
    return $_->{Executor} foreach grep $file =~ /$_->{Re}/i, $this->Executors;
}

sub ExecuteFile {
    my ($this,$file) = @_;
    
    if (my $executor = $this->SelectExecutor($file)) {
        return $executor->Execute($file);
    }
    return undef;
}

sub Execute {
    my ($self,$file) = @_;
    
    local $ENV{PERL5LIB} = $self->_INC2PERL5LIB;
    
    open my $h,'-|',$self->_command_line($file) or return undef;
    
    return $h;
}

1;