File Coverage

blib/lib/CPAN/cpanminus/reporter/RetainReports.pm
Criterion Covered Total %
statement 69 78 88.4
branch 15 36 41.6
condition 3 7 42.8
subroutine 16 16 100.0
pod 3 6 50.0
total 106 143 74.1


line stmt bran cond sub pod time code
1             package CPAN::cpanminus::reporter::RetainReports;
2 4     4   484936 use strict;
  4         43  
  4         130  
3 4     4   24 use warnings;
  4         7  
  4         106  
4 4     4   55 use 5.10.1;
  4         16  
5 4     4   26 use parent ('App::cpanminus::reporter');
  4         9  
  4         25  
6             our $VERSION = '0.10_001';
7 4     4   1023635 use Carp;
  4         10  
  4         247  
8 4     4   27 use File::Path qw( make_path );
  4         12  
  4         209  
9 4     4   32 use File::Spec;
  4         12  
  4         91  
10 4     4   726 use JSON;
  4         11725  
  4         41  
11 4     4   607 use URI;
  4         14  
  4         89  
12 4     4   1880 use CPAN::DistnameInfo;
  4         3936  
  4         3305  
13             #use Data::Dump qw( dd pp );
14              
15             =head1 NAME
16              
17             CPAN::cpanminus::reporter::RetainReports - Retain reports on disk rather than transmitting them
18              
19             =head1 SYNOPSIS
20              
21             use CPAN::cpanminus::reporter::RetainReports;
22              
23             my $cpanmdir = '/home/username/.cpanm';
24             my $log = "$cpanmdir/build.log";
25             local $ENV{PERL_CPANM_HOME} = $cpanmdir;
26             local $ENV{PERL_CPAN_REPORTER_DIR} = '/home/username/.cpanreporter';
27              
28             my $reporter = CPAN::cpanminus::reporter::RetainReports->new(
29             force => 1, # ignore mtime check on cpanm build.log
30             build_dir => $cpanmdir,
31             build_logfile => $log,
32             'ignore-versions' => 1,
33             );
34              
35             my $analysisdir = '/home/username/bbc/testing/results/perl-5.27.0';
36             $reporter->set_report_dir($analysisdir);
37             $reporter->run;
38              
39             =head1 DESCRIPTION
40              
41             This library parses the output of a F generated by running
42             L and
43             writes the output of that parsing to disk for later analysis or processing.
44              
45             This is B code; the API is subject to change.
46              
47             =head2 Rationale: Who Should Use This Library?
48              
49             This library is a subclass of Breno G. de Oliveira's CPAN library
50             L.
51             That library provides the utility program
52             F
53             a way to generate and transmit CPANtesters reports after using Tatsuhiko
54             Miyagawa's
55             L
56             utility to install libraries from CPAN.
57              
58             Like similar test reporting methodologies, F does not
59             retain test reports on disk once they have been transmitted to
60             L. Whether a particular module passed
61             or failed its tests is very quickly reported to
62             L and, after a lag, the complete report
63             is posted to L. That works fine under normal
64             circumstances, but if there are any technical problems with those websites the
65             person who ran the tests originally has no easy access to reports --
66             particularly to reports of failures. Quick access to reports of test failures
67             is particularly valuable when testing a library against specific commits to
68             the Perl 5 core distribution and against Perl's monthly development releases.
69              
70             This library is intended to provide at least a partial solution to that
71             problem. It is intended for use by at least three different kinds of users:
72              
73             =over 4
74              
75             =item * People working on the Perl 5 core distribution or the Perl toolchain
76              
77             These individuals (commonly known as the Perl 5 Porters (P5P) and the Perl
78             Toolchain Gang) often want to know the impact on the most commonly used CPAN
79             libraries of (a) a particular commit to Perl 5's master development branch
80             (known as I) or some other branch in the repository; or (b) a monthly
81             development release of F (5.27.1, 5.27.2, etc.). After installing
82             blead, a branch or a monthly dev release, they often want to install hundreds
83             of modules at a time and inspect the results for breakage.
84              
85             =item * CPAN library authors and maintainers
86              
87             A diligent CPAN maintainer pays attention to whether her libraries are
88             building and testing properly against Perl 5 blead. Such a maintainer can use
89             this library to get reports more quickly than waiting upon CPANtesters.
90              
91             =item * People maintaining lists of CPAN libraries which they customarily install with F
92              
93             Organizations which use many CPAN libraries in their production tend to keep a
94             curated list of them, often in a format like
95             L.
96             Those organizations can use this library to assess the impact of changes in
97             blead or a branch or of a monthly dev release on such a list.
98              
99             =back
100              
101             =head1 METHODS
102              
103             =head2 C
104              
105             =over 4
106              
107             =item * Purpose
108              
109             F constructor.
110              
111             =item * Arguments
112              
113             my $reporter = CPAN::cpanminus::reporter::RetainReports->new(
114             force => 1,
115             build_dir => $cpanmdir,
116             build_logfile => $log,
117             'ignore-versions' => 1,
118             );
119              
120             Takes a list of key-value pairs or hash. Keys may be any eligible for passing
121             to C. Those shown have proven to be useful
122             for this library's author.
123              
124             =item * Return Value
125              
126             F object.
127              
128             =item * Comments
129              
130             =over 4
131              
132             =item * Inherited from F.
133              
134             =item * Environmental Variables
135              
136             At this time it is thought that these two environmental variables should be
137             explicitly set if either the F<.cpanm> or the F<.cpanreporter> directory is in a
138             non-standard location, I in a location other than directly under the
139             user's home directory.
140              
141             local $ENV{PERL_CPANM_HOME} = '/home/username/.cpanm';
142             local $ENV{PERL_CPAN_REPORTER_DIR} = '/home/username/.cpanreporter';
143              
144             =back
145              
146             =back
147              
148             =head2 C
149              
150             =over 4
151              
152             =item * Purpose
153              
154             Identify the directory to which reports will be written, creating it if needed.
155              
156             =item * Arguments
157              
158             $reporter->set_report_dir($analysisdir);
159              
160             String holding path to desired directory.
161              
162             =item * Return Value
163              
164             String holding path to desired directory.
165              
166             =back
167              
168             =cut
169              
170             sub set_report_dir {
171 18     18 1 315994 my ($self, $dir) = @_;
172 18 50       223 unless (-d $dir) {
173 0 0       0 make_path($dir, { mode => 0711 }) or croak "Unable to create $dir";
174             }
175 18         168 $self->{report_dir} = $dir;
176             }
177              
178             =head2 C
179              
180             =over 4
181              
182             =item * Purpose
183              
184             Identify the already created directory in which reports will be ridden.
185              
186             =item * Arguments
187              
188             $self->get_report_dir();
189              
190             None.
191              
192             =item * Return Value
193              
194             String holding path to relevant directory.
195              
196             =back
197              
198             =cut
199              
200             sub get_report_dir {
201 229     229 1 1042 my $self = shift;
202 229         546 return $self->{report_dir};
203             }
204              
205             =head2 C
206              
207             =over 4
208              
209             =item * Purpose
210              
211             While parsing a build log, parse a URI.
212              
213             =item * Arguments
214              
215             $self->parse_uri("http://www.cpan.org/authors/id/J/JK/JKEENAN/Perl-Download-FTP-0.02.tar.gz");
216              
217             String holding a URI such as the one above.
218              
219             =item * Return Value
220              
221             True value upon success; C otherwise.
222              
223             =item * Comments
224              
225             =over 4
226              
227             =item * Stores the following attributes for a given CPAN distribution:
228              
229             distname => 'Perl-Download-FTP'
230             distversion => '0.02'
231             distfile => 'JKEENAN/Perl-Download-FTP-0.02.tar.gz'
232             author => 'JKEENAN'
233              
234             These attributes can subsequently be accessed via:
235              
236             $self->distname();
237             $self->distversion();
238             $self->distfile();
239             $self->author();
240              
241             =item * Limited to parsing these URI schemes:
242              
243             http https ftp cpan file
244              
245             =item * Overwrites C.
246              
247             =back
248              
249             =back
250              
251             =cut
252              
253             sub parse_uri {
254 230     230 1 10741 my ($self, $resource) = @_;
255              
256 230         1328 my $d = CPAN::DistnameInfo->new($resource);
257 230         17868 $self->distversion($d->version);
258 230         679 $self->distname($d->dist);
259              
260 230         1173 my $uri = URI->new( $resource );
261 230         50147 my $scheme = lc $uri->scheme;
262 230         4031 my %eligible_schemes = map {$_ => 1} (qw| http https ftp cpan file |);
  1150         2875  
263 230 50       786 if (! $eligible_schemes{$scheme}) {
264 0 0       0 print "invalid scheme '$scheme' for resource '$resource'. Skipping...\n"
265             unless $self->quiet;
266 0         0 return;
267             }
268              
269 230         728 my $author = $self->get_author( $uri );
270 230 50       119904 unless (defined $author) {
271 0 0       0 print "error fetching author for resource '$resource'. Skipping...\n"
272             unless $self->quiet;
273 0         0 return;
274             }
275              
276             # the 'LOCAL' user is reserved and should never send reports.
277 230 50       640 if ($author eq 'LOCAL') {
278 0 0       0 print "'LOCAL' user is reserved. Skipping resource '$resource'\n"
279             unless $self->quiet;
280 0         0 return;
281             }
282              
283 230         825 $self->author($author);
284              
285             # If $author eq '', then distfile will be set to $uri.
286 230         1929 $self->distfile(substr("$uri", index("$uri", $author)));
287              
288 230         4868 return 1;
289             }
290              
291             sub distversion {
292 460     460 0 1726 my ($self, $distversion) = @_;
293 460 100       1181 $self->{_distversion} = $distversion if $distversion;
294 460         1359 return $self->{_distversion};
295             }
296              
297             sub distname {
298 460     460 0 2459 my ($self, $distname) = @_;
299 460 100       1170 $self->{_distname} = $distname if $distname;
300 460         8976 return $self->{_distname};
301             }
302              
303             =head2 C
304              
305             =over 4
306              
307             =item * Purpose
308              
309             Execute a run of processing of a F build log.
310              
311             =item * Arguments
312              
313             None.
314              
315             =item * Return Value
316              
317             None relevant.
318              
319             =item * Comments
320              
321             =over 4
322              
323             =item *
324              
325             See the F directory for sample reports.
326              
327             =item *
328              
329             Inherited from C. However, whereas that library's
330             method composes and transmits a report to L, this library's
331             C method generates a F<.json> report file for each distribution
332             analyzed and retains that on disk for subsequent processing or analysis. As
333             such, this is the crucial difference between this library and
334             F.
335              
336             =item *
337              
338             In a later version of this library we will provide a more human-friendly,
339             plain-text version of the report.
340              
341             =back
342              
343             =back
344              
345             =cut
346              
347             sub make_report {
348 228     228 0 335646 my ($self, $resource, $dist, $result, @test_output) = @_;
349              
350 228 50       865 if ( index($dist, 'Local-') == 0 ) {
351 0 0       0 print "'Local::' namespace is reserved. Skipping resource '$resource'\n"
352             unless $self->quiet;
353 0         0 return;
354             }
355 228 50       670 return unless $self->parse_uri($resource);
356              
357 228         640 my $author = $self->author;
358              
359 228   50     1661 my $cpanm_version = $self->{_cpanminus_version} || 'unknown cpanm version';
360 228         600 my $meta = $self->get_meta_for( $dist );
361             my %CTCC_args = (
362             author => $self->author || '',
363             distname => $dist, # string like: Mason-Tidy-2.57
364             grade => $result,
365             via => "App::cpanminus::reporter $App::cpanminus::reporter::VERSION ($cpanm_version)",
366             test_output => join( '', @test_output ),
367             prereqs => ($meta && ref $meta) ? $meta->{prereqs} : undef,
368 228 50 50     19309 );
      33        
369 228         6183 my $tdir = $self->get_report_dir();
370 228 50       2974 croak "Could not locate $tdir" unless (-d $tdir);
371 228 50       1161 my $report = (length $author)
372             ? File::Spec->catfile($tdir, join('.' => $self->author, $dist, 'log', 'json'))
373             : File::Spec->catfile($tdir, join('.' => $dist, 'log', 'json'));
374 228 50       21287 open my $OUT, '>', $report or croak "Unable to open $report for writing";
375 228         1693 say $OUT encode_json( {
376             %CTCC_args,
377             'distversion' => $self->distversion,
378             'dist' => $self->distname, # string like: Mason-Tidy
379             } );
380 228 50       9914 close $OUT or croak "Unable to close $report after writing";
381              
382 228         2859 return;
383             }
384              
385              
386             =head1 BUGS AND SUPPORT
387              
388             Please report any bugs by mail to C
389             or through the web interface at L.
390              
391             =head1 AUTHOR
392              
393             James E Keenan
394             CPAN ID: JKEENAN
395             jkeenan@cpan.org
396             http://thenceforward.net/perl/modules/CPAN-cpanminus-reporter-RetainReports
397              
398             =head1 COPYRIGHT
399              
400             This program is free software; you can redistribute
401             it and/or modify it under the same terms as Perl itself.
402              
403             The full text of the license can be found in the
404             LICENSE file included with this module.
405              
406             =head1 SEE ALSO
407              
408             perl(1). cpanm(1). cpanm-reporter(1). App::cpanminus(3). App::cpanminus::reporter(3).
409              
410             =cut
411              
412             1;
413