line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::Run::Plugin::TrimDisplayedFilenames; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
1085702
|
use warnings; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
61
|
|
4
|
2
|
|
|
2
|
|
10
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
55
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
42
|
use 5.008; |
|
2
|
|
|
|
|
11
|
|
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
451
|
use Moose; |
|
2
|
|
|
|
|
389193
|
|
|
2
|
|
|
|
|
13
|
|
9
|
|
|
|
|
|
|
|
10
|
2
|
|
|
2
|
|
12627
|
use MRO::Compat; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
32
|
|
11
|
2
|
|
|
2
|
|
28
|
use File::Spec; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
28
|
|
12
|
2
|
|
|
2
|
|
24
|
use File::Basename; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
151
|
|
13
|
2
|
|
|
2
|
|
625
|
use List::MoreUtils (); |
|
2
|
|
|
|
|
6598
|
|
|
2
|
|
|
|
|
1066
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
extends ('Test::Run::Base'); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 NAME |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Test::Run::Plugin::TrimDisplayedFilenames - trim the first components |
20
|
|
|
|
|
|
|
of the displayed filename to deal with excessively long ones. |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 VERSION |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Version 0.0125 |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=cut |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
our $VERSION = '0.0125'; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
has 'trim_displayed_filenames_query' => (is => "rw", isa => "Str"); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub _process_filename_dirs |
34
|
|
|
|
|
|
|
{ |
35
|
8
|
|
|
8
|
|
24
|
my ($self, $fn, $callback) = @_; |
36
|
|
|
|
|
|
|
|
37
|
8
|
|
|
|
|
315
|
my $basename = basename($fn); |
38
|
8
|
|
|
|
|
178
|
my $dirpath = dirname($fn); |
39
|
|
|
|
|
|
|
|
40
|
8
|
|
|
|
|
64
|
my ($volume, $directories, $filename) = File::Spec->splitpath($dirpath, 1); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# The actual manipulation. |
43
|
8
|
|
|
|
|
60
|
my $dirs = $callback->([File::Spec->splitdir($directories)]); |
44
|
|
|
|
|
|
|
|
45
|
8
|
|
|
|
|
75
|
my $final_dir = |
46
|
|
|
|
|
|
|
File::Spec->catpath( |
47
|
|
|
|
|
|
|
$volume, File::Spec->catdir(@$dirs), $filename |
48
|
|
|
|
|
|
|
); |
49
|
|
|
|
|
|
|
|
50
|
8
|
50
|
|
|
|
26
|
if ($final_dir eq "") |
51
|
|
|
|
|
|
|
{ |
52
|
8
|
|
|
|
|
268
|
return $basename; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
else |
55
|
|
|
|
|
|
|
{ |
56
|
0
|
|
|
|
|
0
|
return File::Spec->catfile( |
57
|
|
|
|
|
|
|
$final_dir, $basename |
58
|
|
|
|
|
|
|
); |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub _get_search_from_callback |
63
|
|
|
|
|
|
|
{ |
64
|
6
|
|
|
6
|
|
14
|
my ($self, $options) = @_; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
return |
67
|
6
|
50
|
|
|
|
44
|
+($options->{search_from} eq "start") |
68
|
|
|
|
|
|
|
? \&List::MoreUtils::firstidx |
69
|
|
|
|
|
|
|
: \&List::MoreUtils::lasttidx |
70
|
|
|
|
|
|
|
; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub _get_array_portion |
74
|
|
|
|
|
|
|
{ |
75
|
6
|
|
|
6
|
|
19
|
my ($self, $options, $dirs, $idx) = @_; |
76
|
|
|
|
|
|
|
|
77
|
6
|
|
|
|
|
32
|
my @copy = @$dirs; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
return |
80
|
|
|
|
|
|
|
[ |
81
|
6
|
50
|
|
|
|
32
|
+($options->{keep_from} eq "start") |
82
|
|
|
|
|
|
|
? splice(@copy, 0, $idx) |
83
|
|
|
|
|
|
|
: splice(@copy, $idx+1) |
84
|
|
|
|
|
|
|
]; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub _trim_filename_dir_components |
88
|
|
|
|
|
|
|
{ |
89
|
6
|
|
|
6
|
|
21
|
my ($self, $filename, $component_callback, $options) = @_; |
90
|
|
|
|
|
|
|
|
91
|
6
|
|
50
|
|
|
22
|
$options ||= { 'search_from' => "start", 'keep_from' => "end" }; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
return $self->_process_filename_dirs( |
94
|
|
|
|
|
|
|
$filename, |
95
|
|
|
|
|
|
|
sub { |
96
|
6
|
|
|
6
|
|
15
|
my $dirs = shift; |
97
|
|
|
|
|
|
|
|
98
|
6
|
|
|
|
|
22
|
my $idx = |
99
|
|
|
|
|
|
|
$self->_get_search_from_callback($options) |
100
|
|
|
|
|
|
|
->($component_callback, @$dirs) |
101
|
|
|
|
|
|
|
; |
102
|
|
|
|
|
|
|
|
103
|
6
|
50
|
|
|
|
38
|
if (!defined($idx)) |
104
|
|
|
|
|
|
|
{ |
105
|
0
|
|
|
|
|
0
|
return $dirs |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
6
|
|
|
|
|
24
|
return $self->_get_array_portion($options, $dirs, $idx); |
109
|
|
|
|
|
|
|
}, |
110
|
6
|
|
|
|
|
41
|
); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub _process_output_leader_fn |
114
|
|
|
|
|
|
|
{ |
115
|
8
|
|
|
8
|
|
25
|
my ($self, $fn) = @_; |
116
|
|
|
|
|
|
|
|
117
|
8
|
|
|
|
|
311
|
my $query = $self->trim_displayed_filenames_query(); |
118
|
|
|
|
|
|
|
|
119
|
8
|
50
|
|
|
|
30
|
if (!defined($query)) |
120
|
|
|
|
|
|
|
{ |
121
|
0
|
|
|
|
|
0
|
return $fn; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
8
|
50
|
|
|
|
52
|
if ($query =~ m{\A(fromre|keep):(.*)}ms) |
125
|
|
|
|
|
|
|
{ |
126
|
8
|
|
|
|
|
31
|
my ($cmd, $arg) = ($1, $2); |
127
|
|
|
|
|
|
|
|
128
|
8
|
100
|
|
|
|
26
|
if ($cmd eq "fromre") |
129
|
|
|
|
|
|
|
{ |
130
|
6
|
|
|
|
|
113
|
my $re = qr{$arg}; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
return |
133
|
|
|
|
|
|
|
$self->_trim_filename_dir_components( |
134
|
|
|
|
|
|
|
$fn, |
135
|
18
|
|
|
18
|
|
215
|
sub { $_ =~ m{$re} }, |
136
|
6
|
|
|
|
|
60
|
+{ search_from => "start", keep_from => "end" } |
137
|
|
|
|
|
|
|
); |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
else # $cmd eq "keep" |
140
|
|
|
|
|
|
|
{ |
141
|
|
|
|
|
|
|
# We need to decrement 1 because there's also the filename. |
142
|
2
|
|
|
|
|
7
|
my $num_keep = int($arg); |
143
|
|
|
|
|
|
|
return |
144
|
|
|
|
|
|
|
$self->_process_filename_dirs( |
145
|
|
|
|
|
|
|
$fn, |
146
|
|
|
|
|
|
|
sub { |
147
|
2
|
|
|
2
|
|
8
|
my @dirs = @{shift()}; |
|
2
|
|
|
|
|
8
|
|
148
|
|
|
|
|
|
|
return |
149
|
2
|
50
|
|
|
|
10
|
+($num_keep <= 1) |
150
|
|
|
|
|
|
|
? [] |
151
|
|
|
|
|
|
|
: [splice(@dirs, -($num_keep-1))] |
152
|
|
|
|
|
|
|
; |
153
|
|
|
|
|
|
|
}, |
154
|
2
|
|
|
|
|
15
|
); |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
else |
158
|
|
|
|
|
|
|
{ |
159
|
|
|
|
|
|
|
# TODO - Replace with an exception object. |
160
|
0
|
|
|
|
|
0
|
die "Unrecognized trim_displayed_filename_query." |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub _calc_test_file_data_display_path |
165
|
|
|
|
|
|
|
{ |
166
|
8
|
|
|
8
|
|
790277
|
my ($self, $idx, $test_file) = @_; |
167
|
|
|
|
|
|
|
|
168
|
8
|
|
|
|
|
36
|
return $self->_process_output_leader_fn($test_file); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head1 SYNOPSIS |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
package MyTestRun; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
use Moose; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
extends('Test::Run::Plugin::TrimDisplayedFilenames'); |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head1 FUNCTIONS |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=cut |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head1 AUTHOR |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Shlomi Fish, C<< <shlomif at cpan.org> >> |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head1 BUGS |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
190
|
|
|
|
|
|
|
C<bug-test-run-plugin-alternateinterpreters at rt.cpan.org>, or through the web interface at |
191
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test::Run::Plugin::TrimDisplayedFilenames>. |
192
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
193
|
|
|
|
|
|
|
your bug as I make changes. |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=head1 SUPPORT |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
perldoc Test::Run::Plugin::TrimDisplayedFilenames |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
You can also look for information at: |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=over 4 |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
L<http://annocpan.org/dist/Test::Run::Plugin::TrimDisplayedFilenames> |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=item * CPAN Ratings |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/Test::Run::Plugin::TrimDisplayedFilenames> |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test::Run::Plugin::TrimDisplayedFilenames> |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=item * MetaCPAN |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
L<http://metacpan.org/release/Test-Run-Plugin-TrimDisplayedFilenames> |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=back |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
Curtis "Ovid" Poe ( L<http://search.cpan.org/~ovid/> ) who gave the idea |
226
|
|
|
|
|
|
|
of testing several tests from several interpreters in one go here: |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
L<http://use.perl.org/~Ovid/journal/32092> |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head1 SEE ALSO |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
L<Test::Run>, L<Test::Run::CmdLine>, L<TAP::Parser>, |
233
|
|
|
|
|
|
|
L<Test::Run::CmdLine::Plugin::TrimDisplayedFilenames> |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
Copyright 2007 Shlomi Fish, all rights reserved. |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
This program is released under the following license: MIT X11. |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=cut |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
1; # End of Test::Run::Plugin::TrimDisplayedFilenames |