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