[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
  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);
  # 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 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
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
	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);
b221278d TH	203	# warn if -m and -p is set
b221278d TH	204	warn "$MySelf: W: Time period assigned by '-p' takes precendece over month assigned by '-m'.\n" if ($Month && $Period);
741336c2 TH	205	# default: set -m to last month
	206	$Month = &LastMonth if (!defined($Month) and !defined($Period));
	207	# set $StartMonth, $EndMonth
	208	my ($StartMonth, $EndMonth);
	209	if ($Period) {
	210	# -p: get date range
	211	($StartMonth, $EndMonth) = &SplitPeriod($Period);
	212	die "$MySelf: E: Wrong format for time period - use '$MySelf -p YYYY-MM:YYYY-MM'!\n" if !defined($StartMonth);
	213	} else {
	214	# set $StartMonth = $EndMonth = $Month if -p is not set
	215	$StartMonth = $EndMonth = $Month;
	216	};
	217	return ($StartMonth, $EndMonth);
	218	};
	219
	220	################################################################################
	221	sub LastMonth {
	222	################################################################################
	223	### get last month from today in YYYY-MM format
	224	### OUT: last month as YYYY-MM
	225	# get today's date
	226	my (undef,undef,undef,undef,$Month,$Year,undef,undef,undef) = localtime(time);
	227	# $Month is already defined from 0 to 11, so no need to decrease it by 1
	228	$Year += 1900;
	229	if ($Month < 1) {
	230	$Month = 12;
	231	$Year--;
	232	};
	233	# return last month
	234	return sprintf('%4d-%02d',$Year,$Month);
	235	};
	236
	237	################################################################################
	238	sub CheckMonth {
	239	################################################################################
	240	### check for valid month
	241	### IN : $Month: month
	242	### OUT: TRUE / FALSE
	243	my ($Month) = @_;
	244	return 0 if (defined($Month) and $Month !~ /^\d{4}-\d{2}$/);
	245	return 1;
	246	};
	247
	248	################################################################################
	249	sub SplitPeriod {
	250	################################################################################
	251	### split a time period YYYY-MM:YYYY-MM into start and end month
	252	### IN : $Period: time period
	253