line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package TAP::Harness::Archive; |
2
|
3
|
|
|
3
|
|
153775
|
use warnings; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
97
|
|
3
|
3
|
|
|
3
|
|
14
|
use strict; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
63
|
|
4
|
3
|
|
|
3
|
|
15
|
use base 'TAP::Harness'; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
2775
|
|
5
|
3
|
|
|
3
|
|
28263
|
use Cwd (); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
47
|
|
6
|
3
|
|
|
3
|
|
16
|
use File::Basename (); |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
43
|
|
7
|
3
|
|
|
3
|
|
15
|
use File::Temp (); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
40
|
|
8
|
3
|
|
|
3
|
|
13
|
use File::Spec (); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
44
|
|
9
|
3
|
|
|
3
|
|
14
|
use File::Path (); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
42
|
|
10
|
3
|
|
|
3
|
|
12
|
use File::Find (); |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
40
|
|
11
|
3
|
|
|
3
|
|
1099564
|
use Archive::Tar (); |
|
3
|
|
|
|
|
2046366
|
|
|
3
|
|
|
|
|
91
|
|
12
|
3
|
|
|
3
|
|
3322
|
use TAP::Parser (); |
|
3
|
|
|
|
|
155809
|
|
|
3
|
|
|
|
|
73
|
|
13
|
3
|
|
|
3
|
|
2976
|
use YAML::Tiny (); |
|
3
|
|
|
|
|
17453
|
|
|
3
|
|
|
|
|
83
|
|
14
|
3
|
|
|
3
|
|
2598
|
use TAP::Parser::Aggregator (); |
|
3
|
|
|
|
|
20661
|
|
|
3
|
|
|
|
|
273
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 NAME |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
TAP::Harness::Archive - Create an archive of TAP test results |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=cut |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
our $VERSION = '0.18'; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 SYNOPSIS |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
use TAP::Harness::Archive; |
27
|
|
|
|
|
|
|
my $harness = TAP::Harness::Archive->new(\%args); |
28
|
|
|
|
|
|
|
$harness->runtests(@tests); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 DESCRIPTION |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
This module is a direct subclass of L and behaves |
33
|
|
|
|
|
|
|
in exactly the same way except for one detail. In addition to |
34
|
|
|
|
|
|
|
outputting a running progress of the tests and an ending summary |
35
|
|
|
|
|
|
|
it can also capture all of the raw TAP from the individual test |
36
|
|
|
|
|
|
|
files or streams into an archive file (C<.tar> or C<.tar.gz>). |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head1 METHODS |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
All methods are exactly the same as our base L except |
41
|
|
|
|
|
|
|
for the following. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head2 new |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
In addition to the options that L allow to this method, |
46
|
|
|
|
|
|
|
we also allow the following: |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=over |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=item archive |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
This is the name of the archive file to generate. We use L |
53
|
|
|
|
|
|
|
in the background so we only support C<.tar> and C<.tar.gz> archive file |
54
|
|
|
|
|
|
|
formats. This can optionally be an existing directory that will have |
55
|
|
|
|
|
|
|
the TAP archive's contents deposited therein without any file archiving |
56
|
|
|
|
|
|
|
(no L involved). |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=item extra_files |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
This is an array reference to extra files that you want to include in the TAP |
61
|
|
|
|
|
|
|
archive but which are not TAP files themselves. This is useful if you want to |
62
|
|
|
|
|
|
|
include some log files that contain useful information about the test run. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=item extra_properties |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
This is a hash reference of extra properties that you've collected during your |
67
|
|
|
|
|
|
|
test run. Some things you might want to include are the Perl version, the system's |
68
|
|
|
|
|
|
|
architecture, the operating system, etc. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=back |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=cut |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
my (%ARCHIVE_TYPES, @ARCHIVE_EXTENSIONS); |
75
|
|
|
|
|
|
|
BEGIN { |
76
|
3
|
|
|
3
|
|
26
|
%ARCHIVE_TYPES = ( |
77
|
|
|
|
|
|
|
'tar' => 'tar', |
78
|
|
|
|
|
|
|
'tar.gz' => 'tar.gz', |
79
|
|
|
|
|
|
|
'tgz' => 'tar.gz', |
80
|
|
|
|
|
|
|
); |
81
|
3
|
|
|
|
|
10
|
@ARCHIVE_EXTENSIONS = map { ".$_" } keys %ARCHIVE_TYPES; |
|
9
|
|
|
|
|
5243
|
|
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub new { |
85
|
7
|
|
|
7
|
1
|
19864
|
my ($class, $args) = @_; |
86
|
7
|
|
100
|
|
|
40
|
$args ||= {}; |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# these can't be passed on to Test::Harness |
89
|
7
|
|
|
|
|
21
|
my $archive = delete $args->{archive}; |
90
|
7
|
|
|
|
|
26
|
my $extra_files = delete $args->{extra_files}; |
91
|
7
|
|
|
|
|
16
|
my $extra_props = delete $args->{extra_properties}; |
92
|
|
|
|
|
|
|
|
93
|
7
|
100
|
|
|
|
38
|
$class->_croak("You must provide the name of the archive to create!") |
94
|
|
|
|
|
|
|
unless $archive; |
95
|
|
|
|
|
|
|
|
96
|
6
|
|
|
|
|
70
|
my $self = $class->SUPER::new($args); |
97
|
|
|
|
|
|
|
|
98
|
6
|
100
|
|
|
|
74628
|
my $is_directory = -d $archive ? 1 : 0; |
99
|
6
|
100
|
|
|
|
58
|
if ($is_directory) { |
100
|
1
|
|
|
|
|
8
|
$self->{__archive_is_directory} = $is_directory; |
101
|
1
|
|
|
|
|
6
|
$self->{__archive_tempdir} = $archive; |
102
|
|
|
|
|
|
|
} else { |
103
|
5
|
|
|
|
|
47
|
my $format = $class->_get_archive_format_from_filename($archive); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# if it's not a format we understand, or it's not a directory |
106
|
|
|
|
|
|
|
$class->_croak("Archive is not a known format type!") |
107
|
5
|
100
|
66
|
|
|
61
|
unless $format && $ARCHIVE_TYPES{$format}; |
108
|
|
|
|
|
|
|
|
109
|
4
|
|
|
|
|
16
|
$self->{__archive_file} = $archive; |
110
|
4
|
|
|
|
|
10
|
$self->{__archive_format} = $format; |
111
|
4
|
|
|
|
|
26
|
$self->{__archive_tempdir} = File::Temp::tempdir(); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# handle any extra files |
115
|
5
|
100
|
|
|
|
1731
|
if($extra_files) { |
116
|
1
|
50
|
|
|
|
5
|
ref $extra_files eq 'ARRAY' |
117
|
|
|
|
|
|
|
or $class->_croak("extra_files must be an array reference!"); |
118
|
1
|
|
|
|
|
3
|
foreach my $file (@$extra_files) { |
119
|
3
|
50
|
|
|
|
41
|
$class->_croak("extra_file $file does not exist!") unless -e $file; |
120
|
3
|
50
|
|
|
|
37
|
$class->_croak("extra_file $file is not readable!") unless -r $file; |
121
|
|
|
|
|
|
|
} |
122
|
1
|
|
|
|
|
2
|
$self->{__archive_extra_files} = $extra_files; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
5
|
100
|
|
|
|
20
|
if($extra_props) { |
126
|
1
|
50
|
|
|
|
4
|
ref $extra_props eq 'HASH' |
127
|
|
|
|
|
|
|
or $class->_croak("extra_properties must be a hash reference!"); |
128
|
1
|
|
|
|
|
3
|
$self->{__archive_extra_props} = $extra_props; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
5
|
|
|
|
|
23
|
return $self; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub _get_archive_format_from_filename { |
135
|
5
|
|
|
5
|
|
19
|
my ($self, $filename) = @_; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# try to guess it if we don't have one |
138
|
5
|
|
|
|
|
447
|
my (undef, undef, $suffix) = File::Basename::fileparse($filename, @ARCHIVE_EXTENSIONS); |
139
|
5
|
|
|
|
|
23
|
$suffix =~ s/^\.//; |
140
|
5
|
|
|
|
|
63
|
return $ARCHIVE_TYPES{$suffix}; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=head2 runtests |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
Takes the same arguments as L's version and returns the |
146
|
|
|
|
|
|
|
same thing (a L object). The only difference |
147
|
|
|
|
|
|
|
is that in addition to the normal test running and progress output |
148
|
|
|
|
|
|
|
we also create the TAP Archive when it's all done. |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=cut |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub runtests { |
153
|
5
|
|
|
5
|
1
|
67
|
my ($self, @files) = @_; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# tell TAP::Harness to put the raw tap someplace we can find it later |
156
|
5
|
|
|
|
|
20
|
my $dir = $self->{__archive_tempdir}; |
157
|
5
|
|
|
|
|
45
|
$ENV{PERL_TEST_HARNESS_DUMP_TAP} = $dir; |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# get some meta information about this run |
160
|
5
|
|
|
|
|
54
|
my %meta = ( |
161
|
|
|
|
|
|
|
file_order => \@files, |
162
|
|
|
|
|
|
|
start_time => time(), |
163
|
|
|
|
|
|
|
); |
164
|
|
|
|
|
|
|
|
165
|
5
|
|
|
|
|
75
|
my $aggregator = $self->SUPER::runtests(@files); |
166
|
|
|
|
|
|
|
|
167
|
5
|
|
|
|
|
509820
|
$meta{stop_time} = time(); |
168
|
|
|
|
|
|
|
|
169
|
5
|
|
|
|
|
48
|
my @parsers = $aggregator->parsers; |
170
|
5
|
|
|
|
|
124
|
for ( my $i = 0; $i < @parsers; $i++ ) { |
171
|
10
|
|
|
|
|
179
|
$parsers[ $i ] = { |
172
|
|
|
|
|
|
|
start_time => $parsers[ $i ]->start_time, |
173
|
|
|
|
|
|
|
end_time => $parsers[ $i ]->end_time, |
174
|
|
|
|
|
|
|
description => $files[ $i ], |
175
|
|
|
|
|
|
|
}; |
176
|
|
|
|
|
|
|
} |
177
|
5
|
|
|
|
|
97
|
$meta{file_attributes} = \@parsers; |
178
|
|
|
|
|
|
|
|
179
|
5
|
|
|
|
|
72
|
my $cwd = Cwd::getcwd(); |
180
|
5
|
|
|
|
|
20
|
my $is_dir = $self->{__archive_is_directory}; |
181
|
5
|
|
|
|
|
16
|
my ($archive, $output_file); |
182
|
5
|
100
|
|
|
|
34
|
if( $is_dir ) { |
183
|
1
|
|
|
|
|
9
|
$output_file = $self->{__archive_tempdir}; |
184
|
|
|
|
|
|
|
} else { |
185
|
4
|
|
|
|
|
20
|
$output_file = $self->{__archive_file}; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# go into the dir so that we can reference files |
188
|
|
|
|
|
|
|
# relatively and put them in the archive that way |
189
|
4
|
50
|
|
|
|
164
|
chdir($dir) or $self->_croak("Could not change to directory $dir: $!"); |
190
|
|
|
|
|
|
|
|
191
|
4
|
50
|
|
|
|
186
|
unless (File::Spec->file_name_is_absolute($output_file)) { |
192
|
0
|
|
|
|
|
0
|
$output_file = File::Spec->catfile($cwd, $output_file); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# create the archive |
196
|
4
|
|
|
|
|
101
|
$archive = Archive::Tar->new(); |
197
|
4
|
|
|
|
|
132
|
$archive->add_files($self->_get_all_tap_files); |
198
|
4
|
50
|
|
|
|
4566
|
chdir($cwd) or $self->_croak("Could not return to directory $cwd: $!"); |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# add in any extra files |
202
|
5
|
100
|
|
|
|
39
|
if(my $x_files = $self->{__archive_extra_files}) { |
203
|
1
|
|
|
|
|
2
|
my @rel_x_files; |
204
|
1
|
|
|
|
|
8
|
foreach my $x_file (@$x_files) { |
205
|
|
|
|
|
|
|
# handle both relative and absolute file names |
206
|
3
|
|
|
|
|
7
|
my $rel_file; |
207
|
3
|
50
|
|
|
|
26
|
if( File::Spec->file_name_is_absolute($x_file) ) { |
208
|
0
|
|
|
|
|
0
|
$rel_file = File::Spec->abs2rel($x_file, $cwd); |
209
|
|
|
|
|
|
|
} else { |
210
|
3
|
|
|
|
|
6
|
$rel_file = $x_file; |
211
|
|
|
|
|
|
|
} |
212
|
3
|
|
|
|
|
12
|
push(@rel_x_files, $rel_file); |
213
|
|
|
|
|
|
|
} |
214
|
1
|
50
|
|
|
|
19
|
$archive->add_files(@rel_x_files) unless $is_dir; |
215
|
1
|
|
|
|
|
1050
|
$meta{extra_files} = \@rel_x_files; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# add any extra_properties to the meta |
219
|
5
|
100
|
|
|
|
39
|
if(my $extra_props = $self->{__archive_extra_props}) { |
220
|
1
|
|
|
|
|
5
|
$meta{extra_properties} = $extra_props; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# create the YAML meta file |
224
|
5
|
|
|
|
|
107
|
my $yaml = YAML::Tiny->new(); |
225
|
5
|
|
|
|
|
59
|
$yaml->[0] = \%meta; |
226
|
5
|
100
|
|
|
|
29
|
if( $is_dir ) { |
227
|
1
|
|
|
|
|
71
|
my $meta_file = File::Spec->catfile($output_file, 'meta.yml'); |
228
|
1
|
50
|
|
|
|
296
|
open(my $out, '>', $meta_file) or die "Could not create meta.yml: $!"; |
229
|
1
|
|
|
|
|
11
|
print $out $yaml->write_string; |
230
|
1
|
|
|
|
|
1141
|
close($out); |
231
|
|
|
|
|
|
|
} else { |
232
|
4
|
|
|
|
|
47
|
$archive->add_data('meta.yml', $yaml->write_string); |
233
|
4
|
50
|
|
|
|
4689
|
$archive->write($output_file, $self->{__archive_format} eq 'tar.gz') or die $archive->error; |
234
|
|
|
|
|
|
|
# be nice and clean up |
235
|
4
|
|
|
|
|
26388
|
File::Path::rmtree($dir); |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
5
|
50
|
|
|
|
75
|
print "\nTAP Archive created at $output_file\n" unless $self->verbosity < -1; |
239
|
|
|
|
|
|
|
|
240
|
5
|
|
|
|
|
620
|
return $aggregator; |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub _get_all_tap_files { |
244
|
4
|
|
|
4
|
|
13
|
my ($self, $dir, $meta) = @_; |
245
|
4
|
|
33
|
|
|
59
|
$dir ||= $self->{__archive_tempdir}; |
246
|
4
|
|
|
|
|
9
|
my @files; |
247
|
|
|
|
|
|
|
my %x_files; |
248
|
4
|
0
|
33
|
|
|
25
|
if($meta && $meta->{extra_files}) { |
249
|
0
|
|
|
|
|
0
|
%x_files = map { $_ => 1 } @{$meta->{extra_files}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
File::Find::find( |
253
|
|
|
|
|
|
|
{ |
254
|
|
|
|
|
|
|
no_chdir => 1, |
255
|
|
|
|
|
|
|
wanted => sub { |
256
|
16
|
50
|
|
16
|
|
82
|
return if /^\./; |
257
|
16
|
100
|
|
|
|
1375
|
return if -d; |
258
|
8
|
|
|
|
|
936
|
my $rel_name = File::Spec->abs2rel($_, $dir); |
259
|
8
|
50
|
|
|
|
44
|
return if $rel_name eq 'meta.yml'; |
260
|
8
|
50
|
|
|
|
140
|
push(@files, $rel_name) unless $x_files{$rel_name}; |
261
|
|
|
|
|
|
|
}, |
262
|
|
|
|
|
|
|
}, |
263
|
4
|
|
|
|
|
759
|
$dir |
264
|
|
|
|
|
|
|
); |
265
|
4
|
|
|
|
|
80
|
return @files; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head2 aggregator_from_archive |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
This class method will return a L object |
271
|
|
|
|
|
|
|
when given a TAP Archive to open and parse. It's pretty much the reverse |
272
|
|
|
|
|
|
|
of creating a TAP Archive from using C and C. |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
It takes a hash of arguments which are as follows: |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=over |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=item archive |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
The path to the archive file. This can also be a directory if you created |
281
|
|
|
|
|
|
|
the archive as a directory. This is required. |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=item parser_callbacks |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
This is a hash ref containing callbacks for the L objects |
286
|
|
|
|
|
|
|
that are created while parsing the TAP files. See the L |
287
|
|
|
|
|
|
|
documentation for details about these callbacks. |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
=item made_parser_callback |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
This callback is executed every time a new L object |
292
|
|
|
|
|
|
|
is created. It will be passed the new parser object, the name |
293
|
|
|
|
|
|
|
of the file to be parsed, and also the full (temporary) path of that file. |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=item meta_yaml_callback |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
This is a subroutine that will be called if we find and parse a YAML |
298
|
|
|
|
|
|
|
file containing meta information about the test run in the archive. |
299
|
|
|
|
|
|
|
The structure of the YAML file will be passed in as an argument. |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=back |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
my $aggregator = TAP::Harness::Archive->aggregator_from_archive( |
304
|
|
|
|
|
|
|
{ |
305
|
|
|
|
|
|
|
archive => 'my_tests.tar.gz', |
306
|
|
|
|
|
|
|
parser_callbacks => { |
307
|
|
|
|
|
|
|
plan => sub { warn "Nice to see you plan ahead..." }, |
308
|
|
|
|
|
|
|
unknown => sub { warn "Your TAP is bad!" }, |
309
|
|
|
|
|
|
|
}, |
310
|
|
|
|
|
|
|
made_parser_callback => sub { |
311
|
|
|
|
|
|
|
my ($parser, $file, $full_path) = @_; |
312
|
|
|
|
|
|
|
warn "$file is temporarily located at $full_path\n"; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
); |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
=cut |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
sub aggregator_from_archive { |
321
|
5
|
|
|
5
|
1
|
4455
|
my ($class, $args) = @_; |
322
|
5
|
|
|
|
|
17
|
my $meta; |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
my $file = Cwd::abs_path( $args->{archive} ) |
325
|
5
|
50
|
|
|
|
281
|
or $class->_croak("You must provide the path to the archive!"); |
326
|
|
|
|
|
|
|
|
327
|
5
|
|
|
|
|
171
|
my $is_directory = -d $file; |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# extract the files out into a temporary directory |
330
|
5
|
100
|
|
|
|
71
|
my $dir = $is_directory ? $file : File::Temp::tempdir(); |
331
|
5
|
|
|
|
|
1791
|
my $cwd = Cwd::getcwd(); |
332
|
5
|
50
|
|
|
|
80
|
chdir($dir) or $class->_croak("Could not change to directory $dir: $!"); |
333
|
5
|
|
|
|
|
13
|
my @files; |
334
|
|
|
|
|
|
|
|
335
|
5
|
100
|
|
|
|
47
|
Archive::Tar->new()->extract_archive($file) unless $is_directory; |
336
|
5
|
|
|
|
|
124398
|
my @tap_files; |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
# do we have a meta.yml file in the archive? |
339
|
5
|
|
|
|
|
118
|
my $yaml_file = File::Spec->catfile($dir, 'meta.yml'); |
340
|
5
|
50
|
|
|
|
177
|
if( -e $yaml_file) { |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
# parse it into a structure |
343
|
5
|
50
|
|
|
|
125
|
if ($YAML::Tiny::VERSION < 1.57) { |
344
|
0
|
|
|
|
|
0
|
$meta = YAML::Tiny->new()->read($yaml_file); |
345
|
0
|
0
|
|
|
|
0
|
die "Could not read YAML $yaml_file: " . YAML::Tiny->errstr if YAML::Tiny->errstr; |
346
|
|
|
|
|
|
|
} else { |
347
|
5
|
|
|
|
|
28
|
$meta = eval { |
348
|
5
|
|
|
|
|
102
|
YAML::Tiny->new()->read($yaml_file); |
349
|
|
|
|
|
|
|
}; |
350
|
5
|
50
|
|
|
|
238330
|
if ($@) { |
351
|
0
|
|
|
|
|
0
|
die "Could not read YAML $yaml_file: ".$@; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
5
|
50
|
|
|
|
35
|
if($args->{meta_yaml_callback}) { |
356
|
5
|
|
|
|
|
33
|
$args->{meta_yaml_callback}->($meta); |
357
|
|
|
|
|
|
|
} |
358
|
5
|
|
|
|
|
10118
|
$meta = $meta->[0]; |
359
|
|
|
|
|
|
|
|
360
|
5
|
50
|
33
|
|
|
129
|
if($meta->{file_order} && ref $meta->{file_order} eq 'ARRAY') { |
361
|
5
|
|
|
|
|
11
|
foreach my $file (@{$meta->{file_order}}) { |
|
5
|
|
|
|
|
33
|
|
362
|
10
|
50
|
|
|
|
183
|
push(@tap_files, $file) if -e $file; |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
# if we didn't get the files from the YAML file, just find them all |
368
|
5
|
50
|
|
|
|
34
|
unless(@tap_files) { |
369
|
0
|
|
|
|
|
0
|
@tap_files = $class->_get_all_tap_files($dir, $meta); |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# now create the aggregator |
373
|
5
|
|
|
|
|
108
|
my $aggregator = TAP::Parser::Aggregator->new(); |
374
|
5
|
|
|
|
|
490
|
foreach my $tap_file (@tap_files) { |
375
|
10
|
50
|
|
|
|
1242
|
open(my $fh, $tap_file) or die "Could not open $tap_file for reading: $!"; |
376
|
10
|
|
|
|
|
127
|
my $parser = TAP::Parser->new({source => $fh, callbacks => $args->{parser_callbacks}}); |
377
|
10
|
100
|
|
|
|
6380
|
if($args->{made_parser_callback}) { |
378
|
6
|
|
|
|
|
129
|
$args->{made_parser_callback}->($parser, $tap_file, File::Spec->catfile($dir, $tap_file)); |
379
|
|
|
|
|
|
|
} |
380
|
10
|
|
|
|
|
11728
|
$parser->run; |
381
|
10
|
|
|
|
|
16018
|
$aggregator->add($tap_file, $parser); |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
# be nice and clean up |
385
|
5
|
50
|
|
|
|
897
|
chdir($cwd) or $class->_croak("Could not return to directory $cwd: $!"); |
386
|
5
|
100
|
|
|
|
4879
|
File::Path::rmtree($dir) unless $is_directory; |
387
|
|
|
|
|
|
|
|
388
|
5
|
|
|
|
|
101
|
return $aggregator; |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=head1 AUTHOR |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
Michael Peters, C<< >> |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=head1 BUGS |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
398
|
|
|
|
|
|
|
C, or through the web interface at |
399
|
|
|
|
|
|
|
L. |
400
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
401
|
|
|
|
|
|
|
your bug as I make changes. |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
=head1 SUPPORT |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
perldoc TAP::Harness::Archive |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
You can also look for information at: |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
=over 4 |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
L |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
=item * CPAN Ratings |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
L |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
L |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
=item * Search CPAN |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
L |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
=back |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=over |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=item * A big thanks to Plus Three, LP (L) for sponsoring my work on this module and other open source pursuits. |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
=item * Andy Armstrong |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=back |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
Copyright 2007 Michael Peters, all rights reserved. |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
446
|
|
|
|
|
|
|
under the same terms as Perl itself. |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=cut |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
1; # End of TAP::Harness::Archive |