Initial checkin of working branch.

[usenet/newsstats.git] / gatherstats.pl

diff --git a/gatherstats.pl b/gatherstats.pl
new file mode 100755 (executable)
index 0000000..09157d1
--- /dev/null
+++ b/gatherstats.pl
@@ -0,0 +1,102 @@
+#! /usr/bin/perl -W\r
+#\r
+# gatherstats.pl\r
+#\r
+# This script will gather statistical information from a database\r
+# containing headers and other information from a INN feed.\r
+# \r
+# It is part of the NewsStats package.\r
+#\r
+# Copyright (c) 2010 Thomas Hochstein <thh@inter.net>\r
+#\r
+# It can be redistributed and/or modified under the same terms under \r
+# which Perl itself is published.\r
+\r
+BEGIN {\r
+  our $VERSION = "0.01";\r
+  use File::Basename;\r
+  push(@INC, dirname($0));\r
+}\r
+use strict;\r
+\r
+use NewsStats qw(:DEFAULT :TimePeriods ListNewsgroups);\r
+\r
+use DBI;\r
+\r
+################################# Definitions ##################################\r
+\r
+# define types of information that can be gathered\r
+# all / groups (/ clients / hosts)\r
+my %LegalTypes;\r
+@LegalTypes{('all','groups')} = ();\r
+\r
+################################# Main program #################################\r
+\r
+### read commandline options\r
+my %Options = &ReadOptions('dom:p:t:n:r:g:c:s:');\r
+\r
+### read configuration\r
+my %Conf = %{ReadConfig('newsstats.conf')};\r
+\r
+### override configuration via commandline options\r
+my %ConfOverride;\r
+$ConfOverride{'DBTableRaw'}   = $Options{'r'} if $Options{'r'};\r
+$ConfOverride{'DBTableGrps'}  = $Options{'g'} if $Options{'g'};\r
+$ConfOverride{'DBTableClnts'} = $Options{'c'} if $Options{'c'};\r
+$ConfOverride{'DBTableHosts'} = $Options{'s'} if $Options{'s'};\r
+$ConfOverride{'TLH'} = $Options{'n'} if $Options{'n'};\r
+&OverrideConfig(\%Conf,\%ConfOverride);\r
+\r
+### get type of information to gather, default to 'all'\r
+$Options{'t'} = 'all' if !$Options{'t'};\r
+die "$MySelf: E: Unknown type '-t $Options{'t'}'!\n" if !exists($LegalTypes{$Options{'t'}});\r
+\r
+### get time period\r
+my ($StartMonth,$EndMonth) = &GetTimePeriod($Options{'m'},$Options{'p'});\r
+\r
+### init database\r
+my $DBHandle = InitDB(\%Conf,1);\r
+\r
+### get data for each month\r
+warn "$MySelf: W: Output only mode. Database is not updated.\n" if $Options{'o'};\r
+foreach my $Month (&ListMonth($StartMonth,$EndMonth)) {\r
+\r
+  print "---------- $Month ----------\n" if $Options{'d'};\r
+\r
+  if ($Options{'t'} eq 'all' or $Options{'t'} eq 'groups') {\r
+    ### ----------------------------------------------\r
+    ### get groups data (number of postings per group)\r
+    # get groups data from raw table for given month\r
+    my $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s.%s WHERE day LIKE ? AND NOT disregard",$Conf{'DBDatabase'},$Conf{'DBTableRaw'}));\r
+    $DBQuery->execute($Month.'-%') or die sprintf("$MySelf: E: Can't get groups data for %s from %s.%s: $DBI::errstr\n",$Month,$Conf{'DBDatabase'},$Conf{'DBTableRaw'});\r
+\r
+    # count postings per group\r
+    my %Postings;\r
+\r
+    while (($_) = $DBQuery->fetchrow_array) {\r
+      # get list oft newsgroups and hierarchies from Newsgroups:\r
+      my %Newsgroups = ListNewsgroups($_);\r
+      # count each newsgroup and hierarchy once\r
+      foreach (sort keys %Newsgroups) {\r
+        # don't count newsgroup/hierarchy in wrong TLH\r
+        next if(defined($Conf{'TLH'}) and !/^$Conf{'TLH'}/);\r
+        $Postings{$_}++;\r
+      };\r
+    };\r
+\r
+    print "----- GroupStats -----\n" if $Options{'d'};\r
+    foreach my $Newsgroup (sort keys %Postings) {\r
+      print "$Newsgroup => $Postings{$Newsgroup}\n" if $Options{'d'};\r
+      if (!$Options{'o'}) {\r
+        # write to database\r
+        $DBQuery = $DBHandle->prepare(sprintf("REPLACE INTO %s.%s (month,newsgroup,postings) VALUES (?, ?, ?)",$Conf{'DBDatabase'},$Conf{'DBTableGrps'}));\r
+        $DBQuery->execute($Month, $Newsgroup, $Postings{$Newsgroup}) or die sprintf("$MySelf: E: Can't write groups data for %s/%s to %s.%s: $DBI::errstr\n",$Month,$Newsgroup,$Conf{'DBDatabase'},$Conf{'DBTableGrps'});\r
+        $DBQuery->finish;\r
+      };\r
+    };\r
+  };\r
+};\r
+\r
+### close handles\r
+$DBHandle->disconnect;\r
+\r