NewsStats.pm

   1 # NewsStats.pm
   2 #
   3 # Library functions for the NewsStats package.
   4 #
   5 # Copyright (c) 2010 Thomas Hochstein <thh@inter.net>
   6 #
   7 # This module can be redistributed and/or modified under the same terms under
   8 # which Perl itself is published.
   9
  10 package NewsStats;
  11
  12 use strict;
  13 use warnings;
  14 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  15
  16 require Exporter;
  17 @ISA = qw(Exporter);
  18 @EXPORT = qw(
  19   $MySelf
  20   $MyVersion
  21   ReadOptions
  22   ReadConfig
  23   OverrideConfig
  24   InitDB
  25 );
  26 @EXPORT_OK = qw(
  27   GetTimePeriod
  28   LastMonth
  29   CheckMonth
  30   SplitPeriod
  31   ListMonth
  32   ListNewsgroups
  33   OutputData
  34   FormatOutput
  35   SQLHierarchies
  36   SQLGroupList
  37   GetMaxLenght
  38 );
  39 %EXPORT_TAGS = ( TimePeriods => [qw(GetTimePeriod LastMonth CheckMonth SplitPeriod ListMonth)],
  40                  Output      => [qw(OutputData FormatOutput)],
  41                  SQLHelper   => [qw(SQLHierarchies SQLGroupList GetMaxLenght)]);
  42 $VERSION = '0.1';
  43
  44 use Data::Dumper;
  45 use File::Basename;
  46 use Getopt::Std;
  47
  48 use Config::Auto;
  49 use DBI;
  50
  51 #####-------------------------------- Vars --------------------------------#####
  52
  53 our $MySelf = fileparse($0, '.pl');
  54 our $MyVersion = "$MySelf $::VERSION (NewsStats.pm $VERSION)";
  55
  56 #####------------------------------- Basics -------------------------------#####
  57
  58 ################################################################################
  59 sub ReadOptions {
  60 ################################################################################
  61 ### read commandline options and act on standard options
  62 ### IN : $Params: containing list of commandline paramaters (without -h and -V)
  63 ### OUT: a hash containing the commandline options
  64   $Getopt::Std::STANDARD_HELP_VERSION = 1;
  65
  66   my ($Params) = @_;
  67   my %Options;
  68
  69   getopts('Vh'.$Params, \%Options);
  70
  71   # -V: display version
  72   &ShowVersion if ($Options{'V'});
  73
  74   # -h: feed myself to perldoc
  75   &ShowPOD if ($Options{'h'});
  76
  77   return %Options;
  78 };
  79 ################################################################################
  80
  81 ################################################################################
  82 sub ShowVersion {
  83 ################################################################################
  84 ### display version and exit
  85   print "$MyVersion\nCopyright (c) 2010 Thomas Hochstein <thh\@inter.net>\n";
  86   print "This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.\n";
  87   exit(100);
  88 };
  89 ################################################################################
  90
  91 ################################################################################
  92 sub ShowPOD {
  93 ################################################################################
  94 ### feed myself to perldoc and exit
  95   exec('perldoc', $0);
  96   exit(100);
  97 };
  98 ################################################################################
  99
 100 ################################################################################
 101 sub ReadConfig {
 102 ################################################################################
 103 ### read config via Config::Auto
 104 ### IN : $ConfFile: config filename
 105 ### OUT: reference to a hash containing the configuration
 106   my ($ConfFile) = @_;
 107   return Config::Auto::parse($ConfFile, format => 'equal');
 108 };
 109 ################################################################################
 110
 111 ################################################################################
 112 sub OverrideConfig  {
 113 ################################################################################
 114 ### override configuration values
 115 ### IN : $ConfigR  : reference to configuration hash
 116 ###      $OverrideR: reference to a hash containing overrides
 117   my ($ConfigR,$OverrideR) = @_;
 118   my %Override = %$OverrideR;
 119   warn "$MySelf W: Empty configuration hash passed to OverrideConfig().\n" if ( keys %$ConfigR < 1);
 120   return if (keys %Override < 1 or keys %$ConfigR < 1);
 121   foreach my $Key (keys %Override) {
 122     $$ConfigR{$Key} = $Override{$Key};
 123   };
 124 };
 125 ################################################################################
 126
 127 ################################################################################
 128 sub InitDB {
 129 ################################################################################
 130 ### initialise database connection
 131 ### IN : $ConfigR: reference to configuration hash
 132 ###      $Die    : if TRUE, die if connection failed
 133 ### OUT: DBHandle
 134   my ($ConfigR,$Die) = @_;
 135   my %Conf = %$ConfigR;
 136   my $DBHandle = DBI->connect(sprintf('DBI:%s:database=%s;host=%s',$Conf{'DBDriver'},$Conf{'DBDatabase'},$Conf{'DBHost'}), $Conf{'DBUser'}, $Conf{'DBPw'}, { PrintError => 0 });
 137   if (!$DBHandle) {
 138     die ("$MySelf: E: $DBI::errstr\n") if (defined($Die) and $Die);
 139     warn("$MySelf: W: $DBI::errstr\n");
 140   };
 141   return $DBHandle;
 142 };
 143 ################################################################################
 144
 145 #####------------------------------ GetStats ------------------------------#####
 146
 147 ################################################################################
 148 sub ListNewsgroups {
 149 ################################################################################
 150 ### count each newsgroup and each hierarchy level, but only once
 151 ### IN : $Newsgroups: a list of newsgroups (content of Newsgroups:)
 152 ### OUT: %Newsgroups: hash containing all newsgroup and hierarchy names as keys
 153   my ($Newsgroups) = @_;
 154   my %Newsgroups;
 155   chomp($Newsgroups);
 156   # remove whitespace from contents of Newsgroups:
 157   $Newsgroups =~ s/\s//;
 158   # call &HierarchyCount for each newsgroup in $Newsgroups:
 159   for (split /,/, $Newsgroups) {
 160     # add original newsgroup to %Newsgroups
 161     $Newsgroups{$_} = 1;
 162     # add all hierarchy elements to %Newsgroups, amended by '.ALL',
 163     # i.e. de.alt.ALL and de.ALL
 164     foreach (ParseHierarchies($_)) {
 165       $Newsgroups{$_.'.ALL'} = 1;
 166     }
 167   };
 168   return %Newsgroups;
 169 };
 170
 171 ################################################################################
 172 sub ParseHierarchies {
 173 ################################################################################
 174 ### get all hierarchies a newsgroup belongs to
 175 ### IN : $Newsgroup  : a newsgroup name
 176 ### OUT: @Hierarchies: array containing all hierarchies the newsgroup belongs to
 177   my ($Newsgroup) = @_;
 178   my @Hierarchies;
 179   # strip trailing dots
 180   $Newsgroup =~ s/(.+)\.+$/$1/;
 181   # butcher newsgroup name by "." and add each hierarchy to @Hierarchies
 182   # i.e. de.alt.test: "de.alt" and "de"
 183   while ($Newsgroup =~ /\./) {
 184     $Newsgroup =~ s/^((?:\.?[^.]+)*)\.[^.]+$/$1/;
 185     push @Hierarchies, $Newsgroup;
 186   };
 187   return @Hierarchies;
 188 };
 189
 190 ################################################################################
 191
 192 #####----------------------------- TimePeriods ----------------------------#####
 193
 194 ################################################################################
 195 sub GetTimePeriod {
 196 ################################################################################
 197 ### get time period using -m / -p
 198 ### IN : $Month,$Period: contents of -m and -p
 199 ### OUT: $StartMonth, $EndMonth
 200   my ($Month,$Period) = @_;
 201   # exit if -m is set and not like YYYY-MM
 202   die "$MySelf: E: Wrong date format - use '$MySelf -m YYYY-MM'!\n" if not &CheckMonth($Month);
 203   # default: set -m to last month
 204   $Month = &LastMonth if (!defined($Month) and !defined($Period));
 205   # set $StartMonth, $EndMonth
 206   my ($StartMonth, $EndMonth);
 207   if ($Period) {
 208     # -p: get date range
 209     ($StartMonth, $EndMonth) = &SplitPeriod($Period);
 210     die "$MySelf: E: Wrong format for time period - use '$MySelf -p YYYY-MM:YYYY-MM'!\n" if !defined($StartMonth);
 211   } else {
 212     # set $StartMonth = $EndMonth = $Month if -p is not set
 213     $StartMonth = $EndMonth = $Month;
 214   };
 215   return ($StartMonth, $EndMonth);
 216 };
 217
 218 ################################################################################
 219 sub LastMonth {
 220 ################################################################################
 221 ### get last month from today in YYYY-MM format
 222 ### OUT: last month as YYYY-MM
 223   # get today's date
 224   my (undef,undef,undef,undef,$Month,$Year,undef,undef,undef) = localtime(time);
 225   # $Month is already defined from 0 to 11, so no need to decrease it by 1
 226   $Year += 1900;
 227   if ($Month < 1) {
 228     $Month = 12;
 229     $Year--;
 230   };
 231   # return last month
 232   return sprintf('%4d-%02d',$Year,$Month);
 233 };
 234
 235 ################################################################################
 236 sub CheckMonth {
 237 ################################################################################
 238 ### check for valid month
 239 ### IN : $Month: month
 240 ### OUT: TRUE / FALSE
 241   my ($Month) = @_;
 242   return 0 if (defined($Month) and $Month !~ /^\d{4}-\d{2}$/);
 243   return 1;
 244 };
 245
 246 ################################################################################
 247 sub SplitPeriod {
 248 ################################################################################
 249 ### split a time period YYYY-MM:YYYY-MM into start and end month
 250 ### IN : $Period: time period
 251 ### OUT: $StartMonth, Â$EndMonth
 252   my ($Period) = @_;
 253   return (undef,undef) if $Period !~ /^\d{4}-\d{2}:\d{4}-\d{2}$/;
 254   my ($StartMonth, $EndMonth) = split /:/, $Period;
 255   # switch parameters as necessary
 256   if ($EndMonth gt $StartMonth) {
 257     return ($StartMonth, $EndMonth);
 258   } else {
 259     return ($EndMonth, $StartMonth);
 260   };
 261 };
 262
 263 ################################################################################
 264 sub ListMonth {
 265 ################################################################################
 266 ### return a list of month (YYYY-MM) between start and end month
 267 ### IN : $StartMonth, $EndMonth
 268 ### OUT: @Months: array containing all months from $StartMonth to $EndMonth
 269   my ($StartMonth, $EndMonth) = @_;
 270   return (undef,undef) if ($StartMonth !~ /^\d{4}-\d{2}$/ or $EndMonth !~ /^\d{4}-\d{2}$/);
 271   # return if $StartMonth = $EndMonth
 272   return ($StartMonth) if ($StartMonth eq $EndMonth);
 273   # set $Year, $Month from $StartMonth
 274   my ($Year, $Month) = split /-/, $StartMonth;
 275   # define @Months
 276   my (@Months);
 277   until ("$Year-$Month" gt $EndMonth) {
 278     push @Months, "$Year-$Month";
 279     $Month = "$Month"; # force string context
 280     $Month++;
 281     if ($Month > 12) {
 282       $Month = '01';
 283       $Year++;
 284     };
 285   };
 286   return @Months;
 287 };
 288
 289 #####---------------------------- OutputFormats ---------------------------#####
 290
 291 ################################################################################
 292 sub OutputData {
 293 ################################################################################
 294 ### output information with formatting from DBHandle
 295 ### IN : $Format : format specifier
 296 ###      $DBQuery: database query handle with executed query,
 297 ###                containing $Month, $Key, $Value
 298 ###      $PadGroup: padding length for newsgroups field (optional) for 'pretty'
 299 ### OUT: $Output: formatted output
 300   my ($Format, $DBQuery,$PadGroup) = @_;
 301   while (my ($Month, $Key, $Value) = $DBQuery->fetchrow_array) {
 302     print &FormatOutput($Format, $Month, $Key, $Value, $PadGroup);
 303   };
 304 };
 305
 306 ################################################################################
 307 sub FormatOutput {
 308 ################################################################################
 309 ### format information for output
 310 ### IN : $Format  : format specifier
 311 ###      $PadGroup: padding length for newsgroups field (optional) for 'pretty'
 312 ###      $Month   : month (as YYYY-MM)
 313 ###      $Key     : newsgroup, client, ...
 314 ###      $Value   : number of postings with that attribute
 315 ### OUT: $Output: formatted output
 316   my ($Format, $Month, $Key, $Value, $PadGroup) = @_;
 317
 318   # define output types
 319   my %LegalOutput;
 320   @LegalOutput{('dump','dumpgroup','list','pretty')} = ();
 321   # bail out if format is unknown
 322   die "$MySelf: E: Unknown output type '$Format'!\n" if !exists($LegalOutput{$Format});
 323
 324   my ($Output);
 325   our ($LastIteration);
 326   if ($Format eq 'dump') {
 327     # output as dump (ng nnnnn)
 328     $Output = sprintf ("%s %u\n",$Key,$Value);
 329   } elsif ($Format eq 'dumpgroup') {
 330     # output as dump (YYYY-NN: nnnnn)
 331     $Output = sprintf ("%s: %5u\n",$Month,$Value);
 332   } elsif ($Format eq 'list') {
 333     # output as list (YYYY-NN: ng nnnnn)
 334     $Output = sprintf ("%s: %s %u\n",$Month,$Key,$Value);
 335   } elsif ($Format eq 'pretty') {
 336     # output as table
 337     $Output = sprintf ("----- %s:\n",$Month) if (!defined($LastIteration) or $Month ne $LastIteration);
 338     $LastIteration = $Month;
 339     $Output .= sprintf ($PadGroup ? sprintf("%%-%us %%5u\n",$PadGroup) : "%s %u\n",$Key,$Value);
 340   };
 341   return $Output;
 342 };
 343
 344 #####------------------------- QueryModifications -------------------------#####
 345
 346 ################################################################################
 347 sub SQLHierarchies {
 348 ################################################################################
 349 ### amend WHERE clause to include hierarchies
 350 ### IN : $ShowHierarchies: boolean value
 351 ### OUT: SQL code
 352   my ($ShowHierarchies) = @_;
 353   return $ShowHierarchies ? '' : "AND newsgroup NOT LIKE '%.ALL'";
 354 };
 355
 356 ################################################################################
 357 sub GetMaxLenght {
 358 ################################################################################
 359 ### get length of longest field in query
 360 ### IN : $DBHandle   : database handel
 361 ###      $Table      : table to query
 362 ###      $Field      : field to check
 363 ###      $WhereClause: WHERE clause
 364 ###      @BindVars   : bind variables for WHERE clause
 365 ### OUT: $Length: length of longest instnace of $Field
 366   my ($DBHandle,$Table,$Field,$WhereClause,@BindVars) = @_;
 367   my $DBQuery = $DBHandle->prepare(sprintf("SELECT MAX(LENGTH(%s)) FROM %s WHERE %s",$Field,$Table,$WhereClause));
 368   $DBQuery->execute(@BindVars) or warn sprintf("$MySelf: W: Can't get field length for %s from table %s: $DBI::errstr\n",$Field,$Table);
 369   my ($Length) = $DBQuery->fetchrow_array;
 370   return $Length;
 371 };
 372
 373 ################################################################################
 374 sub SQLGroupList {
 375 ################################################################################
 376 ### create part of WHERE clause for list of newsgroups separated by :
 377 ### IN : $Newsgroups: list of newsgroups (group.one.*:group.two:group.three.*)
 378 ### OUT: SQL code, list of newsgroups
 379   my ($Newsgroups) = @_;
 380   $Newsgroups =~ s/\*/%/g;
 381   return ('newsgroup LIKE ?', $Newsgroups) if $Newsgroups !~ /:/;
 382   my $SQL = '(';
 383   my @GroupList = split /:/, $Newsgroups;
 384   foreach (@GroupList) {
 385      $SQL .= ' OR ' if $SQL gt '(';
 386      $SQL .= 'newsgroup LIKE ?';
 387   };
 388   $SQL .= ')';
 389   return ($SQL,@GroupList);
 390 };
 391
 392 #####------------------------------- done ---------------------------------#####
 393 1;
 394
 395