gatherstats.pl

   1 #! /usr/bin/perl -W\r
   2 #\r
   3 # gatherstats.pl\r
   4 #\r
   5 # This script will gather statistical information from a database\r
   6 # containing headers and other information from a INN feed.\r
   7 # \r
   8 # It is part of the NewsStats package.\r
   9 #\r
  10 # Copyright (c) 2010 Thomas Hochstein <thh@inter.net>\r
  11 #\r
  12 # It can be redistributed and/or modified under the same terms under \r
  13 # which Perl itself is published.\r
  14 \r
  15 BEGIN {\r
  16   our $VERSION = "0.01";\r
  17   use File::Basename;\r
  18   push(@INC, dirname($0));\r
  19 }\r
  20 use strict;\r
  21 \r
  22 use NewsStats qw(:DEFAULT :TimePeriods ListNewsgroups);\r
  23 \r
  24 use DBI;\r
  25 \r
  26 ################################# Definitions ##################################\r
  27 \r
  28 # define types of information that can be gathered\r
  29 # all / groups (/ clients / hosts)\r
  30 my %LegalTypes;\r
  31 @LegalTypes{('all','groups')} = ();\r
  32 \r
  33 ################################# Main program #################################\r
  34 \r
  35 ### read commandline options\r
  36 my %Options = &ReadOptions('dom:p:t:n:r:g:c:s:');\r
  37 \r
  38 ### read configuration\r
  39 my %Conf = %{ReadConfig('newsstats.conf')};\r
  40 \r
  41 ### override configuration via commandline options\r
  42 my %ConfOverride;\r
  43 $ConfOverride{'DBTableRaw'}   = $Options{'r'} if $Options{'r'};\r
  44 $ConfOverride{'DBTableGrps'}  = $Options{'g'} if $Options{'g'};\r
  45 $ConfOverride{'DBTableClnts'} = $Options{'c'} if $Options{'c'};\r
  46 $ConfOverride{'DBTableHosts'} = $Options{'s'} if $Options{'s'};\r
  47 $ConfOverride{'TLH'} = $Options{'n'} if $Options{'n'};\r
  48 &OverrideConfig(\%Conf,\%ConfOverride);\r
  49 \r
  50 ### get type of information to gather, default to 'all'\r
  51 $Options{'t'} = 'all' if !$Options{'t'};\r
  52 die "$MySelf: E: Unknown type '-t $Options{'t'}'!\n" if !exists($LegalTypes{$Options{'t'}});\r
  53 \r
  54 ### get time period\r
  55 my ($StartMonth,$EndMonth) = &GetTimePeriod($Options{'m'},$Options{'p'});\r
  56 \r
  57 ### init database\r
  58 my $DBHandle = InitDB(\%Conf,1);\r
  59 \r
  60 ### get data for each month\r
  61 warn "$MySelf: W: Output only mode. Database is not updated.\n" if $Options{'o'};\r
  62 foreach my $Month (&ListMonth($StartMonth,$EndMonth)) {\r
  63 \r
  64   print "---------- $Month ----------\n" if $Options{'d'};\r
  65 \r
  66   if ($Options{'t'} eq 'all' or $Options{'t'} eq 'groups') {\r
  67     ### ----------------------------------------------\r
  68     ### get groups data (number of postings per group)\r
  69     # get groups data from raw table for given month\r
  70     my $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s.%s WHERE day LIKE ? AND NOT disregard",$Conf{'DBDatabase'},$Conf{'DBTableRaw'}));\r
  71     $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
  72 \r
  73     # count postings per group\r
  74     my %Postings;\r
  75 \r
  76     while (($_) = $DBQuery->fetchrow_array) {\r
  77       # get list oft newsgroups and hierarchies from Newsgroups:\r
  78       my %Newsgroups = ListNewsgroups($_);\r
  79       # count each newsgroup and hierarchy once\r
  80       foreach (sort keys %Newsgroups) {\r
  81         # don't count newsgroup/hierarchy in wrong TLH\r
  82         next if(defined($Conf{'TLH'}) and !/^$Conf{'TLH'}/);\r
  83         $Postings{$_}++;\r
  84       };\r
  85     };\r
  86 \r
  87     print "----- GroupStats -----\n" if $Options{'d'};\r
  88     foreach my $Newsgroup (sort keys %Postings) {\r
  89       print "$Newsgroup => $Postings{$Newsgroup}\n" if $Options{'d'};\r
  90       if (!$Options{'o'}) {\r
  91         # write to database\r
  92         $DBQuery = $DBHandle->prepare(sprintf("REPLACE INTO %s.%s (month,newsgroup,postings) VALUES (?, ?, ?)",$Conf{'DBDatabase'},$Conf{'DBTableGrps'}));\r
  93         $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
  94         $DBQuery->finish;\r
  95       };\r
  96     };\r
  97   };\r
  98 };\r
  99 \r
 100 ### close handles\r
 101 $DBHandle->disconnect;\r
 102 \r