File Coverage

blib/lib/Labyrinth/Plugin/CPAN/Release.pm
Criterion Covered Total %
statement 24 150 16.0
branch 0 68 0.0
condition 0 51 0.0
subroutine 8 12 66.6
pod 4 4 100.0
total 36 285 12.6


line stmt bran cond sub pod time code
1             package Labyrinth::Plugin::CPAN::Release;
2              
3 4     4   9329 use strict;
  4         9  
  4         106  
4 4     4   20 use warnings;
  4         8  
  4         112  
5              
6 4     4   20 use vars qw($VERSION);
  4         9  
  4         181  
7             $VERSION = '3.58';
8              
9             =head1 NAME
10              
11             Labyrinth::Plugin::CPAN::Release - Plugin to handle the release summary table
12              
13             =cut
14              
15             #----------------------------------------------------------------------------
16             # Libraries
17              
18 4     4   23 use base qw(Labyrinth::Plugin::Base);
  4         8  
  4         333  
19              
20 4     4   24 use Labyrinth::Audit;
  4         8  
  4         594  
21 4     4   27 use Labyrinth::DTUtils;
  4         8  
  4         249  
22 4     4   23 use Labyrinth::Variables;
  4         9  
  4         463  
23              
24 4     4   25 use Labyrinth::Plugin::CPAN;
  4         10  
  4         34  
