[usenet/newsstats.git] / NewsStats.pm

# 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
  $PackageVersion
  ReadOptions
  ReadConfig
  OverrideConfig
  InitDB
);
@EXPORT_OK = qw(
  GetTimePeriod
  LastMonth
  CheckMonth
  SplitPeriod
  ListMonth
  ListNewsgroups
  ReadGroupList
  OutputData
  FormatOutput
  SQLHierarchies
  SQLGroupList
  GetMaxLength
);
%EXPORT_TAGS = ( TimePeriods => [qw(GetTimePeriod LastMonth CheckMonth SplitPeriod ListMonth)],
                 Output      => [qw(OutputData FormatOutput)],
                 SQLHelper   => [qw(SQLHierarchies SQLGroupList GetMaxLength)]);
$VERSION = '0.01';
our $PackageVersion = '0.01';

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 -h and -V
### IN : $Params: list of legal 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 "NewsStats v$PackageVersion\n$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;
  # Config hash empty?
  warn "$MySelf W: Empty configuration hash passed to OverrideConfig().\n" if ( keys %$ConfigR < 1);
  # return if no overrides
  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 fails
### 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 {
################################################################################
### explode a (scalar) list of newsgroup names to a list of newsgroup and
### hierarchy names where every newsgroup and hierarchy appears only once:
### de.alt.test,de.alt.admin -> de.ALL, de.alt.ALL, de.alt.test, de.alt.admin
### IN : $Newsgroups  : a list of newsgroups (content of Newsgroups: header)
###      $TLH         : top level hierarchy (all other newsgroups are ignored)
###      $ValidGroupsR: reference to a hash containing all valid newsgroups
###                     as keys
### OUT: %Newsgroups  : hash containing all newsgroup and hierarchy names as keys
  my ($Newsgroups,$TLH,$ValidGroupsR) = @_;
  my %ValidGroups = %{$ValidGroupsR} if $ValidGroupsR;
  my %Newsgroups;
  chomp($Newsgroups);
  # remove whitespace from contents of Newsgroups:
  $Newsgroups =~ s/\s//;
  # call &HierarchyCount for each newsgroup in $Newsgroups:
  for (split /,/, $Newsgroups) {
    # don't count newsgroup/hierarchy in wrong TLH
    next if($TLH and !/^$TLH/);
    # don't count invalid newsgroups
    if(%ValidGroups and !defined($ValidGroups{$_})) {
      warn (sprintf("DROPPED: %s\n",$_));
      next;
    }
    # 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 {
################################################################################
### return a list of all hierarchy levels a newsgroup belongs to
### (for de.alt.test.moderated that would be de/de.alt/de.alt.test)
### 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;
};

################################################################################
sub ReadGroupList {
################################################################################
### read a list of valid newsgroups from file (each group on one line,
### ignoring everything after the first whitespace and so accepting files
### in checkgroups format as well as (parts of) an INN active file)
### IN : $Filename    : file to read
### OUT: \%ValidGroups: hash containing all valid newsgroups
  my ($Filename) = @_;
  my %ValidGroups;
  open (my $LIST,"<$Filename") or die "$MySelf: E: Cannot read $Filename: $!\n";
  while (<$LIST>) {
    s/^(\S+).*$/$1/;
    chomp;
    $ValidGroups{$_} = '1';
  };
  close $LIST;
  return \%ValidGroups;
};

################################################################################

#####----------------------------- TimePeriods ----------------------------#####

################################################################################
sub GetTimePeriod {
################################################################################
### get a time period to act on, in order of preference: by default the
### last month; or a month submitted by -m YYYY-MM; or a time period submitted
### by -p YYYY-MM:YYYY-MM
### IN : $Month,$Period: contents of -m and -p
### OUT: $StartMonth, $EndMonth (identical if period is just one month)
  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);
  # warn if -m and -p is set
  warn "$MySelf: W: Time period assigned by '-p' takes precendece over month assigned by '-m'.\n" if ($Month && $Period);
  # 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 todays date 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 if input is a valid month in YYYY-MM form
