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