File Coverage

blib/lib/CPAN/Testers/Schema/ResultSet/Stats.pm
Criterion Covered Total %
statement 42 43 97.6
branch 8 10 80.0
condition n/a
subroutine 7 7 100.0
pod 3 3 100.0
total 60 63 95.2


line stmt bran cond sub pod time code
1 13     13   15478 use utf8;
  13         32  
  13         84  
2             package CPAN::Testers::Schema::ResultSet::Stats;
3             our $VERSION = '0.024';
4             # ABSTRACT: Query the raw test reports
5              
6             #pod =head1 SYNOPSIS
7             #pod
8             #pod my $rs = $schema->resultset( 'Stats' );
9             #pod $rs->insert_test_report( $schema->resultset( 'TestReport' )->first );
10             #pod
11             #pod =head1 DESCRIPTION
12             #pod
13             #pod This object helps to insert and query the legacy test reports (cpanstats).
14             #pod
15             #pod =head1 SEE ALSO
16             #pod
17             #pod L<CPAN::Testers::Schema::Result::Stats>, L<DBIx::Class::ResultSet>,
18             #pod L<CPAN::Testers::Schema>
19             #pod
20             #pod =cut
21              
22 13     13   876 use CPAN::Testers::Schema::Base 'ResultSet';
  13         33  
  13         88  
23 13     13   1843 use Log::Any '$LOG';
  13         23749  
  13         76  
24 13     13   7966 use Carp ();
  13         36  
  13         8855  
