From be4bfe8362d7eec07140f543f8d44120395de88b Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Sun, 24 Apr 2011 16:09:50 +0000 Subject: 2nd try to remove old tlperl0 git-svn-id: svn://tug.org/texlive/trunk@22185 c570f23f-e606-0410-a88d-b1316a301751 --- .../lib/TAP/Parser/SourceHandler/Executable.pm | 185 ------------ .../tlperl0/lib/TAP/Parser/SourceHandler/File.pm | 136 --------- .../tlperl0/lib/TAP/Parser/SourceHandler/Handle.pm | 125 --------- .../tlperl0/lib/TAP/Parser/SourceHandler/Perl.pm | 310 --------------------- .../tlperl0/lib/TAP/Parser/SourceHandler/RawTAP.pm | 131 --------- .../tlperl0/lib/TAP/Parser/SourceHandler/pgTAP.pm | 253 ----------------- 6 files changed, 1140 deletions(-) delete mode 100755 Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/Executable.pm delete mode 100755 Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/File.pm delete mode 100755 Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/Handle.pm delete mode 100755 Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/Perl.pm delete mode 100755 Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/RawTAP.pm delete mode 100755 Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/pgTAP.pm (limited to 'Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler') diff --git a/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/Executable.pm b/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/Executable.pm deleted file mode 100755 index 5337abac543..00000000000 --- a/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/Executable.pm +++ /dev/null @@ -1,185 +0,0 @@ -package TAP::Parser::SourceHandler::Executable; - -use strict; -use vars qw($VERSION @ISA); - -use TAP::Parser::SourceHandler (); -use TAP::Parser::IteratorFactory (); -use TAP::Parser::Iterator::Process (); - -@ISA = qw(TAP::Parser::SourceHandler); - -TAP::Parser::IteratorFactory->register_handler(__PACKAGE__); - -=head1 NAME - -TAP::Parser::SourceHandler::Executable - Stream output from an executable TAP source - -=head1 VERSION - -Version 3.20 - -=cut - -$VERSION = '3.20'; - -=head1 SYNOPSIS - - use TAP::Parser::Source; - use TAP::Parser::SourceHandler::Executable; - - my $source = TAP::Parser::Source->new->raw(['/usr/bin/ruby', 'mytest.rb']); - $source->assemble_meta; - - my $class = 'TAP::Parser::SourceHandler::Executable'; - my $vote = $class->can_handle( $source ); - my $iter = $class->make_iterator( $source ); - -=head1 DESCRIPTION - -This is an I L - it has 2 jobs: - -1. Figure out if the L it's given is an executable command -(L). - -2. Creates an iterator for executable commands (L). - -Unless you're writing a plugin or subclassing L, you probably -won't need to use this module directly. - -=head1 METHODS - -=head2 Class Methods - -=head3 C - - my $vote = $class->can_handle( $source ); - -Only votes if $source looks like an executable file. Casts the following votes: - - 0.9 if it's a hash with an 'exec' key - 0.8 if it's a .sh file - 0.8 if it's a .bat file - 0.75 if it's got an execute bit set - -=cut - -sub can_handle { - my ( $class, $src ) = @_; - my $meta = $src->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->{is_hash} ) { - return 0.9 if $src->raw->{exec}; - } - - return 0; -} - -=head3 C - - my $iterator = $class->make_iterator( $source ); - -Returns a new L for the source. -C<$source-Eraw> must be in one of the following forms: - - { exec => [ @exec ] } - - [ @exec ] - - $file - -Cs on error. - -=cut - -sub make_iterator { - my ( $class, $source ) = @_; - my $meta = $source->meta; - - my @command; - if ( $meta->{is_hash} ) { - @command = @{ $source->raw->{exec} || [] }; - } - elsif ( $meta->{is_scalar} ) { - @command = ${ $source->raw }; - } - elsif ( $meta->{is_array} ) { - @command = @{ $source->raw }; - } - - $class->_croak('No command found in $source->raw!') unless @command; - - $class->_autoflush( \*STDOUT ); - $class->_autoflush( \*STDERR ); - - return $class->iterator_class->new( - { command => \@command, - merge => $source->merge - } - ); -} - -=head3 C - -The class of iterator to use, override if you're sub-classing. Defaults -to L. - -=cut - -use constant iterator_class => 'TAP::Parser::Iterator::Process'; - -# Turns on autoflush for the handle passed -sub _autoflush { - my ( $class, $flushed ) = @_; - my $old_fh = select $flushed; - $| = 1; - select $old_fh; -} - -1; - -=head1 SUBCLASSING - -Please see L for a subclassing overview. - -=head2 Example - - package MyRubySourceHandler; - - use strict; - use vars '@ISA'; - - use Carp qw( croak ); - use TAP::Parser::SourceHandler::Executable; - - @ISA = qw( TAP::Parser::SourceHandler::Executable ); - - # expect $handler->(['mytest.rb', 'cmdline', 'args']); - sub make_iterator { - my ($self, $source) = @_; - my @test_args = @{ $source->test_args }; - my $rb_file = $test_args[0]; - croak("error: Ruby file '$rb_file' not found!") unless (-f $rb_file); - return $self->SUPER::raw_source(['/usr/bin/ruby', @test_args]); - } - -=head1 SEE ALSO - -L, -L, -L, -L, -L, -L, -L, -L - -=cut diff --git a/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/File.pm b/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/File.pm deleted file mode 100755 index d44ace11483..00000000000 --- a/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/File.pm +++ /dev/null @@ -1,136 +0,0 @@ -package TAP::Parser::SourceHandler::File; - -use strict; -use vars qw($VERSION @ISA); - -use TAP::Parser::SourceHandler (); -use TAP::Parser::IteratorFactory (); -use TAP::Parser::Iterator::Stream (); - -@ISA = qw(TAP::Parser::SourceHandler); - -TAP::Parser::IteratorFactory->register_handler(__PACKAGE__); - -=head1 NAME - -TAP::Parser::SourceHandler::File - Stream TAP from a text file. - -=head1 VERSION - -Version 3.20 - -=cut - -$VERSION = '3.20'; - -=head1 SYNOPSIS - - use TAP::Parser::Source; - use TAP::Parser::SourceHandler::File; - - my $source = TAP::Parser::Source->new->raw( \'file.tap' ); - $source->assemble_meta; - - my $class = 'TAP::Parser::SourceHandler::File'; - my $vote = $class->can_handle( $source ); - my $iter = $class->make_iterator( $source ); - -=head1 DESCRIPTION - -This is a I L - it has 2 jobs: - -1. Figure out if the I source it's given is a file containing raw TAP -output. See L for more details. - -2. Takes raw TAP from the text file given, and converts into an iterator. - -Unless you're writing a plugin or subclassing L, you probably -won't need to use this module directly. - -=head1 METHODS - -=head2 Class Methods - -=head3 C - - my $vote = $class->can_handle( $source ); - -Only votes if $source looks like a regular file. Casts the following votes: - - 0.9 if it's a .tap file - 0.9 if it has an extension matching any given in user config. - -=cut - -sub can_handle { - my ( $class, $src ) = @_; - my $meta = $src->meta; - my $config = $src->config_for($class); - - return 0 unless $meta->{is_file}; - my $file = $meta->{file}; - return 0.9 if $file->{lc_ext} eq '.tap'; - - if ( my $exts = $config->{extensions} ) { - return 0.9 if grep { lc($_) eq $file->{lc_ext} } @$exts; - } - - return 0; -} - -=head3 C - - my $iterator = $class->make_iterator( $source ); - -Returns a new L for the source. Cs -on error. - -=cut - -sub make_iterator { - my ( $class, $source ) = @_; - - $class->_croak('$source->raw must be a scalar ref') - unless $source->meta->{is_scalar}; - - my $file = ${ $source->raw }; - my $fh; - open( $fh, '<', $file ) - or $class->_croak("error opening TAP source file '$file': $!"); - return $class->iterator_class->new($fh); -} - -=head3 C - -The class of iterator to use, override if you're sub-classing. Defaults -to L. - -=cut - -use constant iterator_class => 'TAP::Parser::Iterator::Stream'; - -1; - -__END__ - -=head1 CONFIGURATION - - { - extensions => [ @case_insensitive_exts_to_match ] - } - -=head1 SUBCLASSING - -Please see L for a subclassing overview. - -=head1 SEE ALSO - -L, -L, -L, -L, -L, -L, -L - -=cut diff --git a/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/Handle.pm b/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/Handle.pm deleted file mode 100755 index 30594fa1e75..00000000000 --- a/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/Handle.pm +++ /dev/null @@ -1,125 +0,0 @@ -package TAP::Parser::SourceHandler::Handle; - -use strict; -use vars qw($VERSION @ISA); - -use TAP::Parser::SourceHandler (); -use TAP::Parser::IteratorFactory (); -use TAP::Parser::Iterator::Stream (); - -@ISA = qw(TAP::Parser::SourceHandler); - -TAP::Parser::IteratorFactory->register_handler(__PACKAGE__); - -=head1 NAME - -TAP::Parser::SourceHandler::Handle - Stream TAP from an IO::Handle or a GLOB. - -=head1 VERSION - -Version 3.20 - -=cut - -$VERSION = '3.20'; - -=head1 SYNOPSIS - - use TAP::Parser::Source; - use TAP::Parser::SourceHandler::Executable; - - my $source = TAP::Parser::Source->new->raw( \*TAP_FILE ); - $source->assemble_meta; - - my $class = 'TAP::Parser::SourceHandler::Handle'; - my $vote = $class->can_handle( $source ); - my $iter = $class->make_iterator( $source ); - -=head1 DESCRIPTION - -This is a I L class. It -has 2 jobs: - -1. Figure out if the L it's given is an L or -GLOB containing raw TAP output (L). - -2. Creates an iterator for IO::Handle's & globs (L). - -Unless you're writing a plugin or subclassing L, you probably -won't need to use this module directly. - -=head1 METHODS - -=head2 Class Methods - -=head3 C - - my $vote = $class->can_handle( $source ); - -Casts the following votes: - - 0.9 if $source is an IO::Handle - 0.8 if $source is a glob - -=cut - -sub can_handle { - my ( $class, $src ) = @_; - my $meta = $src->meta; - - return 0.9 - if $meta->{is_object} - && UNIVERSAL::isa( $src->raw, 'IO::Handle' ); - - return 0.8 if $meta->{is_glob}; - - return 0; -} - -=head3 C - - my $iterator = $class->make_iterator( $source ); - -Returns a new L for the source. - -=cut - -sub make_iterator { - my ( $class, $source ) = @_; - - $class->_croak('$source->raw must be a glob ref or an IO::Handle') - unless $source->meta->{is_glob} - || UNIVERSAL::isa( $source->raw, 'IO::Handle' ); - - return $class->iterator_class->new( $source->raw ); -} - -=head3 C - -The class of iterator to use, override if you're sub-classing. Defaults -to L. - -=cut - -use constant iterator_class => 'TAP::Parser::Iterator::Stream'; - -1; - -=head1 SUBCLASSING - -Please see L for a subclassing overview. - -=head1 SEE ALSO - -L, -L, -L, -L, -L, -L, -L, -L, -L, -L - -=cut diff --git a/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/Perl.pm b/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/Perl.pm deleted file mode 100755 index f6513fd3156..00000000000 --- a/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/Perl.pm +++ /dev/null @@ -1,310 +0,0 @@ -package TAP::Parser::SourceHandler::Perl; - -use strict; -use Config; -use vars qw($VERSION @ISA); - -use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ ); -use constant IS_VMS => ( $^O eq 'VMS' ); - -use TAP::Parser::SourceHandler::Executable (); -use TAP::Parser::IteratorFactory (); -use TAP::Parser::Iterator::Process (); -use TAP::Parser::Utils qw( split_shell ); - -@ISA = 'TAP::Parser::SourceHandler::Executable'; - -TAP::Parser::IteratorFactory->register_handler(__PACKAGE__); - -=head1 NAME - -TAP::Parser::SourceHandler::Perl - Stream TAP from a Perl executable - -=head1 VERSION - -Version 3.20 - -=cut - -$VERSION = '3.20'; - -=head1 SYNOPSIS - - use TAP::Parser::Source; - use TAP::Parser::SourceHandler::Perl; - - my $source = TAP::Parser::Source->new->raw( \'script.pl' ); - $source->assemble_meta; - - my $class = 'TAP::Parser::SourceHandler::Perl'; - my $vote = $class->can_handle( $source ); - my $iter = $class->make_iterator( $source ); - -=head1 DESCRIPTION - -This is a I L - it has 2 jobs: - -1. Figure out if the L it's given is actually a Perl -script (L). - -2. Creates an iterator for Perl sources (L). - -Unless you're writing a plugin or subclassing L, you probably -won't need to use this module directly. - -=head1 METHODS - -=head2 Class Methods - -=head3 C - - my $vote = $class->can_handle( $source ); - -Only votes if $source looks like a file. Casts the following votes: - - 0.9 if it has a shebang ala "#!...perl" - 0.8 if it's a .t file - 0.9 if it's a .pl file - 0.75 if it's in a 't' directory - 0.25 by default (backwards compat) - -=cut - -sub can_handle { - my ( $class, $source ) = @_; - my $meta = $source->meta; - - return 0 unless $meta->{is_file}; - my $file = $meta->{file}; - - if ( my $shebang = $file->{shebang} ) { - return 0.9 if $shebang =~ /^#!.*\bperl/; - } - - return 0.8 if $file->{lc_ext} eq '.t'; # vote higher than Executable - return 0.9 if $file->{lc_ext} eq '.pl'; - - return 0.75 if $file->{dir} =~ /^t\b/; # vote higher than Executable - - # backwards compat, always vote: - return 0.25; -} - -=head3 C - - my $iterator = $class->make_iterator( $source ); - -Constructs & returns a new L for the source. -Assumes C<$source-Eraw> contains a reference to the perl script. Cs -if the file could not be found. - -The command to run is built as follows: - - $perl @switches $perl_script @test_args - -The perl command to use is determined by L. The command generated -is guaranteed to preserve: - - PERL5LIB - PERL5OPT - Taint Mode, if set in the script's shebang - -I the command generated will I respect any shebang line defined in -your Perl script. This is only a problem if you have compiled a custom version -of Perl or if you want to use a specific version of Perl for one test and a -different version for another, for example: - - #!/path/to/a/custom_perl --some --args - #!/usr/local/perl-5.6/bin/perl -w - -Currently you need to write a plugin to get around this. - -=cut - -sub make_iterator { - my ( $class, $source ) = @_; - my $meta = $source->meta; - my $perl_script = ${ $source->raw }; - - $class->_croak("Cannot find ($perl_script)") unless $meta->{is_file}; - - # TODO: does this really need to be done here? - $class->_autoflush( \*STDOUT ); - $class->_autoflush( \*STDERR ); - - my @switches = $class->_switches($source); - my $path_sep = $Config{path_sep}; - my $path_re = qr{$path_sep}; - - # Filter out any -I switches to be handled as libs later. - # - # Nasty kludge. It might be nicer if we got the libs separately - # although at least this way we find any -I switches that were - # supplied other then as explicit libs. - # - # We filter out any names containing colons because they will break - # PERL5LIB - my @libs; - my @filtered_switches; - for (@switches) { - if ( !/$path_re/ && / ^ ['"]? -I ['"]? (.*?) ['"]? $ /x ) { - push @libs, $1; - } - else { - push @filtered_switches, $_; - } - } - @switches = @filtered_switches; - - my $setup = sub { - if (@libs) { - $ENV{PERL5LIB} - = join( $path_sep, grep {defined} @libs, $ENV{PERL5LIB} ); - } - }; - - # Cargo culted from comments seen elsewhere about VMS / environment - # variables. I don't know if this is actually necessary. - my $previous = $ENV{PERL5LIB}; - my $teardown = sub { - if ( defined $previous ) { - $ENV{PERL5LIB} = $previous; - } - else { - delete $ENV{PERL5LIB}; - } - }; - - # Taint mode ignores environment variables so we must retranslate - # PERL5LIB as -I switches and place PERL5OPT on the command line - # in order that it be seen. - if ( grep { $_ eq "-T" || $_ eq "-t" } @switches ) { - push @switches, $class->_libs2switches(@libs); - push @switches, split_shell( $ENV{PERL5OPT} ); - } - - my @command = $class->_get_command_for_switches( $source, @switches ) - or $class->_croak("No command found!"); - - return TAP::Parser::Iterator::Process->new( - { command => \@command, - merge => $source->merge, - setup => $setup, - teardown => $teardown, - } - ); -} - -sub _get_command_for_switches { - my ( $class, $source, @switches ) = @_; - my $file = ${ $source->raw }; - my @args = @{ $source->test_args || [] }; - my $command = $class->get_perl; - - # XXX don't need to quote if we treat the parts as atoms (except maybe vms) - #$file = qq["$file"] if ( $file =~ /\s/ ) && ( $file !~ /^".*"$/ ); - my @command = ( $command, @switches, $file, @args ); - return @command; -} - -sub _libs2switches { - my $class = shift; - return map {"-I$_"} grep {$_} @_; -} - -=head3 C - -Decode any taint switches from a Perl shebang line. - - # $taint will be 't' - my $taint = TAP::Parser::SourceHandler::Perl->get_taint( '#!/usr/bin/perl -t' ); - - # $untaint will be undefined - my $untaint = TAP::Parser::SourceHandler::Perl->get_taint( '#!/usr/bin/perl' ); - -=cut - -sub get_taint { - my ( $class, $shebang ) = @_; - return - unless defined $shebang - && $shebang =~ /^#!.*\bperl.*\s-\w*([Tt]+)/; - return $1; -} - -sub _switches { - my ( $class, $source ) = @_; - my $file = ${ $source->raw }; - my @args = @{ $source->test_args || [] }; - my @switches = @{ $source->switches || [] }; - my $shebang = $source->meta->{file}->{shebang}; - return unless defined $shebang; - - my $taint = $class->get_taint($shebang); - push @switches, "-$taint" if defined $taint; - - # Quote the argument if we're VMS, since VMS will downcase anything - # not quoted. - if (IS_VMS) { - for (@switches) { - $_ = qq["$_"]; - } - } - - return @switches; -} - -=head3 C - -Gets the version of Perl currently running the test suite. - -=cut - -sub get_perl { - my $class = shift; - return $ENV{HARNESS_PERL} if defined $ENV{HARNESS_PERL}; - return Win32::GetShortPathName($^X) if IS_WIN32; - return $^X; -} - -1; - -__END__ - -=head1 SUBCLASSING - -Please see L for a subclassing overview. - -=head2 Example - - package MyPerlSourceHandler; - - use strict; - use vars '@ISA'; - - use TAP::Parser::SourceHandler::Perl; - - @ISA = qw( TAP::Parser::SourceHandler::Perl ); - - # use the version of perl from the shebang line in the test file - sub get_perl { - my $self = shift; - if (my $shebang = $self->shebang( $self->{file} )) { - $shebang =~ /^#!(.*\bperl.*?)(?:(?:\s)|(?:$))/; - return $1 if $1; - } - return $self->SUPER::get_perl(@_); - } - -=head1 SEE ALSO - -L, -L, -L, -L, -L, -L, -L, -L - -=cut diff --git a/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/RawTAP.pm b/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/RawTAP.pm deleted file mode 100755 index c7048be98de..00000000000 --- a/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/RawTAP.pm +++ /dev/null @@ -1,131 +0,0 @@ -package TAP::Parser::SourceHandler::RawTAP; - -use strict; -use vars qw($VERSION @ISA); - -use TAP::Parser::SourceHandler (); -use TAP::Parser::IteratorFactory (); -use TAP::Parser::Iterator::Array (); - -@ISA = qw(TAP::Parser::SourceHandler); - -TAP::Parser::IteratorFactory->register_handler(__PACKAGE__); - -=head1 NAME - -TAP::Parser::SourceHandler::RawTAP - Stream output from raw TAP in a scalar/array ref. - -=head1 VERSION - -Version 3.20 - -=cut - -$VERSION = '3.20'; - -=head1 SYNOPSIS - - use TAP::Parser::Source; - use TAP::Parser::SourceHandler::RawTAP; - - my $source = TAP::Parser::Source->new->raw( \"1..1\nok 1\n" ); - $source->assemble_meta; - - my $class = 'TAP::Parser::SourceHandler::RawTAP'; - my $vote = $class->can_handle( $source ); - my $iter = $class->make_iterator( $source ); - -=head1 DESCRIPTION - -This is a I L - it has 2 jobs: - -1. Figure out if the L it's given is raw TAP output -(L). - -2. Creates an iterator for raw TAP output (L). - -Unless you're writing a plugin or subclassing L, you probably -won't need to use this module directly. - -=head1 METHODS - -=head2 Class Methods - -=head3 C - - my $vote = $class->can_handle( $source ); - -Only votes if $source is an array, or a scalar with newlines. Casts the -following votes: - - 0.9 if it's a scalar with '..' in it - 0.7 if it's a scalar with 'ok' in it - 0.3 if it's just a scalar with newlines - 0.5 if it's an array - -=cut - -sub can_handle { - my ( $class, $src ) = @_; - my $meta = $src->meta; - - return 0 if $meta->{file}; - if ( $meta->{is_scalar} ) { - return 0 unless $meta->{has_newlines}; - return 0.9 if ${ $src->raw } =~ /\d\.\.\d/; - return 0.7 if ${ $src->raw } =~ /ok/; - return 0.3; - } - elsif ( $meta->{is_array} ) { - return 0.5; - } - return 0; -} - -=head3 C - - my $iterator = $class->make_iterator( $source ); - -Returns a new L for the source. -C<$source-Eraw> must be an array ref, or a scalar ref. - -Cs on error. - -=cut - -sub make_iterator { - my ( $class, $src ) = @_; - my $meta = $src->meta; - - my $tap_array; - if ( $meta->{is_scalar} ) { - $tap_array = [ split "\n" => ${ $src->raw } ]; - } - elsif ( $meta->{is_array} ) { - $tap_array = $src->raw; - } - - $class->_croak('No raw TAP found in $source->raw') - unless scalar $tap_array; - - return TAP::Parser::Iterator::Array->new($tap_array); -} - -1; - -=head1 SUBCLASSING - -Please see L for a subclassing overview. - -=head1 SEE ALSO - -L, -L, -L, -L, -L, -L, -L, -L - -=cut diff --git a/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/pgTAP.pm b/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/pgTAP.pm deleted file mode 100755 index aeaf5365ff5..00000000000 --- a/Master/tlpkg/tlperl0/lib/TAP/Parser/SourceHandler/pgTAP.pm +++ /dev/null @@ -1,253 +0,0 @@ -package TAP::Parser::SourceHandler::pgTAP; - -use strict; -use vars qw($VERSION @ISA); - -use TAP::Parser::IteratorFactory (); -use TAP::Parser::Iterator::Process (); - -@ISA = qw(TAP::Parser::SourceHandler); -TAP::Parser::IteratorFactory->register_handler(__PACKAGE__); - -=head1 NAME - -TAP::Parser::SourceHandler::pgTAP - Stream TAP from pgTAP test scripts - -=head1 VERSION - -Version 3.20 - -=cut - -$VERSION = '3.20'; - -=head1 SYNOPSIS - -In F for your application with pgTAP tests in F: - - Module::Build->new( - module_name => 'MyApp', - test_file_exts => [qw(.t .pg)], - use_tap_harness => 1, - tap_harness_args => { - sources => { - Perl => undef, - pgTAP => { - dbname => 'try', - username => 'postgres', - suffix => '.pg', - }, - } - }, - build_requires => { - 'Module::Build' => '0.30', - 'TAP::Parser::SourceHandler::pgTAP' => '3.19', - }, - )->create_build_script; - -If you're using L|prove>: - - prove --source Perl \ - --source pgTAP --pgtap-option dbname=try \ - --pgtap-option username=postgres \ - --pgtap-option suffix=.pg - -Direct use: - - use TAP::Parser::Source; - use TAP::Parser::SourceHandler::pgTAP; - - my $source = TAP::Parser::Source->new->raw(\'mytest.pg'); - $source->config({ pgTAP => { - dbname => 'testing', - username => 'postgres', - suffix => '.pg', - }); - $source->assemble_meta; - - my $class = 'TAP::Parser::SourceHandler::pgTAP'; - my $vote = $class->can_handle( $source ); - my $iter = $class->make_iterator( $source ); - -=head1 DESCRIPTION - -This source handler executes pgTAP tests. It does two things: - -=over - -=item 1. - -Looks at the L passed to it to determine whether or not -the source in question is in fact a pgTAP test (L). - -=item 2. - -Creates an iterator that will call C to run the pgTAP tests -(L). - -=back - -Unless you're writing a plugin or subclassing L, you probably -won't need to use this module directly. - -=head1 METHODS - -=head2 Class Methods - -=head3 C - - my $vote = $class->can_handle( $source ); - -Looks at the source to determine whether or not it's a pgTAP test file and -returns a score for how likely it is in fact a pgTAP test file. The scores are -as follows: - - 1 if it has a suffix equal to that in the "suffix" config - 1 if its suffix is ".pg" - 0.8 if its suffix is ".sql" - 0.75 if its suffix is ".s" - -The latter two scores are subject to change, so try to name your pgTAP tests -ending in ".pg" or specify a suffix in the configuration to be sure. - -=cut - -sub can_handle { - my ( $class, $source ) = @_; - my $meta = $source->meta; - - return 0 unless $meta->{is_file}; - - my $suf = $meta->{file}{lc_ext}; - - # If the config specifies a suffix, it's required. - if ( my $config = $source->config_for('pgTAP') ) { - if ( defined $config->{suffix} ) { - return $suf eq $config->{suffix} ? 1 : 0; - } - } - - # Otherwise, return a score for our supported suffixes. - my %score_for = ( - '.pg' => 0.9, - '.sql' => 0.8, - '.s' => 0.75, - ); - return $score_for{$suf} || 0; -} - -=head3 C - - my $iterator = $class->make_iterator( $source ); - -Returns a new L for the source. C<< -$source->raw >> must be either a file name or a scalar reference to the file -name. - -The pgTAP tests are run by executing C, the PostgreSQL command-line -utility. A number of arguments are passed to it, many of which you can effect -by setting up the source source configuration. The configuration must be a -hash reference, and supports the following keys: - -=over - -=item C - -The path to the C command. Defaults to simply "psql", which should work -well enough if it's in your path. - -=item C - -The database to which to connect to run the tests. Defaults to the value of -the C<$PGDATABASE> environment variable or, if not set, to the system -username. - -=item C - -The PostgreSQL username to use to connect to PostgreSQL. If not specified, no -username will be used, in which case C will fall back on either the -C<$PGUSER> environment variable or, if not set, the system username. - -=item C - -Specifies the host name of the machine to which to connect to the PostgreSQL -server. If the value begins with a slash, it is used as the directory for the -Unix-domain socket. Defaults to the value of the C<$PGDATABASE> environment -variable or, if not set, the local host. - -=item C - -Specifies the TCP port or the local Unix-domain socket file extension on which -the server is listening for connections. Defaults to the value of the -C<$PGPORT> environment variable or, if not set, to the port specified at the -time C was compiled, usually 5432. - -=begin comment - -=item C - -The schema search path to use during the execution of the tests. Useful for -overriding the default search path and you have pgTAP installed in a schema -not included in that search path. - -=end comment - -=back - -=cut - -sub make_iterator { - my ( $class, $source ) = @_; - my $config = $source->config_for('pgTAP'); - - my @command = ( $config->{psql} || 'psql' ); - push @command, qw( - --no-psqlrc - --no-align - --quiet - --pset pager= - --pset tuples_only=true - --set ON_ERROR_ROLLBACK=1 - --set ON_ERROR_STOP=1 - ); - - for (qw(username host port dbname)) { - push @command, "--$_" => $config->{$_} if defined $config->{$_}; - } - - my $fn = ref $source->raw ? ${ $source->raw } : $source->raw; - $class->_croak( - 'No such file or directory: ' . ( defined $fn ? $fn : '' ) ) - unless $fn && -e $fn; - - push @command, '--file', $fn; - - # XXX I'd like a way to be able to specify environment variables to set when - # the iterator executes the command... - # local $ENV{PGOPTIONS} = "--search_path=$config->{search_path}" - # if $config->{search_path}; - - return TAP::Parser::Iterator::Process->new( - { command => \@command, - merge => $source->merge - } - ); -} - -=head1 SEE ALSO - -L, -L, -L, -L, -L, -L, -L, -L, -L - -=head1 AUTHOR - -David E. Wheeler - -=cut -- cgit v1.2.3