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