bin/gatherstats.pl

   1 #! /usr/bin/perl
   2 #
   3 # gatherstats.pl
   4 #
   5 # This script will gather statistical information from a database
   6 # containing headers and other information from a INN feed.
   7 #
   8 # It is part of the NewsStats package.
   9 #
  10 # Copyright (c) 2010-2013 Thomas Hochstein <thh@inter.net>
  11 #
  12 # It can be redistributed and/or modified under the same terms under
  13 # which Perl itself is published.
  14
  15 BEGIN {
  16   our $VERSION = "0.01";
  17   use File::Basename;
  18   # we're in .../bin, so our module is in ../lib
  19   push(@INC, dirname($0).'/../lib');
  20 }
  21 use strict;
  22 use warnings;
  23
  24 use NewsStats qw(:DEFAULT :TimePeriods ListNewsgroups ParseHierarchies ReadGroupList);
  25
  26 use DBI;
  27 use Getopt::Long qw(GetOptions);
  28 Getopt::Long::config ('bundling');
  29
  30 ################################# Definitions ##################################
  31
  32 # define types of information that can be gathered
  33 # all / groups (/ clients / hosts)
  34 my %LegalStats;
  35 @LegalStats{('all','groups')} = ();
  36
  37 ################################# Main program #################################
  38
  39 ### read commandline options
  40 my ($OptCheckgroupsFile,$OptClientsDB,$OptDebug,$OptGroupsDB,$OptTLH,
  41     $OptHostsDB,$OptMonth,$OptRawDB,$OptStatsType,$OptTest,$OptConfFile);
  42 GetOptions ('c|checkgroups=s' => \$OptCheckgroupsFile,
  43             'clientsdb=s'     => \$OptClientsDB,
  44             'd|debug!'        => \$OptDebug,
  45             'groupsdb=s'      => \$OptGroupsDB,
  46             'hierarchy=s'     => \$OptTLH,
  47             'hostsdb=s'       => \$OptHostsDB,
  48             'm|month=s'       => \$OptMonth,
  49             'rawdb=s'         => \$OptRawDB,
  50             's|stats=s'       => \$OptStatsType,
  51             't|test!'         => \$OptTest,
  52             'conffile=s'      => \$OptConfFile,
  53             'h|help'          => \&ShowPOD,
  54             'V|version'       => \&ShowVersion) or exit 1;
  55
  56 ### read configuration
  57 my %Conf = %{ReadConfig($OptConfFile)};
  58
  59 ### override configuration via commandline options
  60 my %ConfOverride;
  61 $ConfOverride{'DBTableRaw'}   = $OptRawDB if $OptRawDB;
  62 $ConfOverride{'DBTableGrps'}  = $OptGroupsDB if $OptGroupsDB;
  63 $ConfOverride{'DBTableClnts'} = $OptClientsDB if $OptClientsDB;
  64 $ConfOverride{'DBTableHosts'} = $OptHostsDB if $OptHostsDB;
  65 $ConfOverride{'TLH'} = $OptTLH if $OptTLH;
  66 &OverrideConfig(\%Conf,\%ConfOverride);
  67
  68 ### get type of information to gather, defaulting to 'all'
  69 $OptStatsType = 'all' if !$OptStatsType;
  70 &Bleat(2, sprintf("Unknown type '%s'!", $OptStatsType))
  71   if !exists($LegalStats{$OptStatsType});
  72
  73 ### get time period from --month
  74 # get verbal description of time period, drop SQL code
  75 my ($Period) = &GetTimePeriod($OptMonth);
  76 &Bleat(2,"--month option has an invalid format - please use 'YYYY-MM' or ".
  77          "'YYYY-MM:YYYY-MM'!") if (!$Period or $Period eq 'all time');
  78
  79 ### reformat $Conf{'TLH'}
  80 my $TLH;
  81 if ($Conf{'TLH'}) {
  82   # $Conf{'TLH'} is parsed as an array by Config::Auto;
  83   # make a flat list again, separated by :
  84   if (ref($Conf{'TLH'}) eq 'ARRAY') {
  85     $TLH = join(':',@{$Conf{'TLH'}});
  86   } else {
  87     $TLH  = $Conf{'TLH'};
  88   }
  89   # strip whitespace
  90   $TLH =~ s/\s//g;
  91   # add trailing dots if none are present yet
  92   # (using negative look-behind assertions)
  93   $TLH =~ s/(?<!\.):/.:/g;
  94   $TLH =~ s/(?<!\.)$/./;
  95   # check for illegal characters
  96   &Bleat(2,'Config error - illegal characters in TLH definition!')
  97     if ($TLH !~ /^[a-zA-Z0-9:+.-]+$/);
  98   # escape dots
  99   $TLH =~ s/\./\\./g;
 100   if ($TLH =~ /:/) {
 101     # reformat $TLH from a:b to (a)|(b),
 102     # e.g. replace ':' by ')|('
 103     $TLH =~ s/:/)|(/g;
 104     $TLH = '(' . $TLH . ')';
 105   };
 106 };
 107
 108 ### init database
 109 my $DBHandle = InitDB(\%Conf,1);
 110
 111 ### get data for each month
 112 &Bleat(1,'Test mode. Database is not updated.') if $OptTest;
 113 foreach my $Month (&ListMonth($Period)) {
 114
 115   print "---------- $Month ----------\n" if $OptDebug;
 116
 117   if ($OptStatsType eq 'all' or $OptStatsType eq 'groups') {
 118     # read list of newsgroups from --checkgroups
 119     # into a hash
 120     my %ValidGroups = %{ReadGroupList(sprintf('%s-%s',$OptCheckgroupsFile,$Month))}
 121       if $OptCheckgroupsFile;
 122
 123     ### ----------------------------------------------
 124     ### get groups data (number of postings per group)
 125     # get groups data from raw table for given month
 126     my $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s.%s ".
 127                                              "WHERE day LIKE ? AND NOT disregard",
 128                                              $Conf{'DBDatabase'},
 129                                              $Conf{'DBTableRaw'}));
 130     $DBQuery->execute($Month.'-%')
 131       or &Bleat(2,sprintf("Can't get groups data for %s from %s.%s: ".
 132                           "$DBI::errstr\n",$Month,
 133                           $Conf{'DBDatabase'},$Conf{'DBTableRaw'}));
 134
 135     # count postings per group
 136     my %Postings;
 137     while (($_) = $DBQuery->fetchrow_array) {
 138       # get list of newsgroups and hierarchies from Newsgroups:
 139       my %Newsgroups = ListNewsgroups($_,$TLH,
 140                                       $OptCheckgroupsFile ? \%ValidGroups : '');
 141       # count each newsgroup and hierarchy once
 142       foreach (sort keys %Newsgroups) {
 143         $Postings{$_}++;
 144       };
 145     };
 146
 147     # add valid but empty groups if --checkgroups is set
 148     if (%ValidGroups) {
 149       foreach (sort keys %ValidGroups) {
 150         if (!defined($Postings{$_})) {
 151           # add current newsgroup as empty group
 152           $Postings{$_} = 0;
 153           warn (sprintf("ADDED: %s as empty group\n",$_));
 154           # add empty hierarchies for current newsgroup as needed
 155           foreach (ParseHierarchies($_)) {
 156             my $Hierarchy = $_ . '.ALL';
 157             if (!defined($Postings{$Hierarchy})) {
 158               $Postings{$Hierarchy} = 0;
 159               warn (sprintf("ADDED: %s as empty group\n",$Hierarchy));
 160             };
 161           };
 162         }
 163       };
 164     };
 165
 166     # delete old data for that month
 167     if (!$OptTest) {
 168       $DBQuery = $DBHandle->do(sprintf("DELETE FROM %s.%s WHERE month = ?",
 169                                        $Conf{'DBDatabase'},$Conf{'DBTableGrps'}),
 170                                        undef,$Month)
 171         or &Bleat(2,sprintf("Can't delete old groups data for %s from %s.%s: ".
 172                             "$DBI::errstr\n",$Month,
 173                             $Conf{'DBDatabase'},$Conf{'DBTableGrps'}));
 174     };
 175
 176     print "----- GroupStats -----\n" if $OptDebug;
 177     foreach my $Newsgroup (sort keys %Postings) {
 178       print "$Newsgroup => $Postings{$Newsgroup}\n" if $OptDebug;
 179       if (!$OptTest) {
 180         # write to database
 181         $DBQuery = $DBHandle->prepare(sprintf("INSERT INTO %s.%s ".
 182                                               "(month,newsgroup,postings) ".
 183                                               "VALUES (?, ?, ?)",
 184                                               $Conf{'DBDatabase'},
 185                                               $Conf{'DBTableGrps'}));
 186         $DBQuery->execute($Month, $Newsgroup, $Postings{$Newsgroup})
 187           or &Bleat(2,sprintf("Can't write groups data for %s/%s to %s.%s: ".
 188                               "$DBI::errstr\n",$Month,$Newsgroup,
 189                               $Conf{'DBDatabase'},$Conf{'DBTableGrps'}));
 190         $DBQuery->finish;
 191       };
 192     };
 193   } else {
 194     # other types of information go here - later on
 195   };
 196 };
 197
 198 ### close handles
 199 $DBHandle->disconnect;
 200
 201 __END__
 202
 203 ################################ Documentation #################################
 204
 205 =head1 NAME
 206
 207 gatherstats - process statistical data from a raw source
 208
 209 =head1 SYNOPSIS
 210
 211 B<gatherstats> [B<-Vhdt>] [B<-m> I<YYYY-MM> | I<YYYY-MM:YYYY-MM>] [B<-s> I<stats>] [B<-c> I<filename template>]] [B<--hierarchy> I<TLH>] [B<--rawdb> I<database table>] [B<-groupsdb> I<database table>] [B<--clientsdb> I<database table>] [B<--hostsdb> I<database table>] [--conffile I<filename>]
 212
 213 =head1 REQUIREMENTS
 214
 215 See L<doc/README>.
 216
 217 =head1 DESCRIPTION
 218
 219 This script will extract and process statistical information from a
 220 database table which is fed from F<feedlog.pl> for a given time period
 221 and write its results to (an)other database table(s). Entries marked
 222 with I<'disregard'> in the database will be ignored; currently, you
 223 have to set this flag yourself, using your database management tools.
 224 You can exclude erroneous entries that way (e.g. automatic reposts
 225 (think of cancels flood and resurrectors); spam; ...).
 226
 227 The time period to act on defaults to last month; you can assign
 228 another time period or a single month via the B<--month> option (see
 229 below).
 230
 231 By default B<gatherstats> will process all types of information; you
 232 can change that using the B<--stats> option and assigning the type of
 233 information to process. Currently that doesn't matter yet as only
 234 processing of the number of postings per group per month is
 235 implemented anyway.
 236
 237 Possible information types include:
 238
 239 =over 3
 240
 241 =item B<groups> (postings per group per month)
 242
 243 B<gatherstats> will examine Newsgroups: headers. Crosspostings will be
 244 counted for each single group they appear in. Groups not in I<TLH>
 245 will be ignored.
 246
 247 B<gatherstats> will also add up the number of postings for each
 248 hierarchy level, but only count each posting once. A posting to
 249 de.alt.test will be counted for de.alt.test, de.alt.ALL and de.ALL,
 250 respectively. A crossposting to de.alt.test and de.alt.admin, on the
 251 other hand, will be counted for de.alt.test and de.alt.admin each, but
 252 only once for de.alt.ALL and de.ALL.
 253
 254 Data is written to I<DBTableGrps> (see L<doc/INSTALL>); you can
 255 override that default through the B<--groupsdb> option.
 256
 257 =back
 258
 259 =head2 Configuration
 260
 261 B<gatherstats> will read its configuration from F<newsstats.conf>
 262 which should be present in the same directory via Config::Auto.
 263
 264 See L<doc/INSTALL> for an overview of possible configuration options.
 265
 266 You can override configuration options via the B<--hierarchy>,
 267 B<--rawdb>, B<--groupsdb>, B<--clientsdb> and B<--hostsdb> options,
 268 respectively.
 269
 270 =head1 OPTIONS
 271
 272 =over 3
 273
 274 =item B<-V>, B<--version>
 275
 276 Print out version and copyright information and exit.
 277
 278 =item B<-h>, B<--help>
 279
 280 Print this man page and exit.
 281
 282 =item B<-d>, B<--debug>
 283
 284 Output debugging information to STDOUT while processing (number of
 285 postings per group).
 286
 287 =item B<-t>, B<--test>
 288
 289 Do not write results to database. You should use B<--debug> in
 290 conjunction with B<--test> ... everything else seems a bit pointless.
 291
 292 =item B<-m>, B<--month> I<YYYY-MM[:YYYY-MM]>
 293
 294 Set processing period to a single month in YYYY-MM format or to a time
 295 period between two month in YYYY-MM:YYYY-MM format (two month, separated
 296 by a colon).
 297
 298 =item B<-s>, B<--stats> I<type>
 299
 300 Set processing type to one of I<all> and I<groups>. Defaults to all
 301 (and is currently rather pointless as only I<groups> has been
 302 implemented).
 303
 304 =item B<-c>, B<--checkgroups> I<filename template>
 305
 306 Check each group against a list of valid newsgroups read from a file,
 307 one group on each line and ignoring everything after the first
 308 whitespace (so you can use a file in checkgroups format or (part of)
 309 your INN active file).
 310
 311 The filename is taken from I<filename template>, amended by each
 312 B<--month> B<gatherstats> is processing in the form of I<template-YYYY-MM>,
 313 so that
 314
 315     gatherstats -m 2010-01:2010-12 -c checkgroups
 316
 317 will check against F<checkgroups-2010-01> for January 2010, against
 318 F<checkgroups-2010-02> for February 2010 and so on.
 319
 320 Newsgroups not found in the checkgroups file will be dropped (and
 321 logged to STDERR), and newsgroups found there but having no postings
 322 will be added with a count of 0 (and logged to STDERR).
 323
 324 =item B<--hierarchy> I<TLH> (newsgroup hierarchy)
 325
 326 Override I<TLH> from F<newsstats.conf>.
 327
 328 =item B<--rawdb> I<table> (raw data table)
 329
 330 Override I<DBTableRaw> from F<newsstats.conf>.
 331
 332 =item B<--groupsdb> I<table> (postings per group table)
 333
 334 Override I<DBTableGrps> from F<newsstats.conf>.
 335
 336 =item B<--clientsdb> I<table> (client data table)
 337
 338 Override I<DBTableClnts> from F<newsstats.conf>.
 339
 340 =item B<--hostsdb> I<table> (host data table)
 341
 342 Override I<DBTableHosts> from F<newsstats.conf>.
 343
 344 =item B<--conffile> I<filename>
 345
 346 Load configuration from I<filename> instead of F<newsstats.conf>.
 347
 348 =back
 349
 350 =head1 INSTALLATION
 351
 352 See L<doc/INSTALL>.
 353
 354 =head1 EXAMPLES
 355
 356 Process all types of information for lasth month:
 357
 358     gatherstats
 359
 360 Do a dry run, showing results of processing:
 361
 362     gatherstats --debug --test
 363
 364 Process all types of information for January of 2010:
 365
 366     gatherstats --month 2010-01
 367
 368 Process only number of postings for the year of 2010,
 369 checking against checkgroups-*:
 370
 371     gatherstats -m 2010-01:2010-12 -s groups -c checkgroups
 372
 373 =head1 FILES
 374
 375 =over 4
 376
 377 =item F<bin/gatherstats.pl>
 378
 379 The script itself.
 380
 381 =item F<lib/NewsStats.pm>
 382
 383 Library functions for the NewsStats package.
 384
 385 =item F<etc/newsstats.conf>
 386
 387 Runtime configuration file.
 388
 389 =back
 390
 391 =head1 BUGS
 392
 393 Please report any bugs or feature requests to the author or use the
 394 bug tracker at L<http://bugs.th-h.de/>!
 395
 396 =head1 SEE ALSO
 397
 398 =over 2
 399
 400 =item -
 401
 402 L<doc/README>
 403
 404 =item -
 405
 406 L<doc/INSTALL>
 407
 408 =back
 409
 410 This script is part of the B<NewsStats> package.
 411
 412 =head1 AUTHOR
 413
 414 Thomas Hochstein <thh@inter.net>
 415
 416 =head1 COPYRIGHT AND LICENSE
 417
 418 Copyright (c) 2010-2012 Thomas Hochstein <thh@inter.net>
 419
 420 This program is free software; you may redistribute it and/or modify it
 421 under the same terms as Perl itself.
 422
 423 =cut