--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Test/Straps.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +1,90 @@
+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;