25              
26             #pod =method since
27             #pod
28             #pod my $rs = $rs->since( $iso_dt );
29             #pod
30             #pod Restrict the resultset to reports submitted since the given date/time (in ISO8601 format).
31             #pod
32             #pod =cut
33              
34 1     1 1 16436 sub since( $self, $date ) {
  1         4  
  1         2  
  1         2  
35 1         8 my $fulldate = $date =~ s/[-:T]//gr;
36 1         3 $fulldate = substr $fulldate, 0, 12; # 12 digits makes YYYYMMDDHHNN
37 1         7 return $self->search( { fulldate => { '>=', $fulldate } } );
38             }
39              
40             #pod =method perl_maturity
41             #pod
42             #pod $rs = $rs->perl_maturity( 'stable' ) # or 'dev'
43             #pod
44             #pod Restrict the resultset to reports submitted for either C<stable> or
45             #pod C<dev> Perl versions.
46             #pod
47             #pod =cut
48              
49 2     2 1 20481 sub perl_maturity( $self, $maturity ) {
  2         5  
  2         5  
  2         3  
50 2 50       13 my $devel = $maturity eq 'stable' ? 0 : $maturity eq 'dev' ? 1
    100          
51             : Carp::croak "Unknown maturity: $maturity; Must be one of: 'stable', 'dev'";
52 2 100       8 if ( !$devel ) {
53             # Patch versions are not stable either
54 1         8 return $self->search(
55             { 'perl_version.devel' => 0, 'perl_version.patch' => 0 },
56             { join => 'perl_version' },
57             );
58             }
59 1         11 return $self->search(
60             { -or => { 'perl_version.devel' => 1, 'perl_version.patch' => 1 } },
61             { join => 'perl_version' },
62             );
63             }
64              
65             #pod =method insert_test_report
66             #pod
67             #pod my $stat = $rs->insert_test_report( $report );
68             #pod
69             #pod Convert a L<CPAN::Testers::Schema::Result::TestReport> object to the new test
70             #pod report structure and insert it into the database. This is for creating
71             #pod backwards-compatible APIs.
72             #pod
73             #pod Returns an instance of L<CPAN::Testers::Schema::Result::Stats> on success.
74             #pod Note that since an uploadid is required for the cpanstats table, this method
75             #pod throws an exception when an upload cannot be determined from the given
76             #pod information.
77             #pod
78             #pod =cut
79              
80 3     3 1 17836 sub insert_test_report ( $self, $report ) {
  3         8  
  3         6  
  3         6  
81 3         21 my $schema = $self->result_source->schema;
82              
83 3         104 my $guid = $report->id;
84 3         98 $LOG->infof( 'Updating stats row (report %s)', $guid );
85 3         68 my $data = $report->report;
86 3         163 my $created = $report->created;
87              
88             # attempt to find an uploadid, which is required for cpanstats
89             my @uploads = $schema->resultset('Upload')->search({
90             dist => $data->{distribution}{name},
91             version => $data->{distribution}{version},
92 3         83 })->all;
93              
94 3 100       9771 if ( !@uploads ) {
    50          
95             die $LOG->error(
96             sprintf 'No upload matches for dist %s version %s (report %s)',
97 1         63 $data->{distribution}->@{qw( name version )}, $guid,
98             );
99             }
100             elsif ( @uploads > 1 ) {
101             $LOG->warnf(
102             'Multiple upload matches for dist %s version %s (report %s)',
103 0         0 $data->{distribution}->@{qw( name version )}, $guid,
104             );
105             }
106 2         172 my $uploadid = $uploads[0]->uploadid;
107              
108             my $stat = {
109             guid => $guid,
110             state => lc($data->{result}{grade}),
111             postdate => $created->strftime('%Y%m'),
112             tester => qq["$data->{reporter}{name}" <$data->{reporter}{email}>],
113             dist => $data->{distribution}{name},
114             version => $data->{distribution}{version},
115             platform => $data->{environment}{language}{archname},
116             perl => $data->{environment}{language}{version},
117             osname => $data->{environment}{system}{osname},
118             osvers => $data->{environment}{system}{osversion},
119 2         61 fulldate => $created->strftime('%Y%m%d%H%M'),
120             type => 2,
121             uploadid => $uploadid,
122             };
123              
124 2         339 return $schema->resultset('Stats')->update_or_create($stat, { key => 'guid' });
125             }
126              
127             1;
128              
129             __END__
130              
131             =pod
132              
133             =head1 NAME
134              
135             CPAN::Testers::Schema::ResultSet::Stats - Query the raw test reports
136              
137             =head1 VERSION
138              
139             version 0.024
140              
141             =head1 SYNOPSIS
142              
143             my $rs = $schema->resultset( 'Stats' );
144             $rs->insert_test_report( $schema->resultset( 'TestReport' )->first );
145              
146             =head1 DESCRIPTION
147              
148             This object helps to insert and query the legacy test reports (cpanstats).
149              
150             =head1 METHODS
151              
152             =head2 since
153              
154             my $rs = $rs->since( $iso_dt );
155              
156             Restrict the resultset to reports submitted since the given date/time (in ISO8601 format).
157              
158             =head2 perl_maturity
159              
160             $rs = $rs->perl_maturity( 'stable' ) # or 'dev'
161              
162             Restrict the resultset to reports submitted for either C<stable> or
163             C<dev> Perl versions.
164              
165             =head2 insert_test_report
166              
167             my $stat = $rs->insert_test_report( $report );
168              
169             Convert a L<CPAN::Testers::Schema::Result::TestReport> object to the new test
170             report structure and insert it into the database. This is for creating
171             backwards-compatible APIs.
172              
173             Returns an instance of L<CPAN::Testers::Schema::Result::Stats> on success.
174             Note that since an uploadid is required for the cpanstats table, this method
175             throws an exception when an upload cannot be determined from the given
176             information.
177              
178             =head1 SEE ALSO
179              
180             L<CPAN::Testers::Schema::Result::Stats>, L<DBIx::Class::ResultSet>,
181             L<CPAN::Testers::Schema>
182              
183             =head1 AUTHORS
184              
185             =over 4
186              
187             =item *
188              
189             Oriol Soriano <oriolsoriano@gmail.com>
190              
191             =item *
192              
193             Doug Bell <preaction@cpan.org>
194              
195             =back
196              
197             =head1 COPYRIGHT AND LICENSE
198              
199             This software is copyright (c) 2018 by Oriol Soriano, Doug Bell.
200              
201             This is free software; you can redistribute it and/or modify it under
202             the same terms as the Perl 5 programming language system itself.
203              
204             =cut