[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
  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.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)
### 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 {
################################################################################
### 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;
};

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

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