Mercurial > pub > Impl
view Lib/IMPL/Test/Straps.pm @ 118:79cdd6c86409
JSON support (experimental)
author | wizard |
---|---|
date | Mon, 07 Jun 2010 08:21:26 +0400 |
parents | 16ada169ca75 |
children | 4267a2ac3d46 |
line wrap: on
line source
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;