new code to load Perl/OS stats

barbie · Jun 4, 2017 · a047c59 · a047c59
1 parent 5c01fab
commit a047c59
Show file tree

Hide file tree

Showing 4 changed files with 78 additions and 9 deletions.
diff --git a/Changes b/Changes
@@ -11,6 +11,7 @@ Changes for the CPAN Testers Reports website
         - updated changes from live production.
         - added Try::Tiny capture around the RemoveAuthorPages block due to
           some odd JSON parsing that was causing it to crash.
+        - new code to load Perl/OS stats, due to the previous db overload.
 
 3.57    2015-08-16
         - fixes from live.

diff --git a/MANIFEST b/MANIFEST
@@ -37,6 +37,7 @@ vhost/cgi-bin/config/requests/req.ini
 vhost/cgi-bin/config/requests/user.ini
 vhost/cgi-bin/config/settings.ini
 vhost/cgi-bin/db/cpanreps-base.sql
+vhost/cgi-bin/db/cpanreps-cpanstats.sql
 vhost/cgi-bin/pages.cgi
 vhost/cgi-bin/release-summary.cgi
 vhost/cgi-bin/reports-metadata.cgi

diff --git a/lib/Labyrinth/Plugin/CPAN/Builder.pm b/lib/Labyrinth/Plugin/CPAN/Builder.pm
@@ -733,23 +733,76 @@ sub DistroPages {
             }
 #$progress->( ".. .. version data update complete for $name" ) if(defined $progress);
 
+# V1 code starts
+#            my ($stats,$oses);
+#            @rows = $dbi->GetQuery('hash','GetDistrosPass',{dist=>$dist});
+#            for(@rows) {
+#                my ($osname,$code) = $cpan->OSName($_->{osname});
+#                $stats->{$_->{perl}}{$code}{count} = $_->{count};
+#                $oses->{$code} = $osname;
+#            }
+##$progress->( ".. .. OS data update complete for $name" ) if(defined $progress);
+#
+#            # distribution PASS stats
+#            my @stats = $dbi->GetQuery('hash','GetStatsPass',{dist=>$dist});
+#            for(@stats) {
+#                my ($osname,$code) = $cpan->OSName($_->{osname});
+#                $stats->{$_->{perl}}{$code}{version} = $_->{version}
+#                    if(!$stats->{$_->{perl}}->{$code} || _versioncmp($_->{version},$stats->{$_->{perl}}->{$code}{version}));
+#            }
+##$progress->( ".. .. Pass Stats data update complete for $name" ) if(defined $progress);
+# V1 code end
+
+# V2 code starts
+#            # retrieve perl/os stats
+#            my ($stats,$oses);
+#            my @stats = $dbi->GetQuery('hash','GetStatsPass',{dist=>$dist});
+#            for(@stats) {
+#                my ($osname,$code) = $cpan->OSName($_->{osname});
+#                $stats->{$_->{perl}}{$code}{version} = $_->{version}
+#                    if(!$stats->{$_->{perl}}->{$code} || _versioncmp($_->{version},$stats->{$_->{perl}}->{$code}{version}));
+#
+#                $stats->{$_->{perl}}{$code}{count}++;
+#                $oses->{$code} = $osname;
+#            }
+##$progress->( ".. .. Perl/OS data update complete for $name" ) if(defined $progress);
+# V2 code end
+
+# V3 code starts
+            # retrieve perl/os stats
             my ($stats,$oses);
-            @rows = $dbi->GetQuery('hash','GetDistrosPass',{dist=>$dist});
+            my $lastid = 0;
+            my @rows = $dbi->GetQuery('hash','GetStatsStore',{dist=>$dist});
             for(@rows) {
-                my ($osname,$code) = $cpan->OSName($_->{osname});
-                $stats->{$_->{perl}}{$code}{count} = $_->{count};
-                $oses->{$code} = $osname;
+                $stats->{$_->{perl}}{$_->{osname}}{version} = $_->{version};
+                $stats->{$_->{perl}}{$_->{osname}}{count}   = $_->{counter};
+                $oses->{$_->{osname}} = $osname;
+                $lastid |= $_->{lastid};
             }
-#$progress->( ".. .. OS data update complete for $name" ) if(defined $progress);
 
-            # distribution PASS stats
-            my @stats = $dbi->GetQuery('hash','GetStatsPass',{dist=>$dist});
+            # update perl/os stats
+            my @stats = $dbi->GetQuery('hash','GetStatsPass2',{dist=>$dist},$lastid);
             for(@stats) {
                 my ($osname,$code) = $cpan->OSName($_->{osname});
                 $stats->{$_->{perl}}{$code}{version} = $_->{version}
                     if(!$stats->{$_->{perl}}->{$code} || _versioncmp($_->{version},$stats->{$_->{perl}}->{$code}{version}));
+
+                $stats->{$_->{perl}}{$code}{count}++;
+                $oses->{$code} = $osname;
+                $lastid = $_->{id} if($lastid < $_->{id};
             }
-#$progress->( ".. .. Pass Stats data update complete for $name" ) if(defined $progress);
+
+            # store perl/os stats
+            $dbi->DoQuery('DelStatsStore',$name);
+            for my $perl (keys %$stats) {
+                for my $code (keys %{$stats->{$perl}}) {
+                    $dbi->DoQuery('SetStatsStore',$name,$perl,$code,$stats->{$perl}{$code}{version},$stats->{$perl}{$code}{count},$lastid);
+                }
+            }
+#$progress->( ".. .. Perl/OS data update complete for $name" ) if(defined $progress);
+# V3 code end
+
+
 
             my @stats_oses = sort keys %$oses;
             my @stats_perl = sort {_versioncmp($b,$a)} keys %$stats;
@@ -833,8 +886,11 @@ sub DistroPages {
 #LogDebug("DistroPages: ids=@ids, distros=@delete");
 
     # remove requests
+    while(@ids) {
 #$progress->( ".. .. removing page_request entries for $name. ids=".scalar(@ids) ) if(defined $progress);
-    $dbi->DoQuery('DeletePageRequests',{ids => join(',',@ids)},'distro',$_) for(@delete);
+        my @remove = splice(@ids,0,100);
+        $dbi->DoQuery('DeletePageRequests',{ids => join(',',@remove)},'distro',$_) for(@delete);
+    };
 #$progress->( ".. .. removed page_request entries for $name" ) if(defined $progress);
 }
 

diff --git a/vhost/cgi-bin/db/cpanreps-cpanstats.sql b/vhost/cgi-bin/db/cpanreps-cpanstats.sql
@@ -0,0 +1,11 @@
+--- new table used by Builder.pm
+
+CREATE TABLE stats_store (
+  `dist`    varchar(150) NOT NULL,
+  `version` varchar(150) DEFAULT NULL,
+  `perl`    varchar(10) DEFAULT NULL,
+  `osname`  varchar(32) DEFAULT NULL,
+  `counter` int(10) unsigned NOT NULL,
+  `lastid`  int(10) unsigned NOT NULL,
+  KEY `dist` (`dist`)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1;