### 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 denoted by YYYY-MM:YYYY-MM into start and end month
### IN : $Period: time period
Commit	Line	Data
	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	$PackageVersion
	22	ReadOptions
	23	ReadConfig
	24	OverrideConfig
	25	InitDB
	26	);
	27	@EXPORT_OK = qw(
	28	GetTimePeriod
	29	LastMonth
	30	CheckMonth
	31	SplitPeriod
	32	ListMonth
	33	ListNewsgroups
	34	ReadGroupList
	35	OutputData
	36	FormatOutput
	37	SQLHierarchies
	38	SQLGroupList
	39	GetMaxLength
	40	);
	41	%EXPORT_TAGS = ( TimePeriods => [qw(GetTimePeriod LastMonth CheckMonth SplitPeriod ListMonth)],
	42	Output => [qw(OutputData FormatOutput)],
	43	SQLHelper => [qw(SQLHierarchies SQLGroupList GetMaxLength)]);
	44	$VERSION = '0.01';
	45	our $PackageVersion = '0.01';
	46
	47	use Data::Dumper;
	48	use File::Basename;
	49	use Getopt::Std;
	50
	51	use Config::Auto;
	52	use DBI;
	53
	54	#####-------------------------------- Vars --------------------------------#####
	55
	56	our $MySelf = fileparse($0, '.pl');
	57	our $MyVersion = "$MySelf $::VERSION (NewsStats.pm $VERSION)";
	58
	59	#####------------------------------- Basics -------------------------------#####
	60
	61	################################################################################
	62	sub ReadOptions {
	63	################################################################################
	64	### read commandline options and act on standard options -h and -V
	65	### IN : $Params: list of legal commandline paramaters (without -h and -V)
	66	### OUT: a hash containing the commandline options
	67	$Getopt::Std::STANDARD_HELP_VERSION = 1;
	68
	69	my ($Params) = @_;
	70	my %Options;
	71
	72	getopts('Vh'.$Params, \%Options);
	73
	74	# -V: display version
	75	&ShowVersion if ($Options{'V'});
	76
	77	# -h: feed myself to perldoc
	78	&ShowPOD if ($Options{'h'});
	79
	80	return %Options;
	81	};
	82	################################################################################
	83
	84	################################################################################
	85	sub ShowVersion {
	86	################################################################################
	87	### display version and exit
	88	print "NewsStats v$PackageVersion\n$MyVersion\nCopyright (c) 2010 Thomas Hochstein <thh\@inter.net>\n";
	89	print "This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.\n";
	90	exit(100);
	91	};
	92	################################################################################
	93
	94	################################################################################
	95	sub ShowPOD {
	96	################################################################################
	97	### feed myself to perldoc and exit
	98	exec('perldoc', $0);
	99	exit(100);
	100	};
	101	################################################################################
	102
	103	################################################################################
	104	sub ReadConfig {
	105	################################################################################
	106	### read config via Config::Auto
	107	### IN : $ConfFile: config filename
	108	### OUT: reference to a hash containing the configuration
	109	my ($ConfFile) = @_;
	110	return Config::Auto::parse($ConfFile, format => 'equal');
	111	};
	112	################################################################################
	113
	114	################################################################################
	115	sub OverrideConfig {
	116	################################################################################
	117	### override configuration values
	118	### IN : $ConfigR : reference to configuration hash
	119	### $OverrideR: reference to a hash containing overrides
	120	my ($ConfigR,$OverrideR) = @_;
	121	my %Override = %$OverrideR;
	122	# Config hash empty?
	123	warn "$MySelf W: Empty configuration hash passed to OverrideConfig().\n" if ( keys %$ConfigR < 1);
	124	# return if no overrides
	125	return if (keys %Override < 1 or keys %$ConfigR < 1);
	126	foreach my $Key (keys %Override) {
	127	$$ConfigR{$Key} = $Override{$Key};
	128	};
	129	};
	130	################################################################################
	131
	132	################################################################################
	133	sub InitDB {
	134	################################################################################
	135	### initialise database connection
	136	### IN : $ConfigR: reference to configuration hash
	137	### $Die : if TRUE, die if connection fails
	138	### OUT: DBHandle
	139	my ($ConfigR,$Die) = @_;
	140	my %Conf = %$ConfigR;
	141	my $DBHandle = DBI->connect(sprintf('DBI:%s:database=%s;host=%s',$Conf{'DBDriver'},$Conf{'DBDatabase'},$Conf{'DBHost'}), $Conf{'DBUser'}, $Conf{'DBPw'}, { PrintError => 0 });
	142	if (!$DBHandle) {
	143	die ("$MySelf: E: $DBI::errstr\n") if (defined($Die) and $Die);
	144	warn("$MySelf: W: $DBI::errstr\n");
	145	};
	146	return $DBHandle;
	147	};
	148	################################################################################
	149
	150	#####------------------------------ GetStats ------------------------------#####
	151
	152	################################################################################
	153	sub ListNewsgroups {
	154	################################################################################
	155	### explode a (scalar) list of newsgroup names to a list of newsgroup and
	156	### hierarchy names where every newsgroup and hierarchy appears only once:
	157	### de.alt.test,de.alt.admin -> de.ALL, de.alt.ALL, de.alt.test, de.alt.admin
	158	### IN : $Newsgroups : a list of newsgroups (content of Newsgroups: header)
	159	### $TLH : top level hierarchy (all other newsgroups are ignored)
	160	### $ValidGroupsR: reference to a hash containing all valid newsgroups
	161	### as keys
	162	### OUT: %Newsgroups : hash containing all newsgroup and hierarchy names as keys
	163	my ($Newsgroups,$TLH,$ValidGroupsR) = @_;
	164	my %ValidGroups = %{$ValidGroupsR} if $ValidGroupsR;
	165	my %Newsgroups;
	166	chomp($Newsgroups);
	167	# remove whitespace from contents of Newsgroups:
	168	$Newsgroups =~ s/\s//;
	169	# call &HierarchyCount for each newsgroup in $Newsgroups:
	170	for (split /,/, $Newsgroups) {
	171	# don't count newsgroup/hierarchy in wrong TLH
	172	next if($TLH and !/^$TLH/);
	173	# don't count invalid newsgroups
	174	if(%ValidGroups and !defined($ValidGroups{$_})) {
	175	warn (sprintf("DROPPED: %s\n",$_));
	176	next;
	177	}
	178	# add original newsgroup to %Newsgroups
	179	$Newsgroups{$_} = 1;
	180	# add all hierarchy elements to %Newsgroups, amended by '.ALL',
	181	# i.e. de.alt.ALL and de.ALL
	182	foreach (ParseHierarchies($_)) {
	183	$Newsgroups{$_.'.ALL'} = 1;
	184	}
	185	};
	186	return %Newsgroups;
	187	};
	188
	189	################################################################################
	190	sub ParseHierarchies {
	191	################################################################################
	192	### return a list of all hierarchy levels a newsgroup belongs to
	193	### (for de.alt.test.moderated that would be de/de.alt/de.alt.test)
	194	### IN : $Newsgroup : a newsgroup name
	195	### OUT: @Hierarchies: array containing all hierarchies the newsgroup belongs to
	196	my ($Newsgroup) = @_;
	197	my @Hierarchies;
	198	# strip trailing dots
	199	$Newsgroup =~ s/(.+)\.+$/$1/;
	200	# butcher newsgroup name by "." and add each hierarchy to @Hierarchies
	201	# i.e. de.alt.test: "de.alt" and "de"
	202	while ($Newsgroup =~ /\./) {
	203	$Newsgroup =~ s/^((?:\.?[^.]+)*)\.[^.]+$/$1/;
	204	push @Hierarchies, $Newsgroup;
	205	};
	206	return @Hierarchies;
	207	};
	208
	209	################################################################################
	210	sub ReadGroupList {
	211	################################################################################
	212	### read a list of valid newsgroups from file (each group on one line,
	213	### ignoring everything after the first whitespace and so accepting files
	214	### in checkgroups format as well as (parts of) an INN active file)
	215	### IN : $Filename : file to read
	216	### OUT: \%ValidGroups: hash containing all valid newsgroups
	217	my ($Filename) = @_;
	218	my %ValidGroups;
	219	open (my $LIST,"<$Filename") or die "$MySelf: E: Cannot read $Filename: $!\n";
	220	while (<$LIST>) {
	221	s/^(\S+).*$/$1/;
	222	chomp;
	223	$ValidGroups{$_} = '1';
	224	};
	225	close $LIST;
	226	return \%ValidGroups;
	227	};
	228
	229	################################################################################
	230
	231	#####----------------------------- TimePeriods ----------------------------#####
	232
	233	################################################################################
	234	sub GetTimePeriod {
	235	################################################################################
	236	### get a time period to act on, in order of preference: by default the
	237	### last month; or a month submitted by -m YYYY-MM; or a time period submitted
	238	### by -p YYYY-MM:YYYY-MM
	239	### IN : $Month,$Period: contents of -m and -p
	240	### OUT: $StartMonth, $EndMonth (identical if period is just one month)
	241	my ($Month,$Period) = @_;
	242	# exit if -m is set and not like YYYY-MM
	243	die "$MySelf: E: Wrong date format - use '$MySelf -m YYYY-MM'!\n" if not &CheckMonth($Month);
	244	# warn if -m and -p is set
	245	warn "$MySelf: W: Time period assigned by '-p' takes precendece over month assigned by '-m'.\n" if ($Month && $Period);
	246	# default: set -m to last month
	247	$Month = &LastMonth if (!defined($Month) and !defined($Period));
	248	# set $StartMonth, $EndMonth
	249	my ($StartMonth, $EndMonth);
	250	if ($Period) {
	251	# -p: get date range
	252	($StartMonth, $EndMonth) = &SplitPeriod($Period);
	253	die "$MySelf: E: Wrong format for time period - use '$MySelf -p YYYY-MM:YYYY-MM'!\n" if !defined($StartMonth);
	254	} else {
	255	# set $StartMonth = $EndMonth = $Month if -p is not set
	256	$StartMonth = $EndMonth = $Month;
	257	};
	258	return ($StartMonth, $EndMonth);
	259	};
	260
	261	################################################################################
	262	sub LastMonth {
	263	################################################################################
	264	### get last month from todays date in YYYY-MM format
	265	### OUT: last month as YYYY-MM
	266	# get today's date
	267	my (undef,undef,undef,undef,$Month,$Year,undef,undef,undef) = localtime(time);
	268	# $Month is already defined from 0 to 11, so no need to decrease it by 1
	269	$Year += 1900;
	270	if ($Month < 1) {
	271	$Month = 12;
	272	$Year--;
	273	};
	274	# return last month
	275	return sprintf('%4d-%02d',$Year,$Month);
	276	};
	277
	278	################################################################################
	279	sub CheckMonth {
	280	################################################################################
	281	### check if input is a valid month in YYYY-MM form
	282	### IN : $Month: month
	283	### OUT: TRUE / FALSE
	284	my ($Month) = @_;
	285	return 0 if (defined($Month) and $Month !~ /^\d{4}-\d{2}$/);
	286	return 1;
	287	};
	288
	289	################################################################################
	290	sub SplitPeriod {
	291	################################################################################
	292	### split a time period denoted by YYYY-MM:YYYY-MM into start and end month
	293	### IN : $Period: time period
	294