File Coverage

blib/lib/CPAN/Testers/Backend/ProcessReports.pm
Criterion Covered Total %
statement 32 113 28.3
branch 0 12 0.0
condition 0 6 0.0
subroutine 11 15 73.3
pod 4 4 100.0
total 47 150 31.3


line stmt bran cond sub pod time code
1             package CPAN::Testers::Backend::ProcessReports;
2             our $VERSION = '0.003';
3             # ABSTRACT: Process an incoming test report into useful statistics
4              
5             #pod =head1 SYNOPSIS
6             #pod
7             #pod beam run <container> <task> [--force | -f] [<reportid>...]
8             #pod
9             #pod =head1 DESCRIPTION
10             #pod
11             #pod This module is a L<Beam::Runnable> task that reads incoming test reports
12             #pod from testers and produces the basic stats needed for the common
13             #pod reporting on the website and via e-mail. This is the first step in
14             #pod processing test data: All other tasks require this step to be completed.
15             #pod
16             #pod =head1 ARGUMENTS
17             #pod
18             #pod =head2 reportid
19             #pod
20             #pod The IDs of reports to process. If specified, the report will be
21             #pod processed whether or not it was processed already (like C<--force>
22             #pod option).
23             #pod
24             #pod =head1 OPTIONS
25             #pod
26             #pod =head2 --force | -f
27             #pod
28             #pod Force re-processing of all reports. This will process all of the test
29             #pod reports again, so it may be prudent to limit to a set of test reports
30             #pod using the C<reportid> argument.
31             #pod
32             #pod =head1 SEE ALSO
33             #pod
34             #pod L<CPAN::Testers::Backend>, L<CPAN::Testers::Schema>, L<Beam::Runnable>
35             #pod
36             #pod =cut
37              
38 1     1   653713 use v5.24;
  1         4  
39 1     1   4 use warnings;
  1         2  
  1         21  
40 1     1   322 use Moo;
  1         3993  
  1         4  
41 1     1   983 use experimental 'signatures', 'postderef';
  1         2  
  1         7  
42 1     1   479 use Types::Standard qw( Str InstanceOf );
  1         57894  
  1         9  
43 1     1   805 use Log::Any '$LOG';
  1         2  
  1         7  
44             with 'Beam::Runnable';
45 1     1   221 use JSON::MaybeXS qw( decode_json );
  1         3  
  1         59  
46 1     1   447 use Getopt::Long qw( GetOptionsFromArray );
  1         7535  
  1         4  
