File Coverage

blib/lib/Test/Run/Plugin/TrimDisplayedFilenames.pm
Criterion Covered Total %
statement 59 63 93.6
branch 9 16 56.2
condition 1 2 50.0
subroutine 17 17 100.0
pod n/a
total 86 98 87.7


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