Mercurial > pub > Impl
diff Lib/IMPL/Test/Straps.pm @ 49:16ada169ca75
migrating to the Eclipse IDE
author | wizard@linux-odin.local |
---|---|
date | Fri, 26 Feb 2010 10:49:21 +0300 |
parents | 03e58a454b20 |
children | 4267a2ac3d46 |
line wrap: on
line diff
--- a/Lib/IMPL/Test/Straps.pm Fri Feb 26 01:43:42 2010 +0300 +++ b/Lib/IMPL/Test/Straps.pm Fri Feb 26 10:49:21 2010 +0300 @@ -1,90 +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; +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;