X-Git-Url: https://code.th-h.de/?p=usenet%2Fnewsstats.git;a=blobdiff_plain;f=NewsStats.pm;h=ed76737246f29be67de050b4a0b66cf63b695630;hb=741336c210429f37bebfd9882b9461e824320cd0;hpb=4db873f74dd1585f2d0e5386bc1df03e6117d284

diff --git a/NewsStats.pm b/NewsStats.pm
new file mode 100644
index 0000000..ed76737
--- /dev/null
+++ b/NewsStats.pm
@@ -0,0 +1,395 @@
+# NewsStats.pm
+#
+# Library functions for the NewsStats package.
+#
+# Copyright (c) 2010 Thomas Hochstein <thh@inter.net>
+#
+# This module can be redistributed and/or modified under the same terms under 
+# which Perl itself is published.
+
+package NewsStats;
+
+use strict;
+use warnings;
+our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(
+  $MySelf
+  $MyVersion
+  ReadOptions
+  ReadConfig
+  OverrideConfig
+  InitDB
+);
+@EXPORT_OK = qw(
+  GetTimePeriod
+  LastMonth
+  CheckMonth
+  SplitPeriod
+  ListMonth
+  ListNewsgroups
+  OutputData
+  FormatOutput
+  SQLHierarchies
+  SQLGroupList
+  GetMaxLenght
+);
+%EXPORT_TAGS = ( TimePeriods => [qw(GetTimePeriod LastMonth CheckMonth SplitPeriod ListMonth)],
+                 Output      => [qw(OutputData FormatOutput)],
+                 SQLHelper   => [qw(SQLHierarchies SQLGroupList GetMaxLenght)]);
+$VERSION = '0.1';
+
+use Data::Dumper;
+use File::Basename;
+use Getopt::Std;
+
+use Config::Auto;
+use DBI;
+
+#####-------------------------------- Vars --------------------------------#####
+
+our $MySelf = fileparse($0, '.pl');
+our $MyVersion = "$MySelf $::VERSION (NewsStats.pm $VERSION)";
+
+#####------------------------------- Basics -------------------------------#####
+
+################################################################################
+sub ReadOptions {
+################################################################################
+### read commandline options and act on standard options
+### IN : $Params: containing list of commandline paramaters (without -h and -V)
+### OUT: a hash containing the commandline options
+  $Getopt::Std::STANDARD_HELP_VERSION = 1;
+
+  my ($Params) = @_;
+  my %Options;
+  
+  getopts('Vh'.$Params, \%Options);
+
+  # -V: display version
+  &ShowVersion if ($Options{'V'});
+
+  # -h: feed myself to perldoc
+  &ShowPOD if ($Options{'h'});
+
+  return %Options;
+};
+################################################################################
+
+################################################################################
+sub ShowVersion {
+################################################################################
+### display version and exit
+  print "$MyVersion\nCopyright (c) 2010 Thomas Hochstein <thh\@inter.net>\n";
+  print "This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.\n";
+  exit(100);
+};
+################################################################################
+
+################################################################################
+sub ShowPOD {
+################################################################################
+### feed myself to perldoc and exit
+  exec('perldoc', $0);
+  exit(100);
+};
+################################################################################
+
+################################################################################
+sub ReadConfig {
+################################################################################
+### read config via Config::Auto
+### IN : $ConfFile: config filename
+### OUT: reference to a hash containing the configuration
+  my ($ConfFile) = @_;
+  return Config::Auto::parse($ConfFile, format => 'equal');
+};
+################################################################################
+
+################################################################################
+sub OverrideConfig  {
+################################################################################
+### override configuration values
+### IN : $ConfigR  : reference to configuration hash
+###      $OverrideR: reference to a hash containing overrides
+  my ($ConfigR,$OverrideR) = @_;
+  my %Override = %$OverrideR;
+  warn "$MySelf W: Empty configuration hash passed to OverrideConfig().\n" if ( keys %$ConfigR < 1);
+  return if (keys %Override < 1 or keys %$ConfigR < 1);
+  foreach my $Key (keys %Override) {
+    $$ConfigR{$Key} = $Override{$Key};
+  };
+};
+################################################################################
+
+################################################################################
+sub InitDB {
+################################################################################
+### initialise database connection
+### IN : $ConfigR: reference to configuration hash
+###      $Die    : if TRUE, die if connection failed
+### OUT: DBHandle
+  my ($ConfigR,$Die) = @_;
+  my %Conf = %$ConfigR;
+  my $DBHandle = DBI->connect(sprintf('DBI:%s:database=%s;host=%s',$Conf{'DBDriver'},$Conf{'DBDatabase'},$Conf{'DBHost'}), $Conf{'DBUser'}, $Conf{'DBPw'}, { PrintError => 0 });
+  if (!$DBHandle) {
+    die ("$MySelf: E: $DBI::errstr\n") if (defined($Die) and $Die);
+    warn("$MySelf: W: $DBI::errstr\n");
+  };
+  return $DBHandle;
+};
+################################################################################
+
+#####------------------------------ GetStats ------------------------------#####
+
+################################################################################
+sub ListNewsgroups {
+################################################################################
+### count each newsgroup and each hierarchy level, but only once
+### IN : $Newsgroups: a list of newsgroups (content of Newsgroups:)
+### OUT: %Newsgroups: hash containing all newsgroup and hierarchy names as keys
+  my ($Newsgroups) = @_;
+  my %Newsgroups;
+  chomp($Newsgroups);
+  # remove whitespace from contents of Newsgroups:
+  $Newsgroups =~ s/\s//;
+  # call &HierarchyCount for each newsgroup in $Newsgroups:
+  for (split /,/, $Newsgroups) {
+    # add original newsgroup to %Newsgroups
+    $Newsgroups{$_} = 1;
+    # add all hierarchy elements to %Newsgroups, amended by '.ALL',
+    # i.e. de.alt.ALL and de.ALL
+    foreach (ParseHierarchies($_)) {
+      $Newsgroups{$_.'.ALL'} = 1;
+    }
+  };
+  return %Newsgroups;
+};
+
+################################################################################
+sub ParseHierarchies {
+################################################################################
+### get all hierarchies a newsgroup belongs to
+### IN : $Newsgroup  : a newsgroup name
+### OUT: @Hierarchies: array containing all hierarchies the newsgroup belongs to
+  my ($Newsgroup) = @_;
+  my @Hierarchies;
+  # strip trailing dots
+  $Newsgroup =~ s/(.+)\.+$/$1/;
+  # butcher newsgroup name by "." and add each hierarchy to @Hierarchies
+  # i.e. de.alt.test: "de.alt" and "de"
+  while ($Newsgroup =~ /\./) {
+    $Newsgroup =~ s/^((?:\.?[^.]+)*)\.[^.]+$/$1/;
+    push @Hierarchies, $Newsgroup;
+  };
+  return @Hierarchies;
+};
+
+################################################################################
+
+#####----------------------------- TimePeriods ----------------------------#####
+
+################################################################################
+sub GetTimePeriod {
+################################################################################
+### get time period using -m / -p
+### IN : $Month,$Period: contents of -m and -p
+### OUT: $StartMonth, $EndMonth
+  my ($Month,$Period) = @_;
+  # exit if -m is set and not like YYYY-MM
+  die "$MySelf: E: Wrong date format - use '$MySelf -m YYYY-MM'!\n" if not &CheckMonth($Month);
+  # default: set -m to last month
+  $Month = &LastMonth if (!defined($Month) and !defined($Period));
+  # set $StartMonth, $EndMonth
+  my ($StartMonth, $EndMonth);
+  if ($Period) {
+    # -p: get date range
+    ($StartMonth, $EndMonth) = &SplitPeriod($Period);
+    die "$MySelf: E: Wrong format for time period - use '$MySelf -p YYYY-MM:YYYY-MM'!\n" if !defined($StartMonth);
+  } else {
+    # set $StartMonth = $EndMonth = $Month if -p is not set
+    $StartMonth = $EndMonth = $Month;
+  };
+  return ($StartMonth, $EndMonth);
+};
+
+################################################################################
+sub LastMonth {
+################################################################################
+### get last month from today in YYYY-MM format
+### OUT: last month as YYYY-MM
+  # get today's date
+  my (undef,undef,undef,undef,$Month,$Year,undef,undef,undef) = localtime(time);
+  # $Month is already defined from 0 to 11, so no need to decrease it by 1
+  $Year += 1900;
+  if ($Month < 1) {
+    $Month = 12;
+    $Year--;
+  };
+  # return last month
+  return sprintf('%4d-%02d',$Year,$Month);
+};
+
+################################################################################
+sub CheckMonth {
+################################################################################
+### check for valid month
+### IN : $Month: month
+### OUT: TRUE / FALSE
+  my ($Month) = @_;
+  return 0 if (defined($Month) and $Month !~ /^\d{4}-\d{2}$/);
+  return 1;
+};
+
+################################################################################
+sub SplitPeriod {
+################################################################################
+### split a time period YYYY-MM:YYYY-MM into start and end month
+### IN : $Period: time period
+### OUT: $StartMonth, Â$EndMonth
+  my ($Period) = @_;
+  return (undef,undef) if $Period !~ /^\d{4}-\d{2}:\d{4}-\d{2}$/;
+  my ($StartMonth, $EndMonth) = split /:/, $Period;
+  # switch parameters as necessary
+  if ($EndMonth gt $StartMonth) {
+    return ($StartMonth, $EndMonth);
+  } else {
+    return ($EndMonth, $StartMonth);
+  };
+};
+
+################################################################################
+sub ListMonth {
+################################################################################
+### return a list of month (YYYY-MM) between start and end month
+### IN : $StartMonth, $EndMonth
+### OUT: @Months: array containing all months from $StartMonth to $EndMonth
+  my ($StartMonth, $EndMonth) = @_;
+  return (undef,undef) if ($StartMonth !~ /^\d{4}-\d{2}$/ or $EndMonth !~ /^\d{4}-\d{2}$/);
+  # return if $StartMonth = $EndMonth
+  return ($StartMonth) if ($StartMonth eq $EndMonth);
+  # set $Year, $Month from $StartMonth
+  my ($Year, $Month) = split /-/, $StartMonth;
+  # define @Months
+  my (@Months);
+  until ("$Year-$Month" gt $EndMonth) {
+    push @Months, "$Year-$Month";
+    $Month = "$Month"; # force string context
+    $Month++;
+    if ($Month > 12) {
+      $Month = '01';
+      $Year++;
+    };
+  };
+  return @Months;
+};
+
+#####---------------------------- OutputFormats ---------------------------#####
+
+################################################################################
+sub OutputData {
+################################################################################
+### output information with formatting from DBHandle
+### IN : $Format : format specifier
+###      $DBQuery: database query handle with executed query,
+###                containing $Month, $Key, $Value
+###      $PadGroup: padding length for newsgroups field (optional) for 'pretty'
+### OUT: $Output: formatted output
+  my ($Format, $DBQuery,$PadGroup) = @_;
+  while (my ($Month, $Key, $Value) = $DBQuery->fetchrow_array) {
+    print &FormatOutput($Format, $Month, $Key, $Value, $PadGroup);
+  };
+};
+
+################################################################################
+sub FormatOutput {
+################################################################################
+### format information for output
+### IN : $Format  : format specifier
+###      $PadGroup: padding length for newsgroups field (optional) for 'pretty'
+###      $Month   : month (as YYYY-MM)
+###      $Key     : newsgroup, client, ...
+###      $Value   : number of postings with that attribute
+### OUT: $Output: formatted output
+  my ($Format, $Month, $Key, $Value, $PadGroup) = @_;
+
+  # define output types
+  my %LegalOutput;
+  @LegalOutput{('dump','dumpgroup','list','pretty')} = ();
+  # bail out if format is unknown
+  die "$MySelf: E: Unknown output type '$Format'!\n" if !exists($LegalOutput{$Format});
+
+  my ($Output);
+  our ($LastIteration);
+  if ($Format eq 'dump') {
+    # output as dump (ng nnnnn)
+    $Output = sprintf ("%s %u\n",$Key,$Value);
+  } elsif ($Format eq 'dumpgroup') {
+    # output as dump (YYYY-NN: nnnnn)
+    $Output = sprintf ("%s: %5u\n",$Month,$Value);
+  } elsif ($Format eq 'list') {
+    # output as list (YYYY-NN: ng nnnnn)
+    $Output = sprintf ("%s: %s %u\n",$Month,$Key,$Value);
+  } elsif ($Format eq 'pretty') {
+    # output as table
+    $Output = sprintf ("----- %s:\n",$Month) if (!defined($LastIteration) or $Month ne $LastIteration);
+    $LastIteration = $Month;
+    $Output .= sprintf ($PadGroup ? sprintf("%%-%us %%5u\n",$PadGroup) : "%s %u\n",$Key,$Value);
+  };
+  return $Output;
+};
+
+#####------------------------- QueryModifications -------------------------#####
+
+################################################################################
+sub SQLHierarchies {
+################################################################################
+### amend WHERE clause to include hierarchies
+### IN : $ShowHierarchies: boolean value
+### OUT: SQL code
+  my ($ShowHierarchies) = @_;
+  return $ShowHierarchies ? '' : "AND newsgroup NOT LIKE '%.ALL'";
+};
+
+################################################################################
+sub GetMaxLenght {
+################################################################################
+### get length of longest field in query
+### IN : $DBHandle   : database handel
+###      $Table      : table to query
+###      $Field      : field to check
+###      $WhereClause: WHERE clause
+###      @BindVars   : bind variables for WHERE clause
+### OUT: $Length: length of longest instnace of $Field
+  my ($DBHandle,$Table,$Field,$WhereClause,@BindVars) = @_;
+  my $DBQuery = $DBHandle->prepare(sprintf("SELECT MAX(LENGTH(%s)) FROM %s WHERE %s",$Field,$Table,$WhereClause));
+  $DBQuery->execute(@BindVars) or warn sprintf("$MySelf: W: Can't get field length for %s from table %s: $DBI::errstr\n",$Field,$Table);
+  my ($Length) = $DBQuery->fetchrow_array;
+  return $Length;
+};
+
+################################################################################
+sub SQLGroupList {
+################################################################################
+### create part of WHERE clause for list of newsgroups separated by :
+### IN : $Newsgroups: list of newsgroups (group.one.*:group.two:group.three.*)
+### OUT: SQL code, list of newsgroups
+  my ($Newsgroups) = @_;
+  $Newsgroups =~ s/\*/%/g;
+  return ('newsgroup LIKE ?', $Newsgroups) if $Newsgroups !~ /:/;
+  my $SQL = '(';
+  my @GroupList = split /:/, $Newsgroups;
+  foreach (@GroupList) {
+     $SQL .= ' OR ' if $SQL gt '(';
+     $SQL .= 'newsgroup LIKE ?';
+  };
+  $SQL .= ')';
+  return ($SQL,@GroupList);
+};
+
+#####------------------------------- done ---------------------------------#####
+1;
+
+