47              
48             #pod =attr schema
49             #pod
50             #pod A L<CPAN::Testers::Schema> object to access the database.
51             #pod
52             #pod =cut
53              
54             has schema => (
55             is => 'ro',
56             isa => InstanceOf['CPAN::Testers::Schema'],
57             required => 1,
58             );
59              
60             #pod =attr metabase_dbh
61             #pod
62             #pod A L<DBI> object connected to the Metabase cache. This is a legacy database
63             #pod needed for some parts of the web app and backend. When these parts are
64             #pod updated to use the new test reports, we can remove this attribute.
65             #pod
66             #pod =cut
67              
68             has metabase_dbh => (
69             is => 'ro',
70             isa => InstanceOf['DBI::db'],
71             required => 1,
72             );
73              
74             #pod =method run
75             #pod
76             #pod The main method that processes job arguments and performs the task.
77             #pod Called by L<Beam::Runner> or L<Beam::Minion>.
78             #pod
79             #pod =cut
80              
81 0     0 1   sub run( $self, @args ) {
  0            
  0            
  0            
82 0           GetOptionsFromArray(
83             \@args, \my %opt,
84             'force|f',
85             );
86              
87 0           my @reports;
88 0 0 0       if ( $opt{force} && !@args ) {
    0          
89 0           $LOG->info( '--force and no IDs specified: Re-processing all reports' );
90 0           @reports = $self->find_reports;
91             }
92             elsif ( @args ) {
93 0           $LOG->info( 'Processing ' . @args . ' reports from command-line' );
94 0           @reports = $self->find_reports( @args );
95             }
96             else {
97 0           $LOG->info( 'Processing all unprocessed reports' );
98 0           @reports = $self->find_unprocessed_reports;
99 0           $LOG->info('Found ' . @reports . ' unprocessed report(s)');
100             }
101              
102 0           my $stats = $self->schema->resultset('Stats');
103 0           my $skipped = 0;
104              
105 0           for my $report (@reports) {
106 0           local $@;
107 0           my $stat;
108 0           my $success = eval { $stat = $stats->insert_test_report($report); 1 };
  0            
  0            
109 0 0         unless ($success) {
110 0           my $guid = $report->id;
111 0           $LOG->warn("Unable to process report GUID $guid. Skipping.");
112 0           $LOG->debug("Error: $@");
113 0           $skipped++;
114 0           next;
115             }
116 0           $self->write_metabase_cache( $report, $stat );
117             }
118              
119 0 0         $LOG->info("Skipped $skipped unprocessed report(s)") if $skipped;
120             }
121              
122             #pod =method find_unprocessed_reports
123             #pod
124             #pod Returns a list of L<CPAN::Testers::Schema::Result::TestReport>
125             #pod objects for reports that are not in the cpanstats table.
126             #pod
127             #pod =cut
128              
129 0     0 1   sub find_unprocessed_reports( $self ) {
  0            
  0            
130 0           my $schema = $self->schema;
131 0           my $stats = $schema->resultset('Stats');
132 0           my $reports = $schema->resultset('TestReport')->search({
133             id => {
134             -not_in => $stats->get_column('guid')->as_query,
135             },
136             report => \[ "->> '\$.environment.language.name'=?", 'Perl 5' ],
137             });
138 0           return $reports->all;
139             }
140              
141             #pod =method find_reports
142             #pod
143             #pod @reports = $self->find_reports;
144             #pod @reports = $self->find_reports( @ids );
145             #pod
146             #pod Find all the test reports to be processed by this module, optionally
147             #pod limited only to the IDs passed-in. Returns a list of
148             #pod L<CPAN::Testers::Schema::Result::TestReport> objects.
149             #pod
150             #pod =cut
151              
152 0     0 1   sub find_reports( $self, @ids ) {
  0            
  0            
  0            
153 0           my $reports = $self->schema->resultset( 'TestReport' )->search({
154             report => \[ "->> '\$.environment.language.name'=?", 'Perl 5' ],
155             });
156 0 0         if ( @ids ) {
157 0           $reports = $reports->search({
158             id => {
159             -in => \@ids,
160             },
161             });
162             }
163 0           return $reports->all;
164             }
165              
166             #pod =method write_metabase_cache
167             #pod
168             #pod $self->write_metabase_cache( $report_row, $stat_row );
169             #pod
170             #pod Write the report to the legacy metabase cache. This cache is used for
171             #pod some of the web apps and some of the backend processes. Until those
172             #pod processes are changed to use the new test report format, we need to
173             #pod maintain the old metabase cache.
174             #pod
175             #pod Once the legacy metabase cache is removed, this method can be removed
176             #pod
177             #pod =cut
178              
179 0     0 1   sub write_metabase_cache( $self, $report_row, $stat_row ) {
  0            
  0            
  0            
  0            
180 0           my $guid = $report_row->id;
181 0           my $id = $stat_row->id;
182 0           my $created_epoch = $report_row->created->epoch;
183 0           my $report = $report_row->report;
184              
185 0           my $distname = $report->{distribution}{name};
186 0           my $distversion = $report->{distribution}{version};
187              
188 0           my $upload_row = $self->schema->resultset( 'Upload' )->search({
189             dist => $distname,
190             version => $distversion,
191             })->first;
192 0           my $author = $upload_row->author;
193 0           my $distfile = sprintf '%s/%s-%s.tar.gz', $author, $distname, $distversion;
194              
195             my %report = (
196             grade => $report->{result}{grade},
197             osname => $report->{environment}{system}{osname},
198             osversion => $report->{environment}{system}{osversion},
199             archname => $report->{environment}{language}{archname},
200             perl_version => $report->{environment}{language}{version},
201             textreport => (
202             $report->{result}{output}{uncategorized} ||
203 0   0       join "\n\n", grep defined, $report->{result}{output}->@{qw( configure build test install )},
204             ),
205             );
206              
207             # These imports are here so they can be easily removed later
208 1     1   1013 use Metabase::User::Profile;
  1         9847  
  1         129  
209             my %creator = (
210             full_name => $report->{reporter}{name},
211             email_address => $report->{reporter}{email},
212 0           );
213 0           my $creator;
214             my ( $creator_row ) = $self->metabase_dbh->selectall_array(
215             'SELECT * FROM testers_email WHERE email=?',
216             { Slice => {} },
217             $creator{email_address},
218 0           );
219 0 0         if ( !$creator_row ) {
220 0           $creator = Metabase::User::Profile->create( %creator );
221             $self->metabase_dbh->do(
222             'INSERT INTO testers_email ( resource, fullname, email ) VALUES ( ?, ?, ? )',
223             {},
224             $creator->core_metadata->{resource},
225             $creator{ full_name },
226             $creator{ email_address },
227 0           );
228             }
229              
230 1     1   231 use CPAN::Testers::Report;
  1         5504  
  1         126  
231             my $metabase_report = CPAN::Testers::Report->open(
232             resource => 'cpan:///distfile/' . $distfile,
233             creator => $creator_row->{resource},
234 0           );
235 0           $metabase_report->add( 'CPAN::Testers::Fact::LegacyReport' => \%report);
236 0           $metabase_report->add( 'CPAN::Testers::Fact::TestSummary' =>
237             [$metabase_report->facts]->[0]->content_metadata()
238             );
239 0           $metabase_report->close();
240              
241             # Encode it to JSON
242 0           my %facts;
243 0           for my $fact ( $metabase_report->facts ) {
244 0           my $name = ref $fact;
245 0           $facts{ $name } = $fact->as_struct;
246 0           $facts{ $name }{ content } = decode_json( $facts{ $name }{ content } );
247             }
248              
249             # Serialize it to compress it using Data::FlexSerializer
250             # "report" gets serialized with JSON
251 1     1   331 use Data::FlexSerializer;
  1         1380292  
  1         27  
252 0           my $json_zipper = Data::FlexSerializer->new(
253             detect_compression => 1,
254             detect_json => 1,
255             output_format => 'json'
256             );
257 0           my $report_zip = $json_zipper->serialize( \%facts );
258              
259             # "fact" gets serialized with Sereal
260 0           my $sereal_zipper = Data::FlexSerializer->new(
261             detect_compression => 1,
262             detect_sereal => 1,
263             output_format => 'sereal'
264             );
265 0           my $fact_zip = $sereal_zipper->serialize( $metabase_report );
266              
267 0           $self->metabase_dbh->do(
268             'REPLACE INTO metabase (guid,id,updated,report,fact) VALUES (?,?,?,?,?)',
269             {},
270             $guid, $id, $created_epoch, $report_zip, $fact_zip,
271             );
272              
273 0           return;
274             }
275              
276             1;
277              
278             __END__
279              
280             =pod
281              
282             =head1 NAME
283              
284             CPAN::Testers::Backend::ProcessReports - Process an incoming test report into useful statistics
285              
286             =head1 VERSION
287              
288             version 0.003
289              
290             =head1 SYNOPSIS
291              
292             beam run <container> <task> [--force | -f] [<reportid>...]
293              
294             =head1 DESCRIPTION
295              
296             This module is a L<Beam::Runnable> task that reads incoming test reports
297             from testers and produces the basic stats needed for the common
298             reporting on the website and via e-mail. This is the first step in
299             processing test data: All other tasks require this step to be completed.
300              
301             =head1 ATTRIBUTES
302              
303             =head2 schema
304              
305             A L<CPAN::Testers::Schema> object to access the database.
306              
307             =head2 metabase_dbh
308              
309             A L<DBI> object connected to the Metabase cache. This is a legacy database
310             needed for some parts of the web app and backend. When these parts are
311             updated to use the new test reports, we can remove this attribute.
312              
313             =head1 METHODS
314              
315             =head2 run
316              
317             The main method that processes job arguments and performs the task.
318             Called by L<Beam::Runner> or L<Beam::Minion>.
319              
320             =head2 find_unprocessed_reports
321              
322             Returns a list of L<CPAN::Testers::Schema::Result::TestReport>
323             objects for reports that are not in the cpanstats table.
324              
325             =head2 find_reports
326              
327             @reports = $self->find_reports;
328             @reports = $self->find_reports( @ids );
329              
330             Find all the test reports to be processed by this module, optionally
331             limited only to the IDs passed-in. Returns a list of
332             L<CPAN::Testers::Schema::Result::TestReport> objects.
333              
334             =head2 write_metabase_cache
335              
336             $self->write_metabase_cache( $report_row, $stat_row );
337              
338             Write the report to the legacy metabase cache. This cache is used for
339             some of the web apps and some of the backend processes. Until those
340             processes are changed to use the new test report format, we need to
341             maintain the old metabase cache.
342              
343             Once the legacy metabase cache is removed, this method can be removed
344              
345             =head1 ARGUMENTS
346              
347             =head2 reportid
348              
349             The IDs of reports to process. If specified, the report will be
350             processed whether or not it was processed already (like C<--force>
351             option).
352              
353             =head1 OPTIONS
354              
355             =head2 --force | -f
356              
357             Force re-processing of all reports. This will process all of the test
358             reports again, so it may be prudent to limit to a set of test reports
359             using the C<reportid> argument.
360              
361             =head1 SEE ALSO
362              
363             L<CPAN::Testers::Backend>, L<CPAN::Testers::Schema>, L<Beam::Runnable>
364              
365             =head1 AUTHOR
366              
367             Doug Bell <preaction@cpan.org>
368              
369             =head1 COPYRIGHT AND LICENSE
370              
371             This software is copyright (c) 2017 by Doug Bell.
372              
373             This is free software; you can redistribute it and/or modify it under
374             the same terms as the Perl 5 programming language system itself.
375              
376             =cut