Skip to content
Browse files

Tidied

  • Loading branch information...
1 parent bb6664b commit 95a0c96368b7a3422aa2767e61a7a11e7b75b91b @AndyA AndyA committed Jun 16, 2009
View
77 lib/TAP/Parser.pm
@@ -3,18 +3,18 @@ package TAP::Parser;
use strict;
use vars qw($VERSION @ISA);
-use TAP::Base ();
-use TAP::Parser::Grammar ();
-use TAP::Parser::Result ();
-use TAP::Parser::ResultFactory ();
-use TAP::Parser::Source::Executable ();
-use TAP::Parser::Source::Perl ();
-use TAP::Parser::Source::File ();
-use TAP::Parser::Source::RawTAP ();
-use TAP::Parser::Source::Handle ();
-use TAP::Parser::Iterator ();
-use TAP::Parser::IteratorFactory ();
-use TAP::Parser::SourceFactory ();
+use TAP::Base ();
+use TAP::Parser::Grammar ();
+use TAP::Parser::Result ();
+use TAP::Parser::ResultFactory ();
+use TAP::Parser::Source::Executable ();
+use TAP::Parser::Source::Perl ();
+use TAP::Parser::Source::File ();
+use TAP::Parser::Source::RawTAP ();
+use TAP::Parser::Source::Handle ();
+use TAP::Parser::Iterator ();
+use TAP::Parser::IteratorFactory ();
+use TAP::Parser::SourceFactory ();
use Carp qw( confess );
@@ -293,8 +293,8 @@ L<TAP::Parser::SourceFactory>.
# new() implementation supplied by TAP::Base
# This should make overriding behaviour of the Parser in subclasses easier:
-sub _default_source_class {'TAP::Parser::Source::Executable'} # deprecated
-sub _default_perl_source_class {'TAP::Parser::Source::Perl'} # deprecated
+sub _default_source_class {'TAP::Parser::Source::Executable'} # deprecated
+sub _default_perl_source_class {'TAP::Parser::Source::Perl'} # deprecated
sub _default_grammar_class {'TAP::Parser::Grammar'}
sub _default_iterator_factory_class {'TAP::Parser::IteratorFactory'}
sub _default_result_factory_class {'TAP::Parser::ResultFactory'}
@@ -397,10 +397,10 @@ C<source_factory_class> can be customized, as described in L</new>.
=cut
# This should make overriding behaviour of the Parser in subclasses easier:
-sub make_source { shift->source_class->new(@_); } # deprecated
-sub make_perl_source { shift->perl_source_class->new(@_); } # deprecated
+sub make_source { shift->source_class->new(@_); } # deprecated
+sub make_perl_source { shift->perl_source_class->new(@_); } # deprecated
sub make_source_factory { shift->source_factory_class->new(@_); }
-sub make_grammar { shift->grammar_class->new(@_); }
+sub make_grammar { shift->grammar_class->new(@_); }
sub make_iterator { shift->iterator_factory_class->make_iterator(@_); }
sub make_result { shift->result_factory_class->make_result(@_); }
@@ -487,29 +487,32 @@ sub make_result { shift->result_factory_class->make_result(@_); }
$self->_croak("Unknown options: @excess");
}
- # convert $tap & $exec to $raw_source equiv.
- my $raw_source_ref;
+ # convert $tap & $exec to $raw_source equiv.
+ my $raw_source_ref;
if ($tap) {
- $raw_source_ref = \$tap;
- } elsif ($exec) {
- $raw_source_ref = { exec => [ @$exec, @$test_args ] };
- } elsif ($raw_source) {
- $raw_source_ref = ref( $raw_source ) ? $raw_source : \$raw_source;
+ $raw_source_ref = \$tap;
}
+ elsif ($exec) {
+ $raw_source_ref = { exec => [ @$exec, @$test_args ] };
+ }
+ elsif ($raw_source) {
+ $raw_source_ref = ref($raw_source) ? $raw_source : \$raw_source;
+ }
+
+ if ($raw_source_ref) {
+ my $src_factory = $self->make_source_factory($sources);
+ my $source = $src_factory->make_source(
+ { raw_source_ref => $raw_source_ref,
+ merge => $merge,
+ switches => $switches,
+ test_args => $test_args
+ }
+ );
- if ($raw_source_ref) {
- my $src_factory = $self->make_source_factory( $sources );
- my $source = $src_factory->make_source({
- raw_source_ref => $raw_source_ref,
- merge => $merge,
- switches => $switches,
- test_args => $test_args
- });
-
- # TODO: replace this with something like:
- # my $stream = $source->get_stream; # notice no "( $self )"
- $stream = $source->get_stream($self);
- }
+ # TODO: replace this with something like:
+ # my $stream = $source->get_stream; # notice no "( $self )"
+ $stream = $source->get_stream($self);
+ }
unless ($stream) {
$self->_croak('PANIC: could not determine stream');
View
3 lib/TAP/Parser/Source.pm
@@ -70,7 +70,6 @@ sub _initialize {
return $self;
}
-
##############################################################################
=head3 C<can_handle>
@@ -104,7 +103,6 @@ sub can_handle {
return;
}
-
=head3 C<make_source>
I<Abstract method>. Takes a hashref as an argument:
@@ -136,7 +134,6 @@ sub make_source {
return;
}
-
##############################################################################
=head2 Instance Methods
View
61 lib/TAP/Parser/Source/Executable.pm
@@ -3,8 +3,8 @@ package TAP::Parser::Source::Executable;
use strict;
use vars qw($VERSION @ISA);
-use TAP::Parser::Source ();
-use TAP::Parser::SourceFactory ();
+use TAP::Parser::Source ();
+use TAP::Parser::SourceFactory ();
use TAP::Parser::IteratorFactory ();
@ISA = qw(TAP::Parser::Source);
@@ -60,7 +60,7 @@ Returns a new C<TAP::Parser::Source::Executable> object.
sub _initialize {
my ( $self, @args ) = @_;
- $self->SUPER::_initialize( @args );
+ $self->SUPER::_initialize(@args);
# TODO: move this to Perl sub-class - not used here?
$self->{switches} = [];
@@ -75,14 +75,16 @@ sub _initialize {
sub can_handle {
my ( $class, $raw_source_ref, $meta ) = @_;
- if ($meta->{is_file}) {
- my $file = $meta->{file};
- # Note: we go in low so we can be out-voted
- return 0.8 if $file->{lc_ext} eq '.sh';
- return 0.8 if $file->{lc_ext} eq '.bat';
- return 0.7 if $file->{execute};
- } elsif ($meta->{hash}) {
- return 0.99 if $raw_source_ref->{exec};
+ if ( $meta->{is_file} ) {
+ my $file = $meta->{file};
+
+ # Note: we go in low so we can be out-voted
+ return 0.8 if $file->{lc_ext} eq '.sh';
+ return 0.8 if $file->{lc_ext} eq '.bat';
+ return 0.7 if $file->{execute};
+ }
+ elsif ( $meta->{hash} ) {
+ return 0.99 if $raw_source_ref->{exec};
}
return 0;
@@ -91,23 +93,24 @@ sub can_handle {
sub make_source {
my ( $class, $args ) = @_;
my $raw_source_ref = $args->{raw_source_ref};
- my $meta = $args->{meta};
- my $source = $class->new;
+ my $meta = $args->{meta};
+ my $source = $class->new;
$source->merge( $args->{merge} );
- if ($meta->{hash}) {
- $source->raw_source( $raw_source_ref->{exec} );
- } elsif ($meta->{is_file}) {
- $source->raw_source([ $raw_source_ref ]);
- } else {
- $source->raw_source( $raw_source_ref );
+ if ( $meta->{hash} ) {
+ $source->raw_source( $raw_source_ref->{exec} );
+ }
+ elsif ( $meta->{is_file} ) {
+ $source->raw_source( [$raw_source_ref] );
+ }
+ else {
+ $source->raw_source($raw_source_ref);
}
return $source;
}
-
##############################################################################
=head2 Instance Methods
@@ -133,16 +136,20 @@ sub raw_source {
return $self->SUPER::raw_source unless @_;
my $ref = ref $_[0];
- if (! defined( $ref )) {
- ; # fall through
- } elsif ($ref eq 'ARRAY') {
+ if ( !defined($ref) ) {
+ ; # fall through
+ }
+ elsif ( $ref eq 'ARRAY' ) {
return $self->SUPER::raw_source( $_[0] );
- } elsif ($ref eq 'HASH') {
- my $exec = $_[0]->{exec};
- return $self->SUPER::raw_source( $exec );
+ }
+ elsif ( $ref eq 'HASH' ) {
+ my $exec = $_[0]->{exec};
+ return $self->SUPER::raw_source($exec);
}
- $self->_croak('Argument to &raw_source must be an array reference or hash reference');
+ $self->_croak(
+ 'Argument to &raw_source must be an array reference or hash reference'
+ );
}
##############################################################################
View
22 lib/TAP/Parser/Source/File.pm
@@ -3,8 +3,8 @@ package TAP::Parser::Source::File;
use strict;
use vars qw($VERSION @ISA);
-use TAP::Parser::Source ();
-use TAP::Parser::SourceFactory ();
+use TAP::Parser::Source ();
+use TAP::Parser::SourceFactory ();
use TAP::Parser::IteratorFactory ();
@ISA = qw(TAP::Parser::Source);
@@ -62,8 +62,8 @@ sub can_handle {
my $file = $meta->{file};
return 1 if $file->{lc_ext} eq '.tap';
- if (my $exts = $config->{extensions}) {
- return 1 if grep {lc($_) eq $file->{lc_ext}} @$exts;
+ if ( my $exts = $config->{extensions} ) {
+ return 1 if grep { lc($_) eq $file->{lc_ext} } @$exts;
}
return 0;
@@ -72,12 +72,11 @@ sub can_handle {
sub make_source {
my ( $class, $args ) = @_;
my $raw_source_ref = $args->{raw_source_ref};
- my $source = $class->new;
- $source->raw_source( $raw_source_ref );
+ my $source = $class->new;
+ $source->raw_source($raw_source_ref);
return $source;
}
-
##############################################################################
=head2 Instance Methods
@@ -96,9 +95,10 @@ sub raw_source {
return $self->SUPER::raw_source unless @_;
my $ref = ref $_[0];
- if (! defined( $ref )) {
+ if ( !defined($ref) ) {
return $self->SUPER::raw_source( $_[0] );
- } elsif ($ref eq 'SCALAR') {
+ }
+ elsif ( $ref eq 'SCALAR' ) {
return $self->SUPER::raw_source( ${ $_[0] } );
}
@@ -120,8 +120,8 @@ sub get_stream {
my $file = $self->raw_source;
my $fh;
open( $fh, '<', $file )
- or $self->_croak( "error opening TAP source file '$file': $!" );
- return $factory->make_iterator( $fh );
+ or $self->_croak("error opening TAP source file '$file': $!");
+ return $factory->make_iterator($fh);
}
1;
View
23 lib/TAP/Parser/Source/Handle.pm
@@ -3,8 +3,8 @@ package TAP::Parser::Source::Handle;
use strict;
use vars qw($VERSION @ISA);
-use TAP::Parser::Source ();
-use TAP::Parser::SourceFactory ();
+use TAP::Parser::Source ();
+use TAP::Parser::SourceFactory ();
use TAP::Parser::IteratorFactory ();
@ISA = qw(TAP::Parser::Source);
@@ -59,8 +59,9 @@ Returns a new C<TAP::Parser::Source::Handle> object.
sub can_handle {
my ( $class, $raw_source_ref, $meta ) = @_;
- return 0.9 if $meta->{is_object}
- && UNIVERSAL::isa( $raw_source_ref, 'IO::Handle' );
+ return 0.9
+ if $meta->{is_object}
+ && UNIVERSAL::isa( $raw_source_ref, 'IO::Handle' );
return 0.8 if $meta->{glob};
@@ -70,12 +71,11 @@ sub can_handle {
sub make_source {
my ( $class, $args ) = @_;
my $raw_source_ref = $args->{raw_source_ref};
- my $source = $class->new;
- $source->raw_source( $raw_source_ref );
+ my $source = $class->new;
+ $source->raw_source($raw_source_ref);
return $source;
}
-
##############################################################################
=head2 Instance Methods
@@ -95,10 +95,11 @@ sub raw_source {
return $self->SUPER::raw_source unless @_;
my $ref = ref $_[0];
- if (! defined( $ref )) {
- ; # fall through
- } elsif ($ref eq 'GLOB' || UNIVERSAL::isa( $ref, 'IO::Handle' )) {
- return $self->SUPER::raw_source( shift );
+ if ( !defined($ref) ) {
+ ; # fall through
+ }
+ elsif ( $ref eq 'GLOB' || UNIVERSAL::isa( $ref, 'IO::Handle' ) ) {
+ return $self->SUPER::raw_source(shift);
}
$self->_croak('Argument to &source must be a glob ref or an IO::Handle');
View
7 lib/TAP/Parser/Source/Perl.pm
@@ -8,7 +8,7 @@ use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
use constant IS_VMS => ( $^O eq 'VMS' );
use TAP::Parser::Source::Executable ();
-use TAP::Parser::SourceFactory ();
+use TAP::Parser::SourceFactory ();
use TAP::Parser::Utils qw( split_shell );
@ISA = 'TAP::Parser::Source::Executable';
@@ -80,15 +80,14 @@ sub make_source {
my $perl_script = $$raw_source_ref;
my $test_args = $args->{test_args} || [];
- my $source = $class->new( $raw_source_ref );
+ my $source = $class->new($raw_source_ref);
$source->merge( $args->{merge} );
$source->switches( $args->{switches} ) if $args->{switches};
- $source->raw_source([ $perl_script, @$test_args ]);
+ $source->raw_source( [ $perl_script, @$test_args ] );
return $source;
}
-
=head2 Instance Methods
=head3 C<raw_source>
View
49 lib/TAP/Parser/Source/RawTAP.pm
@@ -3,8 +3,8 @@ package TAP::Parser::Source::RawTAP;
use strict;
use vars qw($VERSION @ISA);
-use TAP::Parser::Source ();
-use TAP::Parser::SourceFactory ();
+use TAP::Parser::Source ();
+use TAP::Parser::SourceFactory ();
use TAP::Parser::IteratorFactory ();
@ISA = qw(TAP::Parser::Source);
@@ -58,26 +58,26 @@ Returns a new C<TAP::Parser::Source::RawTAP> object.
sub can_handle {
my ( $class, $raw_source_ref, $meta ) = @_;
return 0 if $meta->{file};
- if ($meta->{scalar}) {
- return 0 unless $meta->{has_newlines};
- return 0.9 if $$raw_source_ref =~ /\d\.\.\d/;
- return 0.7 if $$raw_source_ref =~ /ok/;
- return 0.6;
- } elsif ($meta->{array}) {
- return 0.5;
+ if ( $meta->{scalar} ) {
+ return 0 unless $meta->{has_newlines};
+ return 0.9 if $$raw_source_ref =~ /\d\.\.\d/;
+ return 0.7 if $$raw_source_ref =~ /ok/;
+ return 0.6;
+ }
+ elsif ( $meta->{array} ) {
+ return 0.5;
}
return 0;
}
sub make_source {
my ( $class, $args ) = @_;
my $raw_source_ref = $args->{raw_source_ref};
- my $source = $class->new;
- $source->raw_source( $raw_source_ref );
+ my $source = $class->new;
+ $source->raw_source($raw_source_ref);
return $source;
}
-
##############################################################################
=head2 Instance Methods
@@ -94,17 +94,20 @@ array ref.
sub raw_source {
my $self = shift;
- if ( @_ ) {
- my $ref = ref $_[0];
- if (! defined( $ref )) {
- ; # fall through
- } elsif ($ref eq 'SCALAR') {
- my $scalar_ref = shift;
- return $self->SUPER::raw_source([ split "\n" => $$scalar_ref ]);
- } elsif ($ref eq 'ARRAY') {
- return $self->SUPER::raw_source( shift );
- }
- $self->_croak('Argument to &raw_source must be a scalar or array reference');
+ if (@_) {
+ my $ref = ref $_[0];
+ if ( !defined($ref) ) {
+ ; # fall through
+ }
+ elsif ( $ref eq 'SCALAR' ) {
+ my $scalar_ref = shift;
+ return $self->SUPER::raw_source( [ split "\n" => $$scalar_ref ] );
+ }
+ elsif ( $ref eq 'ARRAY' ) {
+ return $self->SUPER::raw_source(shift);
+ }
+ $self->_croak(
+ 'Argument to &raw_source must be a scalar or array reference');
}
return $self->SUPER::raw_source;
}
View
199 lib/TAP/Parser/SourceFactory.pm
@@ -53,9 +53,8 @@ C<$config> is optional. If given, sets L</config> and calls L</load_sources>.
=cut
sub _initialize {
- my ($self, $config) = @_;
- $self->config( $config || {} )
- ->load_sources;
+ my ( $self, $config ) = @_;
+ $self->config( $config || {} )->load_sources;
return $self;
}
@@ -80,7 +79,6 @@ sub register_source {
return $class;
}
-
##############################################################################
=head2 Instance Methods
@@ -113,12 +111,11 @@ sub config {
sub _config_for {
my ( $self, $sclass ) = @_;
- my ($abbrv_sclass) = ($sclass =~ /(?:\:\:)?(\w+)$/);
+ my ($abbrv_sclass) = ( $sclass =~ /(?:\:\:)?(\w+)$/ );
my $config = $self->config->{$abbrv_sclass} || $self->config->{$sclass};
return $config;
}
-
##############################################################################
=head3 C<load_sources>
@@ -143,33 +140,32 @@ C<croak>s on error.
sub load_sources {
my ($self) = @_;
- foreach my $source (keys %{ $self->config }) {
- my $sclass = $self->_load_source( $source );
- # TODO: store which class we loaded anywhere?
+ foreach my $source ( keys %{ $self->config } ) {
+ my $sclass = $self->_load_source($source);
+
+ # TODO: store which class we loaded anywhere?
}
return $self;
}
sub _load_source {
- my ($self, $source) = @_;
+ my ( $self, $source ) = @_;
my @errors;
- foreach my $sclass ("TAP::Parser::Source::$source", $source) {
- return $sclass if UNIVERSAL::isa( $sclass, 'TAP::Parser::Source' );
- eval "use $sclass";
- if (my $e = $@) {
- push @errors, $e;
- next;
- }
- return $sclass if UNIVERSAL::isa( $sclass, 'TAP::Parser::Source' );
- push @errors, "source '$sclass' is not a TAP::Parser::Source"
+ foreach my $sclass ( "TAP::Parser::Source::$source", $source ) {
+ return $sclass if UNIVERSAL::isa( $sclass, 'TAP::Parser::Source' );
+ eval "use $sclass";
+ if ( my $e = $@ ) {
+ push @errors, $e;
+ next;
+ }
+ return $sclass if UNIVERSAL::isa( $sclass, 'TAP::Parser::Source' );
+ push @errors, "source '$sclass' is not a TAP::Parser::Source";
}
- $self->_croak( "Cannot load source '$source': " . join("\n", @errors) );
+ $self->_croak( "Cannot load source '$source': " . join( "\n", @errors ) );
}
-
-
##############################################################################
=head3 C<make_source>
@@ -181,28 +177,31 @@ given (see L</detect_source>). Dies on error.
sub make_source {
my ( $self, $args ) = @_;
- my $raw_source_ref = $args->{raw_source_ref};
+ my $raw_source_ref = $args->{raw_source_ref};
- $self->_croak('no raw source ref defined!') unless defined $raw_source_ref;
- my $ref_type = ref( $raw_source_ref );
+ $self->_croak('no raw source ref defined!')
+ unless defined $raw_source_ref;
+ my $ref_type = ref($raw_source_ref);
$self->_croak('raw_source_ref is not a reference!') unless $ref_type;
# is the raw source already an object?
return $$raw_source_ref
- if ( $ref_type eq 'SCALAR' && ref($$raw_source_ref)
+ if ( $ref_type eq 'SCALAR'
+ && ref($$raw_source_ref)
&& UNIVERSAL::isa( $$raw_source_ref, 'TAP::Parser::Source' ) );
# figure out what kind of source it is
- my ($sd_class, $meta) = $self->detect_source($raw_source_ref);
+ my ( $sd_class, $meta ) = $self->detect_source($raw_source_ref);
# create it
- my $config = $self->_config_for( $sd_class );
- my $source = $sd_class->make_source({
- %$args,
- raw_source_ref => $raw_source_ref,
- config => $config,
- meta => $meta,
- });
+ my $config = $self->_config_for($sd_class);
+ my $source = $sd_class->make_source(
+ { %$args,
+ raw_source_ref => $raw_source_ref,
+ config => $config,
+ meta => $meta,
+ }
+ );
return $source;
}
@@ -231,20 +230,23 @@ sub detect_source {
confess('no raw source ref defined!') unless defined $raw_source_ref;
# build up some meta-data about the source so the sources don't have to
- my $meta = $self->assemble_meta( $raw_source_ref );
+ my $meta = $self->assemble_meta($raw_source_ref);
# find a list of sources that can handle this source:
my %sources;
foreach my $dclass ( @{ $self->sources } ) {
- my $config = $self->_config_for( $dclass );
- my $confidence = $dclass->can_handle($raw_source_ref, $meta, $config);
- # warn "source: $dclass: $confidence\n";
+ my $config = $self->_config_for($dclass);
+ my $confidence
+ = $dclass->can_handle( $raw_source_ref, $meta, $config );
+
+ # warn "source: $dclass: $confidence\n";
$sources{$dclass} = $confidence if $confidence;
}
if ( !%sources ) {
- # use Data::Dump qw( pp );
- # warn pp( $meta );
+
+ # use Data::Dump qw( pp );
+ # warn pp( $meta );
# error: can't detect source
my $raw_source_short = substr( $$raw_source_ref, 0, 50 );
@@ -260,17 +262,18 @@ sub detect_source {
);
# this is really useful for debugging sources:
- if ($ENV{TAP_HARNESS_SOURCE_FACTORY_VOTES}) {
- warn ( "votes: ",
- join( ', ', map { "$_: $sources{$_}" } @sources ),
- "\n" );
+ if ( $ENV{TAP_HARNESS_SOURCE_FACTORY_VOTES} ) {
+ warn(
+ "votes: ",
+ join( ', ', map {"$_: $sources{$_}"} @sources ),
+ "\n"
+ );
}
# return 1st source
return pop @sources, $meta;
}
-
=head3 C<assemble_meta>
Given a reference to the raw source, assembles some meta data about it and
@@ -289,57 +292,61 @@ sub assemble_meta {
# rudimentary is object test - if it's blessed it'll
# inherit from UNIVERSAL
- $meta->{is_object} = UNIVERSAL::isa( $raw_source_ref, 'UNIVERSAL' ) ? 1 : 0;
-
- $meta->{lc( ref( $raw_source_ref ) )} = 1;
- if ($meta->{scalar}) {
- my $source = $$raw_source_ref;
- $meta->{length} = length( $$raw_source_ref );
- $meta->{has_newlines} = $$raw_source_ref =~ /\n/ ? 1 : 0;
-
- # only do file checks if it looks like a filename
- if (! $meta->{has_newlines} and $meta->{length} < 1024) {
- my $file = {};
- $file->{exists} = -e $source ? 1 : 0;
- if ($file->{exists}) {
- $meta->{file} = $file;
-
- # avoid extra system calls (see `perldoc -f -X`)
- $file->{stat} = [ stat(_) ];
- $file->{empty} = -z _ ? 1 : 0;
- $file->{size} = -s _ ? 1 : 0;
- $file->{text} = -T _ ? 1 : 0;
- $file->{binary} = -B _ ? 1 : 0;
- $file->{read} = -r _ ? 1 : 0;
- $file->{write} = -w _ ? 1 : 0;
- $file->{execute} = -x _ ? 1 : 0;
- $file->{setuid} = -u _ ? 1 : 0;
- $file->{setgid} = -g _ ? 1 : 0;
- $file->{sticky} = -k _ ? 1 : 0;
-
- $meta->{is_file} = $file->{is_file} = -f _ ? 1 : 0;
- $meta->{is_dir} = $file->{is_dir} = -d _ ? 1 : 0;
-
- # symlink check requires another system call
- $meta->{is_symlink} = $file->{is_symlink} = -l $source ? 1 : 0;
- if ($file->{symlink}) {
- $file->{lstat} = [ lstat(_) ];
- }
-
- # put together some common info about the file
- ( $file->{basename}, $file->{dir}, $file->{ext} )
- = map { defined $_ ? $_ : '' }
- fileparse( $source, qr/\.[^.]*/ );
- $file->{lc_ext} = lc( $file->{ext} );
- $file->{basename} .= $file->{ext} if $file->{ext};
-
- # TODO: move shebang check from TAP::Parser::SourceFactory
- }
- }
- } elsif ($meta->{array}) {
- $meta->{size} = $#$raw_source_ref + 1;
- } elsif ($meta->{hash}) {
- ; # do nothing
+ $meta->{is_object}
+ = UNIVERSAL::isa( $raw_source_ref, 'UNIVERSAL' ) ? 1 : 0;
+
+ $meta->{ lc( ref($raw_source_ref) ) } = 1;
+ if ( $meta->{scalar} ) {
+ my $source = $$raw_source_ref;
+ $meta->{length} = length($$raw_source_ref);
+ $meta->{has_newlines} = $$raw_source_ref =~ /\n/ ? 1 : 0;
+
+ # only do file checks if it looks like a filename
+ if ( !$meta->{has_newlines} and $meta->{length} < 1024 ) {
+ my $file = {};
+ $file->{exists} = -e $source ? 1 : 0;
+ if ( $file->{exists} ) {
+ $meta->{file} = $file;
+
+ # avoid extra system calls (see `perldoc -f -X`)
+ $file->{stat} = [ stat(_) ];
+ $file->{empty} = -z _ ? 1 : 0;
+ $file->{size} = -s _ ? 1 : 0;
+ $file->{text} = -T _ ? 1 : 0;
+ $file->{binary} = -B _ ? 1 : 0;
+ $file->{read} = -r _ ? 1 : 0;
+ $file->{write} = -w _ ? 1 : 0;
+ $file->{execute} = -x _ ? 1 : 0;
+ $file->{setuid} = -u _ ? 1 : 0;
+ $file->{setgid} = -g _ ? 1 : 0;
+ $file->{sticky} = -k _ ? 1 : 0;
+
+ $meta->{is_file} = $file->{is_file} = -f _ ? 1 : 0;
+ $meta->{is_dir} = $file->{is_dir} = -d _ ? 1 : 0;
+
+ # symlink check requires another system call
+ $meta->{is_symlink} = $file->{is_symlink}
+ = -l $source ? 1 : 0;
+ if ( $file->{symlink} ) {
+ $file->{lstat} = [ lstat(_) ];
+ }
+
+ # put together some common info about the file
+ ( $file->{basename}, $file->{dir}, $file->{ext} )
+ = map { defined $_ ? $_ : '' }
+ fileparse( $source, qr/\.[^.]*/ );
+ $file->{lc_ext} = lc( $file->{ext} );
+ $file->{basename} .= $file->{ext} if $file->{ext};
+
+ # TODO: move shebang check from TAP::Parser::SourceFactory
+ }
+ }
+ }
+ elsif ( $meta->{array} ) {
+ $meta->{size} = $#$raw_source_ref + 1;
+ }
+ elsif ( $meta->{hash} ) {
+ ; # do nothing
}
return $meta;
View
19 t/harness.t
@@ -30,7 +30,6 @@ plan tests => 128;
ok $ENV{HARNESS_ACTIVE}, 'HARNESS_ACTIVE env variable should be set';
ok $ENV{HARNESS_VERSION}, 'HARNESS_VERSION env variable should be set';
-
#### For color tests ####
package Colorizer;
@@ -697,8 +696,8 @@ SKIP: {
{ verbosity => -2,
stdout => $capture,
sources => {
- File => { extensions => [ '.1' ] },
- },
+ File => { extensions => ['.1'] },
+ },
}
);
@@ -720,28 +719,28 @@ SKIP: {
{ verbosity => -2,
stdout => $capture,
sources => {
- MyFileSource => { extensions => [ '.1' ] },
- },
+ MyFileSource => { extensions => ['.1'] },
+ },
}
);
my $source_test = "$source_tests/source.1";
eval { _runtests( $harness, "$source_tests/source.1" ); };
my $e = $@;
- ok( !$e, 'no error on load custom source' ) || diag( $e );
+ ok( !$e, 'no error on load custom source' ) || diag($e);
no warnings 'once';
can_ok( 'MyFileSource', 'new' );
ok( $main::INIT{MyFileSource}, '... and an obj was instantiated' );
my $source = $MyFileSource::LAST_OBJ || {};
isa_ok( $source, 'MyFileSource', '... and MyFileSource obj was created' );
- is( $source->raw_source, $source_test, '... and has the right raw_source' );
+ is( $source->raw_source, $source_test,
+ '... and has the right raw_source' );
my @output = tied($$capture)->dump;
- my $status = pop( @output ) || '';
- like $status, qr{^Result: PASS$},
- '... and test has correct status line';
+ my $status = pop(@output) || '';
+ like $status, qr{^Result: PASS$}, '... and test has correct status line';
pop @output; # get rid of summary line
my $answer = pop @output;
is( $answer, "All tests successful.\n", '... all tests passed' );
View
4 t/lib/MyFileSource.pm
@@ -8,7 +8,7 @@ use vars qw( @ISA $LAST_OBJ );
use MyCustom;
use TAP::Parser::Source::File;
-@ISA = qw( TAP::Parser::Source::File MyCustom );
+@ISA = qw( TAP::Parser::Source::File MyCustom );
$LAST_OBJ = undef;
TAP::Parser::SourceFactory->register_source(__PACKAGE__);
@@ -17,7 +17,7 @@ sub _initialize {
my $self = shift;
$self->SUPER::_initialize(@_);
$main::INIT{ ref($self) }++;
- $self->{initialized} = [ @_ ];
+ $self->{initialized} = [@_];
$LAST_OBJ = $self;
return $self;
}
View
2 t/lib/MyPerlSource.pm
@@ -16,7 +16,7 @@ TAP::Parser::SourceFactory->register_source(__PACKAGE__);
sub can_handle {
my $class = shift;
my $vote = $class->SUPER::can_handle(@_);
- $vote += 0.1 if $vote > 0; # steal the Perl detector's vote
+ $vote += 0.1 if $vote > 0; # steal the Perl detector's vote
return $vote;
}
View
27 t/lib/MySource.pm
@@ -7,6 +7,7 @@ use vars '@ISA';
use MyCustom;
use TAP::Parser::SourceFactory;
+
#use TAP::Parser::Source::Executable;
use TAP::Parser::Source;
@@ -15,23 +16,22 @@ use TAP::Parser::Source;
TAP::Parser::SourceFactory->register_source(__PACKAGE__);
sub can_handle {
- my ($class, $raw_source_ref, $meta, $config) = @_;
- if ($config->{accept_all}) {
- return 1;
- } elsif (my $accept = $config->{accept}) {
- return 0 unless $meta->{scalar};
- return 1 if $$raw_source_ref eq $accept;
+ my ( $class, $raw_source_ref, $meta, $config ) = @_;
+ if ( $config->{accept_all} ) {
+ return 1;
+ }
+ elsif ( my $accept = $config->{accept} ) {
+ return 0 unless $meta->{scalar};
+ return 1 if $$raw_source_ref eq $accept;
}
return 0;
}
sub make_source {
- my ($class, $args) = @_;
+ my ( $class, $args ) = @_;
my $raw_source_ref = $args->{raw_source_ref};
- my $source = $class->new;
- $source->config( $args->{config} )
- ->source([ $raw_source_ref ])
- ->custom;
+ my $source = $class->new;
+ $source->config( $args->{config} )->source( [$raw_source_ref] )->custom;
return $source;
}
@@ -49,9 +49,10 @@ sub source {
}
sub get_stream {
- my ($self, $factory) = @_;
+ my ( $self, $factory ) = @_;
my $iter = $factory->make_iterator( $self->raw_source );
-# my $stream = $self->SUPER::get_stream(@_);
+
+ # my $stream = $self->SUPER::get_stream(@_);
# re-bless it:
bless $iter, 'MyIterator';
View
17 t/lib/TAP/Parser/SubclassTest.pm
@@ -16,17 +16,20 @@ use MyResultFactory;
@ISA = qw( TAP::Parser MyCustom );
-sub _default_source_class {'MySource'} # deprecated
-sub _default_perl_source_class {'MyPerlSource'} # deprecated
+sub _default_source_class {'MySource'} # deprecated
+sub _default_perl_source_class {'MyPerlSource'} # deprecated
sub _default_grammar_class {'MyGrammar'}
sub _default_iterator_factory_class {'MyIteratorFactory'}
sub _default_result_factory_class {'MyResultFactory'}
-sub make_source { shift->SUPER::make_source(@_)->custom } # deprecated
-sub make_perl_source { shift->SUPER::make_perl_source(@_)->custom } # deprecated
-sub make_grammar { shift->SUPER::make_grammar(@_)->custom }
-sub make_iterator { shift->SUPER::make_iterator(@_)->custom }
-sub make_result { shift->SUPER::make_result(@_)->custom }
+sub make_source { shift->SUPER::make_source(@_)->custom } # deprecated
+
+sub make_perl_source {
+ shift->SUPER::make_perl_source(@_)->custom;
+} # deprecated
+sub make_grammar { shift->SUPER::make_grammar(@_)->custom }
+sub make_iterator { shift->SUPER::make_iterator(@_)->custom }
+sub make_result { shift->SUPER::make_result(@_)->custom }
sub _initialize {
my $self = shift;
View
21 t/parser-subclass.t
@@ -52,12 +52,12 @@ my @t_path = $ENV{PERL_CORE} ? ( updir(), 'ext', 'Test-Harness' ) : ();
# DEPRECATED
TODO: {
- local $TODO = 'deprecated';
- $p->make_source;
- is( $CUSTOM{MySource}, 1, 'make custom source' );
- $p->make_perl_source;
- is( $CUSTOM{MyPerlSource}, 1, 'make custom perl source' );
- }
+ local $TODO = 'deprecated';
+ $p->make_source;
+ is( $CUSTOM{MySource}, 1, 'make custom source' );
+ $p->make_perl_source;
+ is( $CUSTOM{MyPerlSource}, 1, 'make custom perl source' );
+ }
$p->make_grammar;
is( $CUSTOM{MyGrammar}, 1, 'make custom grammar' );
@@ -85,10 +85,11 @@ SKIP: { # non-perl source
skip "no '$cat'", 4;
}
my $file = catfile( @t_path, 't', 'data', 'catme.1' );
- my $p = TAP::Parser::SubclassTest->new({
- exec => [ $cat => $file ],
- sources => { MySource => { accept_all => 1 } },
- });
+ my $p = TAP::Parser::SubclassTest->new(
+ { exec => [ $cat => $file ],
+ sources => { MySource => { accept_all => 1 } },
+ }
+ );
is( $INIT{MySource}, 1, 'initialized MySource subclass' );
is( $CUSTOM{MySource}, 1, '... and it was customized' );
View
25 t/source.t
@@ -65,7 +65,7 @@ my $perl = $^X;
# Executable source tests
{
- my $test = File::Spec->catfile( $dir, 'source' );
+ my $test = File::Spec->catfile( $dir, 'source' );
my $source = TAP::Parser::Source::Executable->new;
isa_ok $source, 'TAP::Parser::Source::Executable';
@@ -90,9 +90,10 @@ my $perl = $^X;
# Perl source tests
{
- my $test = File::Spec->catfile( $dir, 'source' );
+ my $test = File::Spec->catfile( $dir, 'source' );
my $source = TAP::Parser::Source::Perl->new;
- isa_ok $source, 'TAP::Parser::Source::Perl', '... and the object it returns';
+ isa_ok $source, 'TAP::Parser::Source::Perl',
+ '... and the object it returns';
can_ok $source, 'source';
ok $source->source( [$test] ),
@@ -111,15 +112,17 @@ my $perl = $^X;
# internals tests!
can_ok $source, '_switches';
ok( grep( $_ =~ /^['"]?-T['"]?$/, $source->_switches ),
- '... and it should find the taint switch'
- );
+ '... and it should find the taint switch'
+ );
}
# coverage test for TAP::Parser::Source::Executable
{
+
# coverage for method get_steam
- my $source = TAP::Parser::Source::Executable->new( { parser => $parser } );
+ my $source
+ = TAP::Parser::Source::Executable->new( { parser => $parser } );
my @die;
eval {
@@ -131,16 +134,16 @@ my $perl = $^X;
like pop @die, qr/No command found!/, '...and it failed as expect';
}
-
# Raw TAP source tests
{
my $source = TAP::Parser::Source::RawTAP->new;
isa_ok $source, 'TAP::Parser::Source::RawTAP';
can_ok $source, 'raw_source';
- eval { $source->raw_source( "1..1\nok 1\n" ) };
+ eval { $source->raw_source("1..1\nok 1\n") };
ok my $error = $@, '... and calling it with a string should fail';
- like $error, qr/^Argument to &raw_source must be a scalar or array reference/,
+ like $error,
+ qr/^Argument to &raw_source must be a scalar or array reference/,
'... with an appropriate error message';
ok $source->raw_source( \"1..1\nok 1\n" ),
'... and calling it with valid args should succeed';
@@ -158,7 +161,7 @@ my $perl = $^X;
# Text file TAP source tests
{
- my $test = File::Spec->catfile( $dir, 'source.tap' );
+ my $test = File::Spec->catfile( $dir, 'source.tap' );
my $source = TAP::Parser::Source::File->new;
isa_ok $source, 'TAP::Parser::Source::File';
@@ -179,7 +182,7 @@ my $perl = $^X;
# IO::Handle TAP source tests
{
- my $test = File::Spec->catfile( $dir, 'source.tap' );
+ my $test = File::Spec->catfile( $dir, 'source.tap' );
my $source = TAP::Parser::Source::File->new;
isa_ok $source, 'TAP::Parser::Source::File';
View
156 t/source_factory.t
@@ -33,43 +33,52 @@ use TAP::Parser::SourceFactory;
can_ok $sf, 'register_source';
# Set config
- eval { $sf->config( 'bad config' ) };
+ eval { $sf->config('bad config') };
my $e = $@;
like $e, qr/\QArgument to &config must be a hash reference/,
'... and calling config with bad config should fail';
my $config = { MySource => { foo => 'bar' } };
- is( $sf->config( $config ), $sf, '... and set config works' );
+ is( $sf->config($config), $sf, '... and set config works' );
# Load/Register a source
- $sf = TAP::Parser::SourceFactory->new({
- MySource => { accept => 'known-source' }
- });
- can_ok('MySource', 'can_handle' );
+ $sf = TAP::Parser::SourceFactory->new(
+ { MySource => { accept => 'known-source' } } );
+ can_ok( 'MySource', 'can_handle' );
is_deeply( $sf->sources, ['MySource'], '... was registered' );
# Known source should pass
{
- my $source;
- eval { $source = $sf->make_source({ raw_source_ref => \"known-source" }) };
- my $error = $@;
- ok( !$error, 'make_source with known source doesnt fail' );
- diag($error) if $error;
- isa_ok( $source, 'MySource', '... and source class' );
- is_deeply( $source->raw_source, [ \"known-source" ],
- '... and raw_source as expected' );
- is_deeply( $source->config, { accept => 'known-source' },
- '... and source config as expected' );
+ my $source;
+ eval {
+ $source
+ = $sf->make_source( { raw_source_ref => \"known-source" } );
+ };
+ my $error = $@;
+ ok( !$error, 'make_source with known source doesnt fail' );
+ diag($error) if $error;
+ isa_ok( $source, 'MySource', '... and source class' );
+ is_deeply(
+ $source->raw_source, [ \"known-source" ],
+ '... and raw_source as expected'
+ );
+ is_deeply(
+ $source->config, { accept => 'known-source' },
+ '... and source config as expected'
+ );
}
# No known source should fail
{
- my $source;
- eval { $source = $sf->make_source({ raw_source_ref => \"unknown-source" }) };
- my $error = $@;
- ok( $error, 'make_source with unknown source fails' );
- like $error, qr/^Cannot detect source of 'unknown-source'/,
- '... with an appropriate error message';
+ my $source;
+ eval {
+ $source
+ = $sf->make_source( { raw_source_ref => \"unknown-source" } );
+ };
+ my $error = $@;
+ ok( $error, 'make_source with unknown source fails' );
+ like $error, qr/^Cannot detect source of 'unknown-source'/,
+ '... with an appropriate error message';
}
}
@@ -89,80 +98,67 @@ my $test_dir = File::Spec->catdir(
'source_tests'
);
-my @sources =
- (
- {
- file => 'source.tap',
- class => 'TAP::Parser::Source::File',
- },
- {
- file => 'source.1',
- class => 'TAP::Parser::Source::File',
- config => { File => { extensions => [ '.1' ] } },
- },
- {
- file => 'source.pl',
- class => 'TAP::Parser::Source::Perl',
- },
- {
- file => 'source.t',
- class => 'TAP::Parser::Source::Perl',
- },
- {
- file => 'source',
- class => 'TAP::Parser::Source::Perl',
- },
- {
- file => 'source.sh',
- class => 'TAP::Parser::Source::Executable',
- },
- {
- file => 'source.bat',
- class => 'TAP::Parser::Source::Executable',
- },
- {
- name => 'raw tap string',
- source => "0..1\nok 1 - raw tap\n",
- class => 'TAP::Parser::Source::RawTAP',
- },
- {
- name => 'raw tap array',
- source => ["0..1\n", "ok 1 - raw tap\n"],
- class => 'TAP::Parser::Source::RawTAP',
- },
- {
- source => \*__DATA__,
- class => 'TAP::Parser::Source::Handle',
- },
- {
- source => IO::File->new('-'),
- class => 'TAP::Parser::Source::Handle',
- },
- );
+my @sources = (
+ { file => 'source.tap',
+ class => 'TAP::Parser::Source::File',
+ },
+ { file => 'source.1',
+ class => 'TAP::Parser::Source::File',
+ config => { File => { extensions => ['.1'] } },
+ },
+ { file => 'source.pl',
+ class => 'TAP::Parser::Source::Perl',
+ },
+ { file => 'source.t',
+ class => 'TAP::Parser::Source::Perl',
+ },
+ { file => 'source',
+ class => 'TAP::Parser::Source::Perl',
+ },
+ { file => 'source.sh',
+ class => 'TAP::Parser::Source::Executable',
+ },
+ { file => 'source.bat',
+ class => 'TAP::Parser::Source::Executable',
+ },
+ { name => 'raw tap string',
+ source => "0..1\nok 1 - raw tap\n",
+ class => 'TAP::Parser::Source::RawTAP',
+ },
+ { name => 'raw tap array',
+ source => [ "0..1\n", "ok 1 - raw tap\n" ],
+ class => 'TAP::Parser::Source::RawTAP',
+ },
+ { source => \*__DATA__,
+ class => 'TAP::Parser::Source::Handle',
+ },
+ { source => IO::File->new('-'),
+ class => 'TAP::Parser::Source::Handle',
+ },
+);
foreach my $test (@sources) {
local $TODO = $test->{TODO};
- if ($test->{file}) {
- $test->{name} = $test->{file};
- $test->{source} = File::Spec->catfile( $test_dir, $test->{file} );
+ if ( $test->{file} ) {
+ $test->{name} = $test->{file};
+ $test->{source} = File::Spec->catfile( $test_dir, $test->{file} );
}
my $name = $test->{name} || substr( $test->{source}, 0, 10 );
- my $sf = TAP::Parser::SourceFactory->new( $test->{config} );
+ my $sf = TAP::Parser::SourceFactory->new( $test->{config} );
my $raw_source = $test->{source};
my $source;
eval {
- my $ref = ref( $raw_source ) ? $raw_source : \$raw_source;
- $source = $sf->make_source({ raw_source_ref => $ref })
+ my $ref = ref($raw_source) ? $raw_source : \$raw_source;
+ $source = $sf->make_source( { raw_source_ref => $ref } );
};
my $error = $@;
ok( !$error, "$name: no error on make_source" );
- diag( $error ) if $error;
+ diag($error) if $error;
isa_ok( $source, $test->{class}, $name );
}
-
__END__
0..1
ok 1 - TAP in the __DATA__ handle

0 comments on commit 95a0c96

Please sign in to comment.
Something went wrong with that request. Please try again.