File Coverage

blib/lib/SmokeRunner/Multi/Runner/TAPArchive.pm

Criterion	Covered	Total	%
statement	62	62	100.0
branch	6	12	50.0
condition	1	3	33.3
subroutine	15	15	100.0
pod	2	2	100.0
total	86	94	91.4

package SmokeRunner::Multi::Runner::TAPArchive;
our $AUTHORITY = 'cpan:YANICK';
#ABSTRACT: Runner subclass which creates a TAP archive file
$SmokeRunner::Multi::Runner::TAPArchive::VERSION = '0.21';
use strict;
use warnings;

use base 'SmokeRunner::Multi::Runner';
__PACKAGE__->mk_ro_accessors( 'tap_archive_file' );

use Archive::Tar;
use File::Basename qw( basename );
use File::chdir;
use File::Spec;
use File::Temp qw( tempfile tempdir );
use SmokeRunner::Multi::SafeRun qw( safe_run );
use SmokeRunner::Multi::Validate qw( validate ARRAYREF_TYPE );
use YAML::Syck qw( Dump );


sub new
{
    my $class = shift;

    return $class->SUPER::new(@_);
}

sub run_tests
{
    my $self = shift;

    my $temp_dir = tempdir( CLEANUP => 1 );
    my $archive  = Archive::Tar->new();

    my @files     = $self->set()->test_files();
    my %meta_info =
        ( file_order => \@files,
          start_time => time,
        );

    {
        local $CWD = $self->set()->set_dir();
        foreach my $file (@files) {
            my $output;
            safe_run
                ( command       => $self->_perl_bin(),
                  args          => [ $self->_libs(), $file ],
                  stdout_buffer => \$output,
                  stderr_buffer => \$output,
                );

            my $basename = basename( $file, '.t' );
            my $destination
                = File::Spec->catfile( $temp_dir, "$basename.tap" );

            open my $fh, '>', $destination
                or die "Cannot write to $destination: $!";
            print $fh $output
                or die "Cannot write to $destination: $!";
            close $fh
                or die "Cannot write to $destination: $!";
        }
    }

    $meta_info{stop_time} = time;
    open my $meta_fh, '>', File::Spec->catfile( $temp_dir, 'meta.yml' )
        or die "Could not open meta.yml for writing: $!";
    print $meta_fh Dump( \%meta_info );
    close $meta_fh;

    $archive->add_files( glob( File::Spec->catfile( $temp_dir, '*' ) ) );

    my $tar_file = File::Spec->catfile( $temp_dir, "tap-archive-$$.tar.gz" );
    $archive->write( $tar_file, 1 );

    $self->{tap_archive_file} = $tar_file;
}

# adapted from Test::Harness::Straps
sub _perl_bin
{
    return $ENV{HARNESS_PERL}
        if defined $ENV{HARNESS_PERL};

    return qq["$^X"]
        if $^O =~ /^(MS)?Win32$/ && $^X =~ /[^\w\.\/\\]/;

    return $^X;
}

sub _libs
{
    return '-Mblib', '-Mlib=lib';
}


1;

__END__