TAP-Harness-Archive-0.15000755001750001750 012132226623 13451 5ustar00ss5ss5000000000000TAP-Harness-Archive-0.15/TODO000444001750001750 21712132226623 14256 0ustar00ss5ss5000000000000=head1 TODO =over =item * use TAP::Harness callbacks as they become available and more stable so we don't have to override runtests() =back TAP-Harness-Archive-0.15/Makefile.PL000444001750001750 145612132226623 15566 0ustar00ss5ss5000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.32 use ExtUtils::MakeMaker; WriteMakefile ( 'INSTALLDIRS' => 'site', 'NAME' => 'TAP::Harness::Archive', 'EXE_FILES' => [], 'VERSION_FROM' => 'lib/TAP/Harness/Archive.pm', 'PREREQ_PM' => { 'YAML::Tiny' => 0, 'File::Spec' => 0, 'TAP::Harness' => '3.05', 'Test::More' => 0, 'File::Find' => 0, 'File::Temp' => 0, 'File::Path' => 0, 'File::Basename' => 0, 'Archive::Tar' => 0, 'Cwd' => 0 } ) ; TAP-Harness-Archive-0.15/META.yml000444001750001750 133512132226623 15061 0ustar00ss5ss5000000000000--- abstract: 'Create an archive of TAP test results' author: - 'Michael Peters ' build_requires: {} configure_requires: Module::Build: 0.40 dynamic_config: 1 generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: TAP-Harness-Archive provides: TAP::Harness::Archive: file: lib/TAP/Harness/Archive.pm version: 0.15 requires: Archive::Tar: 0 Cwd: 0 File::Basename: 0 File::Find: 0 File::Path: 0 File::Spec: 0 File::Temp: 0.19 TAP::Harness: 3.05 Test::More: 0 YAML::Tiny: 0 resources: license: http://dev.perl.org/licenses/ version: 0.15 TAP-Harness-Archive-0.15/Changes000444001750001750 300612132226623 15100 0ustar00ss5ss5000000000000Revision history for TAP-Harness-Archive 0.15 13 Apr, 2013 + Fix tests to correctly use File::Temp which no longer allows wrong use of tempdir() as class method. [Steffen Schwigon] 0.14 27 Jul, 2009 + Added file_attributes hash to the META.yml file of the archive [Justin DeVuyst] + Added traditional Makefile.PL generation [M. Peters] 0.13 11 Mar, 2009 + explicitly use 'TAP::Parser::Aggregator' instead of relying on TAP::Archive to do it for us [M. Peters] + Allow archive to be a directory in which case we just dump stuff in to it. [Andy Armstrong, Steffen Schwigon, M. Peters] 0.12 21 Jul, 2008 + Re-fixing RT#37795 on Windows [Tim Heckman] 0.11 19 Jul, 2008 + Fixing RT#37795. This should fix failing tests on windows. [Tim Heckman] + Only run t/pod.t and t/pod-coverage.t if RELEASE_TESTING is set. [M. Peters] 0.10 04 Jul, 2008 + Added full path as extra argument to made_parser_callback [M. Peters] + Added extra_files argument to new() [M. Peters] + Added extra_properties argument to new() [M. Peters] + Fixed RT# 35649 [M. Peters] 0.03 15 Dec, 2007 + Removed Archive::Builder and Archive::Extract as dependencies because they have soooo many other dependencies. Just using Archive::Tar instead [M. Peters] + Removed support for ZIP files (due to removing Archive::Extract). If this is needed we can always use Archive::Zip. [M. Peters] 0.01 20 Aug, 2007 + First version, released on an unsuspecting world. [M. Peters] TAP-Harness-Archive-0.15/MANIFEST000444001750001750 43212132226623 14716 0ustar00ss5ss5000000000000Build.PL Changes lib/TAP/Harness/Archive.pm Makefile.PL MANIFEST This list of files t/archive.t t/bar.t t/extra_files.t t/extra_files/log1.txt t/extra_files/log2.txt t/extra_files/stuff/svk.info t/extra_properties.t t/foo.t t/pod-coverage.t t/pod.t TODO README META.yml META.json TAP-Harness-Archive-0.15/README000444001750001750 1156612132226623 14517 0ustar00ss5ss5000000000000NAME TAP::Harness::Archive - Create an archive of TAP test results SYNOPSIS use TAP::Harness::Archive; my $harness = TAP::Harness::Archive->new(\%args); $harness->runtests(@tests); DESCRIPTION This module is a direct subclass of TAP::Harness and behaves in exactly the same way except for one detail. In addition to outputting a running progress of the tests and an ending summary it can also capture all of the raw TAP from the individual test files or streams into an archive file (".tar" or ".tar.gz"). METHODS All methods are exactly the same as our base TAP::Harness except for the following. new In addition to the options that TAP::Harness allow to this method, we also allow the following: archive This is the name of the archive file to generate. We use Archive::Tar in the background so we only support ".tar" and ".tar.gz" archive file formats. This can optionally be an existing directory that will have the TAP archive's contents deposited therein without any file archiving (no Archive::Tar involved). extra_files This is an array reference to extra files that you want to include in the TAP archive but which are not TAP files themselves. This is useful if you want to include some log files that contain useful information about the test run. extra_properties This is a hash reference of extra properties that you've collected during your test run. Some things you might want to include are the Perl version, the system's architecture, the operating system, etc. runtests Takes the same arguments as TAP::Harness's version and returns the same thing (a TAP::Parser::Aggregator object). The only difference is that in addition to the normal test running and progress output we also create the TAP Archive when it's all done. aggregator_from_archive This class method will return a TAP::Parser::Aggregator object when given a TAP Archive to open and parse. It's pretty much the reverse of creating a TAP Archive from using "new" and "runtests". It takes a hash of arguments which are as follows: archive The path to the archive file. This can also be a directory if you created the archive as a directory. This is required. parser_callbacks This is a hash ref containing callbacks for the TAP::Parser objects that are created while parsing the TAP files. See the TAP::Parser documentation for details about these callbacks. made_parser_callback This callback is executed every time a new TAP::Parser object is created. It will be passed the new parser object, the name of the file to be parsed, and also the full (temporary) path of that file. meta_yaml_callback This is a subroutine that will be called if we find and parse a YAML file containing meta information about the test run in the archive. The structure of the YAML file will be passed in as an argument. my $aggregator = TAP::Harness::Archive->aggregator_from_archive( { archive => 'my_tests.tar.gz', parser_callbacks => { plan => sub { warn "Nice to see you plan ahead..." }, unknown => sub { warn "Your TAP is bad!" }, }, made_parser_callback => sub { my ($parser, $file, $full_path) = @_; warn "$file is temporarily located at $full_path\n"; } } ); AUTHOR Michael Peters, "" BUGS Please report any bugs or feature requests to "bug-tap-harness-archive at rt.cpan.org", or through the web interface at . I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. SUPPORT You can find documentation for this module with the perldoc command. perldoc TAP::Harness::Archive You can also look for information at: * AnnoCPAN: Annotated CPAN documentation * CPAN Ratings * RT: CPAN's request tracker * Search CPAN ACKNOWLEDGEMENTS * A big thanks to Plus Three, LP () for sponsoring my work on this module and other open source pursuits. * Andy Armstrong COPYRIGHT & LICENSE Copyright 2007 Michael Peters, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. TAP-Harness-Archive-0.15/Build.PL000444001750001750 134312132226623 15103 0ustar00ss5ss5000000000000use strict; use warnings; use Module::Build; use lib './t/lib'; my $builder = Module::Build->new( module_name => 'TAP::Harness::Archive', license => 'perl', dist_author => 'Michael Peters ', dist_version_from => 'lib/TAP/Harness/Archive.pm', requires => { 'TAP::Harness' => 3.05, 'Archive::Tar' => 0, 'Test::More' => 0, 'Cwd' => 0, 'File::Basename' => 0, 'File::Temp' => 0.19, 'File::Spec' => 0, 'File::Path' => 0, 'File::Find' => 0, 'YAML::Tiny' => 0, }, create_readme => 1, ); $builder->create_build_script() TAP-Harness-Archive-0.15/META.json000444001750001750 232512132226623 15231 0ustar00ss5ss5000000000000{ "abstract" : "Create an archive of TAP test results", "author" : [ "Michael Peters " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "TAP-Harness-Archive", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0.40" } }, "runtime" : { "requires" : { "Archive::Tar" : "0", "Cwd" : "0", "File::Basename" : "0", "File::Find" : "0", "File::Path" : "0", "File::Spec" : "0", "File::Temp" : "0.19", "TAP::Harness" : "3.05", "Test::More" : "0", "YAML::Tiny" : "0" } } }, "provides" : { "TAP::Harness::Archive" : { "file" : "lib/TAP/Harness/Archive.pm", "version" : "0.15" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.15" } TAP-Harness-Archive-0.15/t000755001750001750 012132226623 13714 5ustar00ss5ss5000000000000TAP-Harness-Archive-0.15/t/bar.t000444001750001750 12112132226623 14754 0ustar00ss5ss5000000000000#!perl use Test::More (tests => 2); ok(1, 'bar is ok'); ok(1, 'bar is more ok'); TAP-Harness-Archive-0.15/t/archive.t000444001750001750 574012132226623 15665 0ustar00ss5ss5000000000000#!perl use Test::More; use File::Temp (); use File::Spec::Functions qw(catfile catdir file_name_is_absolute); use TAP::Harness::Archive; plan(tests => 65); # test creation eval { TAP::Harness::Archive->new() }; like($@, qr/You must provide the name of the archive to create!/); eval { TAP::Harness::Archive->new({archive => 'foo.bar'}) }; like($@, qr/Archive is not a known format type!/); # a temp directory to put everything in my $temp_dir = File::Temp->newdir('tap-archive-XXXXXXXX', CLEANUP => 1, TMPDIR => 1); my @testfiles = map { catfile('t', $_) } qw(foo.t bar.t); # first a .tar file $file = catfile($temp_dir, 'archive.tar'); $harness = TAP::Harness::Archive->new({archive => $file, verbosity => -2}); $harness->runtests(@testfiles); ok(-e $file, 'archive.tar created'); check_archive($file); # now a .tar.gz $file = catfile($temp_dir, 'archive.tar.gz'); $harness = TAP::Harness::Archive->new({archive => $file, verbosity => -2}); $harness->runtests(@testfiles); ok(-e $file, 'archive.tar.gz created'); check_archive($file); # now a simple directory my $dir = File::Temp->newdir('tap-archive-XXXXXXXX', CLEANUP => 1, TMPDIR => 1); $harness = TAP::Harness::Archive->new({archive => $dir, verbosity => -2}); $harness->runtests(@testfiles); ok(!-e catfile($dir, 'archive.tar.gz'), "no archive.tar.gz created"); check_archive($dir); sub check_archive { my $archive_file = shift; my %tap_files; my $aggregator = TAP::Harness::Archive->aggregator_from_archive( { archive => $archive_file, made_parser_callback => sub { my ($parser, $filename, $full_path) = @_; isa_ok($parser, 'TAP::Parser'); $tap_files{$filename} = 1; ok(-e $full_path, 'full path file exists'); ok(file_name_is_absolute($full_path), 'full path is absolute'); }, meta_yaml_callback => sub { my $yaml = shift; $yaml = $yaml->[0]; ok(exists $yaml->{start_time}, 'meta.yml: start_time exists'); ok(exists $yaml->{stop_time}, 'meta.yml: stop_time exists'); ok(exists $yaml->{file_order}, 'meta.yml: file_order exists'); ok(exists $yaml->{file_attributes}, 'meta.yml: file_attributes exists'); }, } ); isa_ok($aggregator, 'TAP::Parser::Aggregator'); cmp_ok($aggregator->total, '==', 5, "aggregator has correct total"); cmp_ok(scalar keys %tap_files, '==', 2, "correct number of files in archive $archive_file"); foreach my $f (@testfiles) { ok($tap_files{$f}, "file $f in archive $archive_file"); } my @parsers = $aggregator->parsers(); cmp_ok(scalar @parsers, '==', 2, "correct # of parsers"); cmp_ok($parsers[0]->passed(), '==', 3, "foo.t passed 3"); cmp_ok($parsers[0]->failed(), '==', 0, "foo.t failed 0"); cmp_ok($parsers[1]->passed(), '==', 2, "bar.t passed 2"); cmp_ok($parsers[1]->failed(), '==', 0, "bar.t failed 0"); } TAP-Harness-Archive-0.15/t/foo.t000444001750001750 14512132226623 15001 0ustar00ss5ss5000000000000#!perl use Test::More (tests => 3); ok('foo is rad'); ok('foo is radder'); ok('foo is the bestest'); TAP-Harness-Archive-0.15/t/pod.t000444001750001750 37012132226623 15000 0ustar00ss5ss5000000000000#!perl -T use Test::More; if ($ENV{RELEASE_TESTING}) { eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); } else { plan skip_all => "We are not running release tests"; } TAP-Harness-Archive-0.15/t/pod-coverage.t000444001750001750 42712132226623 16574 0ustar00ss5ss5000000000000#!perl -T use Test::More; if($ENV{RELEASE_TESTING}) { eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); } else { plan skip_all => "We are not running release tests"; } TAP-Harness-Archive-0.15/t/extra_files.t000444001750001750 420212132226623 16541 0ustar00ss5ss5000000000000#!perl use Test::More; use File::Temp (); use File::Spec::Functions qw(catfile catdir file_name_is_absolute splitdir); use TAP::Harness::Archive; use Archive::Tar; plan(tests => 10); # a temp directory to put everything in my $temp_dir = File::Temp->newdir('tap-archive-XXXXXXXX', CLEANUP => 1, TMPDIR => 1); my @testfiles = (catfile('t', 'foo.t'), catfile('t', 'bar.t')); my @extra_files = ( catfile('t', 'extra_files', 'log1.txt'), catfile('t', 'extra_files', 'log2.txt'), catfile('t', 'extra_files', 'stuff', 'svk.info'), ); # create an archive with extra files $file = catfile($temp_dir, 'archive.tar.gz'); $harness = TAP::Harness::Archive->new( { archive => $file, verbosity => -2, extra_files => \@extra_files, } ); $harness->runtests(@testfiles); ok(-e $file, 'archive.tar.gz created'); check_archive($file); sub check_archive { my $archive_file = shift; my %tap_files; my $aggregator = TAP::Harness::Archive->aggregator_from_archive( { archive => $archive_file, meta_yaml_callback => sub { my $yaml = shift; $yaml = $yaml->[0]; # did we have all of the extra files? my $x_files = $yaml->{extra_files}; cmp_ok(ref $x_files, 'eq', 'ARRAY', 'extra_files is an array'); cmp_ok(scalar(@$x_files), '==', 3, '3 extra_files recorded'); }, } ); isa_ok($aggregator, 'TAP::Parser::Aggregator'); cmp_ok($aggregator->total, '==', 5, "aggregator has correct total"); my @parsers = $aggregator->parsers(); cmp_ok(scalar @parsers, '==', 2, "correct # of parsers"); } my $tar = Archive::Tar->new($file); isa_ok($tar, 'Archive::Tar'); my @contents = $tar->list_files(); foreach my $extra_file (@extra_files) { # Archive::Tar returns file names with "/" path separator. # Passing it through catdir(splitdir()) will give us the # correct system path separator (e.g. "\" on Win32). my $count = grep { catdir(splitdir($_)) eq $extra_file } @contents; ok($count == 1, "Archive contains extra file $extra_file"); } TAP-Harness-Archive-0.15/t/extra_properties.t000444001750001750 304512132226623 17637 0ustar00ss5ss5000000000000#!perl use Test::More; use File::Temp (); use File::Spec::Functions qw(catfile catdir file_name_is_absolute); use TAP::Harness::Archive; plan(tests => 5); # a temp directory to put everything in my $temp_dir = File::Temp->newdir('tap-archive-XXXXXXXX', CLEANUP => 1, TMPDIR => 1); my @testfiles = (catfile('t', 'foo.t'), catfile('t', 'bar.t')); my %extra_props = ( name => { first => 'Michael', last => 'Peters', middle => 'Ryan', }, hair_color => 'brown', states => [qw(UT CA AL TN MD NC)], ); # create an archive with extra files $file = catfile($temp_dir, 'archive.tar.gz'); $harness = TAP::Harness::Archive->new({ archive => $file, verbosity => -2, extra_properties => \%extra_props, }); $harness->runtests(@testfiles); ok(-e $file, 'archive.tar.gz created'); check_archive($file); sub check_archive { my $archive_file = shift; my %tap_files; my $aggregator = TAP::Harness::Archive->aggregator_from_archive( { archive => $archive_file, meta_yaml_callback => sub { my $yaml = shift; $yaml = $yaml->[0]; # did our extra_properties come through is_deeply($yaml->{extra_properties}, \%extra_props, 'extra_properties are correct'); }, } ); isa_ok($aggregator, 'TAP::Parser::Aggregator'); cmp_ok($aggregator->total, '==', 5, "aggregator has correct total"); my @parsers = $aggregator->parsers(); cmp_ok(scalar @parsers, '==', 2, "correct # of parsers"); } TAP-Harness-Archive-0.15/t/extra_files000755001750001750 012132226623 16221 5ustar00ss5ss5000000000000TAP-Harness-Archive-0.15/t/extra_files/log1.txt000444001750001750 122012132226623 17754 0ustar00ss5ss5000000000000[Fri Jul 4 17:09:43 2008] [info] removed PID file /home/mpeters/development/smolder/tmp/httpd.pid (pid=32139) [Fri Jul 4 17:09:43 2008] [notice] caught SIGTERM, shutting down [Fri Jul 4 17:09:52 2008] [info] created shared memory segment #2359318 [Fri Jul 4 17:09:52 2008] [notice] Apache/1.3.36 (Unix) mod_perl/1.29 configured -- resuming normal operations [Fri Jul 4 17:09:52 2008] [info] Server built: Jun 18 2008 10:22:41 [Fri Jul 4 17:09:52 2008] [notice] Accept mutex: sysvsem (Default: sysvsem) [Fri Jul 4 17:17:15 2008] (32176) Apache::SizeLimit httpd process too big, exiting at SIZE=42696 KB SHARE=2524 KB REQUESTS=4 LIFETIME=0 seconds TAP-Harness-Archive-0.15/t/extra_files/log2.txt000444001750001750 77512132226623 17753 0ustar00ss5ss5000000000000[Fri Jul 4 17:07:41 2008] [info] removed PID file /home/mpeters/development/smolder/tmp/httpd.pid (pid=32113) [Fri Jul 4 17:07:41 2008] [notice] caught SIGTERM, shutting down [Fri Jul 4 17:07:42 2008] [info] created shared memory segment #2326550 [Fri Jul 4 17:07:42 2008] [notice] Apache/1.3.36 (Unix) mod_perl/1.29 configured -- resuming normal operations [Fri Jul 4 17:07:42 2008] [info] Server built: Jun 18 2008 10:22:41 [Fri Jul 4 17:07:42 2008] [notice] Accept mutex: sysvsem (Default: sysvsem) TAP-Harness-Archive-0.15/t/extra_files/stuff000755001750001750 012132226623 17350 5ustar00ss5ss5000000000000TAP-Harness-Archive-0.15/t/extra_files/stuff/svk.info000444001750001750 33112132226623 21142 0ustar00ss5ss5000000000000Checkout Path: /home/mpeters/development/smolder Depot Path: //local/smolder/trunk Revision: 51043 Last Changed Rev.: 51043 Copied From: /mirror/smolder/trunk, Rev. 4352 Merged From: /mirror/smolder/trunk, Rev. 15003 TAP-Harness-Archive-0.15/lib000755001750001750 012132226623 14217 5ustar00ss5ss5000000000000TAP-Harness-Archive-0.15/lib/TAP000755001750001750 012132226623 14643 5ustar00ss5ss5000000000000TAP-Harness-Archive-0.15/lib/TAP/Harness000755001750001750 012132226623 16246 5ustar00ss5ss5000000000000TAP-Harness-Archive-0.15/lib/TAP/Harness/Archive.pm000444001750001750 3156712132226623 20356 0ustar00ss5ss5000000000000package TAP::Harness::Archive; use warnings; use strict; use base 'TAP::Harness'; use Cwd (); use File::Basename (); use File::Temp (); use File::Spec (); use File::Path (); use File::Find (); use Archive::Tar (); use TAP::Parser (); use YAML::Tiny (); use TAP::Parser::Aggregator (); =head1 NAME TAP::Harness::Archive - Create an archive of TAP test results =cut our $VERSION = '0.15'; =head1 SYNOPSIS use TAP::Harness::Archive; my $harness = TAP::Harness::Archive->new(\%args); $harness->runtests(@tests); =head1 DESCRIPTION This module is a direct subclass of L and behaves in exactly the same way except for one detail. In addition to outputting a running progress of the tests and an ending summary it can also capture all of the raw TAP from the individual test files or streams into an archive file (C<.tar> or C<.tar.gz>). =head1 METHODS All methods are exactly the same as our base L except for the following. =head2 new In addition to the options that L allow to this method, we also allow the following: =over =item archive This is the name of the archive file to generate. We use L in the background so we only support C<.tar> and C<.tar.gz> archive file formats. This can optionally be an existing directory that will have the TAP archive's contents deposited therein without any file archiving (no L involved). =item extra_files This is an array reference to extra files that you want to include in the TAP archive but which are not TAP files themselves. This is useful if you want to include some log files that contain useful information about the test run. =item extra_properties This is a hash reference of extra properties that you've collected during your test run. Some things you might want to include are the Perl version, the system's architecture, the operating system, etc. =back =cut my (%ARCHIVE_TYPES, @ARCHIVE_EXTENSIONS); BEGIN { %ARCHIVE_TYPES = ( 'tar' => 'tar', 'tar.gz' => 'tar.gz', 'tgz' => 'tar.gz', ); @ARCHIVE_EXTENSIONS = map { ".$_" } keys %ARCHIVE_TYPES; } sub new { my ($class, $args) = @_; $args ||= {}; # these can't be passed on to Test::Harness my $archive = delete $args->{archive}; my $extra_files = delete $args->{extra_files}; my $extra_props = delete $args->{extra_properties}; $class->_croak("You must provide the name of the archive to create!") unless $archive; my $self = $class->SUPER::new($args); my $is_directory = -d $archive ? 1 : 0; if ($is_directory) { $self->{__archive_is_directory} = $is_directory; $self->{__archive_tempdir} = $archive; } else { my $format = $class->_get_archive_format_from_filename($archive); # if it's not a format we understand, or it's not a directory $class->_croak("Archive is not a known format type!") unless $format && $ARCHIVE_TYPES{$format}; $self->{__archive_file} = $archive; $self->{__archive_format} = $format; $self->{__archive_tempdir} = File::Temp::tempdir(); } # handle any extra files if($extra_files) { ref $extra_files eq 'ARRAY' or $class->_croak("extra_files must be an array reference!"); foreach my $file (@$extra_files) { $class->_croak("extra_file $file does not exist!") unless -e $file; $class->_croak("extra_file $file is not readable!") unless -r $file; } $self->{__archive_extra_files} = $extra_files; } if($extra_props) { ref $extra_props eq 'HASH' or $class->_croak("extra_properties must be a hash reference!"); $self->{__archive_extra_props} = $extra_props; } return $self; } sub _get_archive_format_from_filename { my ($self, $filename) = @_; # try to guess it if we don't have one my (undef, undef, $suffix) = File::Basename::fileparse($filename, @ARCHIVE_EXTENSIONS); $suffix =~ s/^\.//; return $ARCHIVE_TYPES{$suffix}; } =head2 runtests Takes the same arguments as L's version and returns the same thing (a L object). The only difference is that in addition to the normal test running and progress output we also create the TAP Archive when it's all done. =cut sub runtests { my ($self, @files) = @_; # tell TAP::Harness to put the raw tap someplace we can find it later my $dir = $self->{__archive_tempdir}; $ENV{PERL_TEST_HARNESS_DUMP_TAP} = $dir; # get some meta information about this run my %meta = ( file_order => \@files, start_time => time(), ); my $aggregator = $self->SUPER::runtests(@files); $meta{stop_time} = time(); my @parsers = $aggregator->parsers; for ( my $i = 0; $i < @parsers; $i++ ) { $parsers[ $i ] = { start_time => $parsers[ $i ]->start_time, end_time => $parsers[ $i ]->end_time, description => $files[ $i ], }; } $meta{file_attributes} = \@parsers; my $cwd = Cwd::getcwd(); my $is_dir = $self->{__archive_is_directory}; my ($archive, $output_file); if( $is_dir ) { $output_file = $self->{__archive_tempdir}; } else { $output_file = $self->{__archive_file}; # go into the dir so that we can reference files # relatively and put them in the archive that way chdir($dir) or $self->_croak("Could not change to directory $dir: $!"); unless (File::Spec->file_name_is_absolute($output_file)) { $output_file = File::Spec->catfile($cwd, $output_file); } # create the archive $archive = Archive::Tar->new(); $archive->add_files($self->_get_all_tap_files); chdir($cwd) or $self->_croak("Could not return to directory $cwd: $!"); } # add in any extra files if(my $x_files = $self->{__archive_extra_files}) { my @rel_x_files; foreach my $x_file (@$x_files) { # handle both relative and absolute file names my $rel_file; if( File::Spec->file_name_is_absolute($x_file) ) { $rel_file = File::Spec->abs2rel($x_file, $cwd); } else { $rel_file = $x_file; } push(@rel_x_files, $rel_file); } $archive->add_files(@rel_x_files) unless $is_dir; $meta{extra_files} = \@rel_x_files; } # add any extra_properties to the meta if(my $extra_props = $self->{__archive_extra_props}) { $meta{extra_properties} = $extra_props; } # create the YAML meta file my $yaml = YAML::Tiny->new(); $yaml->[0] = \%meta; if( $is_dir ) { my $meta_file = File::Spec->catfile($output_file, 'meta.yml'); open(my $out, '>', $meta_file) or die "Could not create meta.yml: $!"; print $out $yaml->write_string; close($out); } else { $archive->add_data('meta.yml', $yaml->write_string); $archive->write($output_file, $self->{__archive_format} eq 'tar.gz') or die $archive->errstr; # be nice and clean up File::Path::rmtree($dir); } print "\nTAP Archive created at $output_file\n" unless $self->verbosity < -1; return $aggregator; } sub _get_all_tap_files { my ($self, $dir, $meta) = @_; $dir ||= $self->{__archive_tempdir}; my @files; my %x_files; if($meta && $meta->{extra_files}) { %x_files = map { $_ => 1 } @{$meta->{extra_files}}; } File::Find::find( { no_chdir => 1, wanted => sub { return if /^\./; return if -d; my $rel_name = File::Spec->abs2rel($_, $dir); return if $rel_name eq 'meta.yml'; push(@files, $rel_name) unless $x_files{$rel_name}; }, }, $dir ); return @files; } =head2 aggregator_from_archive This class method will return a L object when given a TAP Archive to open and parse. It's pretty much the reverse of creating a TAP Archive from using C and C. It takes a hash of arguments which are as follows: =over =item archive The path to the archive file. This can also be a directory if you created the archive as a directory. This is required. =item parser_callbacks This is a hash ref containing callbacks for the L objects that are created while parsing the TAP files. See the L documentation for details about these callbacks. =item made_parser_callback This callback is executed every time a new L object is created. It will be passed the new parser object, the name of the file to be parsed, and also the full (temporary) path of that file. =item meta_yaml_callback This is a subroutine that will be called if we find and parse a YAML file containing meta information about the test run in the archive. The structure of the YAML file will be passed in as an argument. =back my $aggregator = TAP::Harness::Archive->aggregator_from_archive( { archive => 'my_tests.tar.gz', parser_callbacks => { plan => sub { warn "Nice to see you plan ahead..." }, unknown => sub { warn "Your TAP is bad!" }, }, made_parser_callback => sub { my ($parser, $file, $full_path) = @_; warn "$file is temporarily located at $full_path\n"; } } ); =cut sub aggregator_from_archive { my ($class, $args) = @_; my $meta; my $file = $args->{archive} or $class->_croak("You must provide the path to the archive!"); my $is_directory = -d $file; # extract the files out into a temporary directory my $dir = $is_directory ? $file : File::Temp::tempdir(); my $cwd = Cwd::getcwd(); chdir($dir) or $class->_croak("Could not change to directory $dir: $!"); my @files; Archive::Tar->new()->extract_archive($file) unless $is_directory; my @tap_files; # do we have a meta.yml file in the archive? my $yaml_file = File::Spec->catfile($dir, 'meta.yml'); if( -e $yaml_file) { # parse it into a structure $meta = YAML::Tiny->new()->read($yaml_file); die "Could not read YAML $yaml_file: " . YAML::Tiny->errstr if YAML::Tiny->errstr; if($args->{meta_yaml_callback}) { $args->{meta_yaml_callback}->($meta); } $meta = $meta->[0]; if($meta->{file_order} && ref $meta->{file_order} eq 'ARRAY') { foreach my $file (@{$meta->{file_order}}) { push(@tap_files, $file) if -e $file; } } } # if we didn't get the files from the YAML file, just find them all unless(@tap_files) { @tap_files = $class->_get_all_tap_files($dir, $meta); } # now create the aggregator my $aggregator = TAP::Parser::Aggregator->new(); foreach my $tap_file (@tap_files) { open(my $fh, $tap_file) or die "Could not open $tap_file for reading: $!"; my $parser = TAP::Parser->new({source => $fh, callbacks => $args->{parser_callbacks}}); if($args->{made_parser_callback}) { $args->{made_parser_callback}->($parser, $tap_file, File::Spec->catfile($dir, $tap_file)); } $parser->run; $aggregator->add($tap_file, $parser); } # be nice and clean up chdir($cwd) or $class->_croak("Could not return to directory $cwd: $!"); File::Path::rmtree($dir) unless $is_directory; return $aggregator; } =head1 AUTHOR Michael Peters, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc TAP::Harness::Archive You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS =over =item * A big thanks to Plus Three, LP (L) for sponsoring my work on this module and other open source pursuits. =item * Andy Armstrong =back =head1 COPYRIGHT & LICENSE Copyright 2007 Michael Peters, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of TAP::Harness::Archive