gatherstats.pl

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