25              
26             #----------------------------------------------------------------------------
27             # Public Interface Functions
28              
29             =head1 METHODS
30              
31             =head2 Public Interface Methods
32              
33             =over 4
34              
35             =item Create
36              
37             Create any missing entries. This is only expected to be run during initial
38             build of the table. Once summation occurs, this becomes redundant.
39              
40             =item Update
41              
42             Update table release_summary.
43              
44             =item Rebuild
45              
46             For a give distribution and version, rebuild all related entries within
47             the release_summary table.
48              
49             =item Fix
50              
51             For all distributions and versions, rebuild all related entries within
52             the release_summary table.
53              
54             =back
55              
56             =cut
57              
58             sub Create {
59 0     0 1   my ($self,$progress) = @_;
60 0 0         $progress->( "Create START" ) if(defined $progress);
61              
62 0           my $cpan = Labyrinth::Plugin::CPAN->new();
63 0           $cpan->Configure();
64              
65 0           my @rmax = $dbi->GetQuery('array','GetReportMax');
66 0 0 0       my $rmax = @rmax ? ($rmax[0]->[0] || 0) : 0;
67 0           my @dmax = $dbi->GetQuery('array','GetReleaseDataMax');
68 0 0 0       my $dmax = @dmax ? ($dmax[0]->[0] || 0) : 0;
69              
70 0           my $id = 0;
71 0           my $step = 1000000;
72 0           my ($from,$to) = ($dmax,$step + $dmax);
73 0           while(1) {
74 0           my $changes = 0;
75 0           my @summ = $dbi->GetQuery('hash','GetSummaryBlock',$from,$to);
76 0           my %summ = map {$_->{id} => 1} @summ;
  0            
77 0           my $next = $dbi->Iterator('hash','GetReportBlock',$from,$to);
78 0           while( my $row = $next->() ) {
79 0           $id = $row->{id};
80 0 0         if($summ{$row->{id}}) {
81             #$progress->( ".. processing $row->{id}" ) if(defined $progress);
82 0           next;
83             }
84              
85 0 0         $progress->( ".. inserting $row->{id} for $row->{dist} - $row->{version} = " . $cpan->DistIndex($row->{dist},$row->{version}) )
86             if(defined $progress);
87              
88             $dbi->DoQuery('InsertReleaseData',
89             $row->{dist},$row->{version},$row->{id},$row->{guid},
90              
91             $cpan->OnCPAN($row->{dist},$row->{version}) ? 1 : 2,
92              
93             $row->{version} =~ /_/ ? 2 : 1,
94             $row->{perl} =~ /^5.(7|9|[1-9][13579])/ ? 2 : 1,
95             $row->{perl} =~ /patch/ ? 2 : 1,
96              
97             $row->{state} eq 'pass' ? 1 : 0,
98             $row->{state} eq 'fail' ? 1 : 0,
99             $row->{state} eq 'na' ? 1 : 0,
100             $row->{state} eq 'unknown' ? 1 : 0,
101              
102 0 0         $cpan->DistIndex($row->{dist},$row->{version}));
    0          
    0          
    0          
    0          
    0          
    0          
    0          
103              
104 0           $changes++;
105             }
106              
107 0 0         last unless($id < $rmax);
108              
109 0           $from += $step;
110 0           $to += $step;
111             }
112              
113 0 0         $progress->( "Create STOP" ) if(defined $progress);
114             }
115              
116             sub Update {
117 0     0 1   my ($self,$progress) = @_;
118 0 0         $progress->( "Update START" ) if(defined $progress);
119              
120 0           my @dmax = $dbi->GetQuery('array','GetReleaseDataMax');
121 0 0 0       my $dmax = @dmax ? ($dmax[0]->[0] || 0) : 0;
122 0           my @smax = $dbi->GetQuery('array','GetReleaseSummaryMax');
123 0 0 0       my $smax = @smax ? ($smax[0]->[0] || 0) : 0;
124              
125 0 0         $progress->( ".. summary max=$smax, data max=$dmax" ) if(defined $progress);
126              
127 0 0 0       if($dmax && $smax < $dmax) {
128             # In case we have several hundred thousand or millions of release data
129             # entries to get through, we only process a block at a time. This means
130             # we don't use up too much memory with %summ and make progress in case
131             # the process dies.
132              
133 0           my $step = 1000000;
134 0           my ($from,$to) = ($smax,($smax+$step));
135 0           while(1) {
136 0 0         $progress->( ".. from=$from, to=$to" ) if(defined $progress);
137 0           my %summ;
138 0           my $next = $dbi->Iterator('array','GetReleaseData',$from,$to);
139 0           while( my $row = $next->() ) {
140 0 0         $progress->( ".. .. processing $row->[2]" ) if(defined $progress);
141 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{id} = $row->[2];
142 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{guid} = $row->[3];
143 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{pass} += $row->[8];
144 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{fail} += $row->[9];
145 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{na} += $row->[10];
146 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{unknown} += $row->[11];
147 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{uploadid} = $row->[12];
148             }
149              
150 0           for my $dist (keys %summ) {
151 0           for my $vers (keys %{$summ{$dist}}) {
  0            
152 0           for my $key1 (keys %{ $summ{$dist}{$vers} }) {
  0            
153 0           for my $key2 (keys %{ $summ{$dist}{$vers}{$key1} }) {
  0            
154 0           for my $key3 (keys %{ $summ{$dist}{$vers}{$key1}{$key2} }) {
  0            
155 0           for my $key4 (keys %{ $summ{$dist}{$vers}{$key1}{$key2}{$key3} }) {
  0            
156 0 0         $progress->( ".. processing [$dist,$vers,$key1,$key2,$key3,$key4] = " .
157             "$summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{id}" ) if(defined $progress);
158 0           my @rows = $dbi->GetQuery('hash','GetReleaseSummary',$dist,$vers,$key1,$key2,$key3,$key4);
159             # if(scalar(@rows) > 1) {
160             # #use Data::Dumper;
161             # #$progress->( ".. rows=".Dumper(\@rows) ) if(defined $progress);
162             # #$progress->( ".. summ=".Dumper($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}) ) if(defined $progress);
163             # for my $row (@rows) {
164             # $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{pass} += $row->{pass};
165             # $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{fail} += $row->{fail};
166             # $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{na} += $row->{na};
167             # $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{unknown} += $row->{unknown};
168             # }
169             #
170             # $dbi->DoQuery('DeleteReleaseSummary',$dist,$vers,$key1,$key2,$key3,$key4);
171             #
172             # $dbi->DoQuery('InsertReleaseSummary',
173             # $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{id},
174             # $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{guid},
175             # ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{pass} || 0),
176             # ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{fail} || 0),
177             # ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{na} || 0),
178             # ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{unknown} || 0),
179             # ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{uploadid} || 0),
180             # $dist,$vers,$key1,$key2,$key3,$key4);
181             #
182             # } elsif(scalar(@rows) > 0) {
183 0 0         if(scalar(@rows) > 0) {
184             #use Data::Dumper;
185             #$progress->( ".. rows=".Dumper(\@rows) ) if(defined $progress);
186             #$progress->( ".. summ=".Dumper($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}) ) if(defined $progress);
187              
188             $dbi->DoQuery('UpdateReleaseSummary',
189             $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{id},
190             $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{guid},
191             ($rows[0]->{pass} + ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{pass} || 0)),
192             ($rows[0]->{fail} + ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{fail} || 0)),
193             ($rows[0]->{na} + ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{na} || 0)),
194             ($rows[0]->{unknown} + ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{unknown} || 0)),
195 0   0       ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{uploadid} || 0),
      0        
      0        
      0        
      0        
196             $dist,$vers,$key1,$key2,$key3,$key4);
197             } else {
198             $dbi->DoQuery('InsertReleaseSummary',
199             $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{id},
200             $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{guid},
201             ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{pass} || 0),
202             ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{fail} || 0),
203             ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{na} || 0),
204             ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{unknown} || 0),
205 0   0       ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{uploadid} || 0),
      0        
      0        
      0        
      0        
206             $dist,$vers,$key1,$key2,$key3,$key4);
207             }
208             }
209             }
210             }
211             }
212             }
213             }
214              
215 0 0         last unless($to < $dmax);
216              
217 0           $from += $step;
218 0           $to += $step;
219             }
220             }
221              
222 0 0         $progress->( "Update STOP" ) if(defined $progress);
223             }
224              
225             sub Rebuild {
226 0     0 1   my ($self,$progress,$dist,$vers) = @_;
227 0 0         $progress->( "Rebuild START [$dist-$vers]" ) if(defined $progress);
228              
229 0           my %summ;
230 0           my $next = $dbi->Iterator('array','GetReleaseDataByDistVers',$dist,$vers);
231 0           while( my $row = $next->() ) {
232 0 0         $progress->( ".. .. processing $row->[2]" ) if(defined $progress);
233 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{id} = $row->[2];
234 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{guid} = $row->[3];
235 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{pass} += $row->[8];
236 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{fail} += $row->[9];
237 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{na} += $row->[10];
238 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{unknown} += $row->[11];
239 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{uploadid} = $row->[12];
240             }
241 0           $dbi->DoQuery('DeleteReleaseSummaryByDistVers',$dist,$vers);
242 0           for my $key1 (keys %{ $summ{$dist}{$vers} }) {
  0            
243 0           for my $key2 (keys %{ $summ{$dist}{$vers}{$key1} }) {
  0            
244 0           for my $key3 (keys %{ $summ{$dist}{$vers}{$key1}{$key2} }) {
  0            
245 0           for my $key4 (keys %{ $summ{$dist}{$vers}{$key1}{$key2}{$key3} }) {
  0            
246 0 0         $progress->( ".. processing [$dist,$vers,$key1,$key2,$key3,$key4] = " .
247             "$summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{id}" ) if(defined $progress);
248             $dbi->DoQuery('InsertReleaseSummary',
249             $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{id},
250             $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{guid},
251             ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{pass} || 0),
252             ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{fail} || 0),
253             ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{na} || 0),
254             ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{unknown} || 0),
255 0   0       ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{uploadid} || 0),
      0        
      0        
      0        
      0        
256             $dist,$vers,$key1,$key2,$key3,$key4);
257             }
258             }
259             }
260             }
261              
262 0 0         $progress->( "Rebuild STOP" ) if(defined $progress);
263             }
264              
265             sub Fix {
266 0     0 1   my ($self,$progress) = @_;
267 0 0         $progress->( "Fix START" ) if(defined $progress);
268              
269 0           my @rs = $dbi->Iterator('hash','GetReleaseDists');
270 0           for my $rs (@rs) {
271 0           my %summ;
272 0           my $next = $dbi->Iterator('array','GetReleaseDataByDist',$rs->{dist});
273 0           while( my $row = $next->() ) {
274 0 0         $progress->( ".. .. processing $row->[2]" ) if(defined $progress);
275 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{id} = $row->[2];
276 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{guid} = $row->[3];
277 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{pass} += $row->[8];
278 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{fail} += $row->[9];
279 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{na} += $row->[10];
280 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{unknown} += $row->[11];
281 0           $summ{$row->[0]}{$row->[1]}{$row->[4]}{$row->[5]}{$row->[6]}{$row->[7]}{uploadid} = $row->[12];
282             }
283              
284 0           $dbi->DoQuery('DeleteReleaseSummaryByDist',$rs->{dist});
285              
286 0           for my $dist (keys %summ) {
287 0           for my $vers (keys %{$summ{$dist}}) {
  0            
288 0           for my $key1 (keys %{ $summ{$dist}{$vers} }) {
  0            
289 0           for my $key2 (keys %{ $summ{$dist}{$vers}{$key1} }) {
  0            
290 0           for my $key3 (keys %{ $summ{$dist}{$vers}{$key1}{$key2} }) {
  0            
291 0           for my $key4 (keys %{ $summ{$dist}{$vers}{$key1}{$key2}{$key3} }) {
  0            
292 0 0         $progress->( ".. processing [$dist,$vers,$key1,$key2,$key3,$key4] = " .
293             "$summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{id}" ) if(defined $progress);
294             $dbi->DoQuery('InsertReleaseSummary',
295             $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{id},
296             $summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{guid},
297             ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{pass} || 0),
298             ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{fail} || 0),
299             ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{na} || 0),
300             ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{unknown} || 0),
301 0   0       ($summ{$dist}{$vers}{$key1}{$key2}{$key3}{$key4}{uploadid} || 0),
      0        
      0        
      0        
      0        
302             $dist,$vers,$key1,$key2,$key3,$key4);
303             }
304             }
305             }
306             }
307             }
308             }
309             }
310              
311 0 0         $progress->( "Fix STOP" ) if(defined $progress);
312             }
313              
314             1;
315              
316             __END__
317              
318             =head1 SEE ALSO
319              
320             Labyrinth
321              
322             =head1 AUTHOR
323              
324             Barbie, <barbie@missbarbell.co.uk> for
325             Miss Barbell Productions, L<http://www.missbarbell.co.uk/>
326              
327             =head1 COPYRIGHT & LICENSE
328              
329             Copyright (C) 2008-2017 Barbie for Miss Barbell Productions
330             All Rights Reserved.
331              
332             This module is free software; you can redistribute it and/or
333             modify it under the Artistic License 2.0.
334              
335             =cut