thh/newsstats
1
0
Fork 0
Code Issues 4 Pull requests Packages Projects Releases Activity

Adapt gatherstats.pl to new coding style.

Browse source 
* Switch to Getopt::Long, change coding style;
      limit line length.

* Replace 'die' and 'warn' by calls to &Bleat().

* Completely changed options due to new
  GetOpt::Long processing.
  - merged -m/-p into --month

* Adapt to changes in NewsStats.pm

* Redo documentation.

* Update TODO.

Signed-off-by: Thomas Hochstein <thh@inter.net>
This commit is contained in:
Thomas Hochstein 2012-05-07 20:29:25 +02:00
parent edd250f265
commit 880c3eb227
3 changed files with 127 additions and 101 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
NewsStats.pm
View file

@ -343,13 +343,13 @@ sub SplitPeriod {
sub ListMonth { sub ListMonth {
################################################################################ ################################################################################
### return a list of months (YYYY-MM) between start and end month ### return a list of months (YYYY-MM) between start and end month
### IN : $StartMonth, $EndMonth ### IN : $MonthExpression ('YYYY-MM' or 'YYYY-MM to YYYY-MM')
### OUT: @Months: array containing all months from $StartMonth to $EndMonth ### OUT: @Months: array containing all months from $MonthExpression enumerated
my ($StartMonth, $EndMonth) = @_; my ($MonthExpression )= @_;
return (undef,undef) # return if single month
if ($StartMonth !~ /^\d{4}-\d{2}$/ or $EndMonth !~ /^\d{4}-\d{2}$/); return ($MonthExpression) if ($MonthExpression =~ /^\d{4}-\d{2}$/);
# return if $StartMonth = $EndMonth # parse $MonthExpression
return ($StartMonth) if ($StartMonth eq $EndMonth); my ($StartMonth, $EndMonth) = split(' to ',$MonthExpression);
# set $Year, $Month from $StartMonth # set $Year, $Month from $StartMonth
my ($Year, $Month) = split /-/, $StartMonth; my ($Year, $Month) = split /-/, $StartMonth;
# define @Months # define @Months

2
doc/TODO
View file

@ -42,6 +42,7 @@ Bug numbers refer to the Mantis issue tracker at <http://bugs.th-h.de/>.
names - would be nice. names - would be nice.
+ install/install.pl + install/install.pl
- Complete rewrite (like groupstats.pl, include changes in NewsStats.pm)
- Add / enhance / test error handling - Add / enhance / test error handling
- General tests and optimisations - General tests and optimisations
@ -54,7 +55,6 @@ Bug numbers refer to the Mantis issue tracker at <http://bugs.th-h.de/>.
- General tests and optimisations - General tests and optimisations
+ gatherstats.pl + gatherstats.pl
- Complete rewrite (like groupstats.pl, include changes in NewsStats.pm)
- Use hierarchy information (see GroupInfo above) - Use hierarchy information (see GroupInfo above)
- Add gathering of other stats (clients, hosts, ...) - Add gathering of other stats (clients, hosts, ...)
- better modularisation (code reuse for other reports!) - better modularisation (code reuse for other reports!)

212
gatherstats.pl
View file

@ -7,7 +7,7 @@
# #
# It is part of the NewsStats package. # It is part of the NewsStats package.
# #
# Copyright (c) 2010 Thomas Hochstein <thh@inter.net> # Copyright (c) 2010-2012 Thomas Hochstein <thh@inter.net>
# #
# It can be redistributed and/or modified under the same terms under # It can be redistributed and/or modified under the same terms under
# which Perl itself is published. # which Perl itself is published.
@ -22,37 +22,56 @@ use strict;
use NewsStats qw(:DEFAULT :TimePeriods ListNewsgroups ReadGroupList); use NewsStats qw(:DEFAULT :TimePeriods ListNewsgroups ReadGroupList);
use DBI; use DBI;
use Getopt::Long qw(GetOptions);
Getopt::Long::config ('bundling');
################################# Definitions ################################## ################################# Definitions ##################################
# define types of information that can be gathered # define types of information that can be gathered
# all / groups (/ clients / hosts) # all / groups (/ clients / hosts)
my %LegalTypes; my %LegalStats;
@LegalTypes{('all','groups')} = (); @LegalStats{('all','groups')} = ();
################################# Main program ################################# ################################# Main program #################################
### read commandline options ### read commandline options
my %Options = &ReadOptions('dom:p:t:l:n:r:g:c:s:'); my ($OptCheckgroupsFile,$OptClientsDB,$OptDebug,$OptGroupsDB,$OptTLH,
$OptHostsDB,$OptMonth,$OptRawDB,$OptStatsType,$OptTest);
GetOptions ('c|checkgroups=s' => \$OptCheckgroupsFile,
'clientsdb=s' => \$OptClientsDB,
'd|debug!' => \$OptDebug,
'groupsdb=s' => \$OptGroupsDB,
'hierarchy=s' => \$OptTLH,
'hostsdb=s' => \$OptHostsDB,
'm|month=s' => \$OptMonth,
'rawdb=s' => \$OptRawDB,
's|stats=s' => \$OptStatsType,
't|test!' => \$OptTest,
'h|help' => \&ShowPOD,
'V|version' => \&ShowVersion) or exit 1;
### read configuration ### read configuration
my %Conf = %{ReadConfig('newsstats.conf')}; my %Conf = %{ReadConfig($HomePath.'/newsstats.conf')};
### override configuration via commandline options ### override configuration via commandline options
my %ConfOverride; my %ConfOverride;
$ConfOverride{'DBTableRaw'} = $Options{'r'} if $Options{'r'}; $ConfOverride{'DBTableRaw'} = $OptRawDB if $OptRawDB;
$ConfOverride{'DBTableGrps'} = $Options{'g'} if $Options{'g'}; $ConfOverride{'DBTableGrps'} = $OptGroupsDB if $OptGroupsDB;
$ConfOverride{'DBTableClnts'} = $Options{'c'} if $Options{'c'}; $ConfOverride{'DBTableClnts'} = $OptClientsDB if $OptClientsDB;
$ConfOverride{'DBTableHosts'} = $Options{'s'} if $Options{'s'}; $ConfOverride{'DBTableHosts'} = $OptHostsDB if $OptHostsDB;
$ConfOverride{'TLH'} = $Options{'n'} if $Options{'n'}; $ConfOverride{'TLH'} = $OptTLH if $OptTLH;
&OverrideConfig(\%Conf,\%ConfOverride); &OverrideConfig(\%Conf,\%ConfOverride);
### get type of information to gather, defaulting to 'all' ### get type of information to gather, defaulting to 'all'
$Options{'t'} = 'all' if !$Options{'t'}; $OptStatsType = 'all' if !$OptStatsType;
die "$MySelf: E: Unknown type '-t $Options{'t'}'!\n" if !exists($LegalTypes{$Options{'t'}}); &Bleat(2, sprintf("Unknown type '%s'!", $OptStatsType))
if !exists($LegalStats{$OptStatsType});
### get time period (-m or -p) ### get time period from --month
my ($StartMonth,$EndMonth) = &GetTimePeriod($Options{'m'},$Options{'p'}); # get verbal description of time period, drop SQL code
my ($Period) = &GetTimePeriod($OptMonth);
&Bleat(2,"--month option has an invalid format - please use 'YYYY-MM' or ".
"'YYYY-MM:YYYY-MM'!") if (!$Period or $Period eq 'all time');
### reformat $Conf{'TLH'} ### reformat $Conf{'TLH'}
my $TLH; my $TLH;
@ -67,45 +86,55 @@ if ($Conf{'TLH'}) {
# strip whitespace # strip whitespace
$TLH =~ s/\s//g; $TLH =~ s/\s//g;
# check for illegal characters # check for illegal characters
die "$MySelf: E: Config error - illegal characters in TLH definition\n" if ($TLH !~ /^[a-zA-Z0-9:]+$/); &Bleat(2,'Config error - illegal characters in TLH definition!')
if ($TLH !~ /^[a-zA-Z0-9:]+$/);
if ($TLH =~ /:/) { if ($TLH =~ /:/) {
# reformat $TLH form a:b to (a)|(b) # reformat $TLH from a:b to (a)|(b),
# e.g. replace '.' by '|'
$TLH =~ s/:/)|(/g; $TLH =~ s/:/)|(/g;
$TLH = '(' . $TLH . ')'; $TLH = '(' . $TLH . ')';
}; };
}; };
### read newsgroups list from -l # read list of newsgroups from --checkgroups
my %ValidGroups = %{&ReadGroupList($Options{'l'})} if $Options{'l'}; # into a hash
my %ValidGroups = %{ReadGroupList($OptCheckgroupsFile)} if $OptCheckgroupsFile;
### init database ### init database
my $DBHandle = InitDB(\%Conf,1); my $DBHandle = InitDB(\%Conf,1);
### get data for each month ### get data for each month
warn "$MySelf: W: Output only mode. Database is not updated.\n" if $Options{'o'}; &Bleat(1,'Test mode. Database is not updated.') if $OptTest;
foreach my $Month (&ListMonth($StartMonth,$EndMonth)) { foreach my $Month (&ListMonth($Period)) {
print "---------- $Month ----------\n" if $Options{'d'}; print "---------- $Month ----------\n" if $OptDebug;
if ($Options{'t'} eq 'all' or $Options{'t'} eq 'groups') { if ($OptStatsType eq 'all' or $OptStatsType eq 'groups') {
### ---------------------------------------------- ### ----------------------------------------------
### get groups data (number of postings per group) ### get groups data (number of postings per group)
# get groups data from raw table for given month # get groups data from raw table for given month
my $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s.%s WHERE day LIKE ? AND NOT disregard",$Conf{'DBDatabase'},$Conf{'DBTableRaw'})); my $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s.%s ".
$DBQuery->execute($Month.'-%') or die sprintf("$MySelf: E: Can't get groups data for %s from %s.%s: $DBI::errstr\n",$Month,$Conf{'DBDatabase'},$Conf{'DBTableRaw'}); "WHERE day LIKE ? AND NOT disregard",
$Conf{'DBDatabase'},
$Conf{'DBTableRaw'}));
$DBQuery->execute($Month.'-%')
or &Bleat(2,sprintf("Can't get groups data for %s from %s.%s: ".
"$DBI::errstr\n",$Month,
$Conf{'DBDatabase'},$Conf{'DBTableRaw'}));
# count postings per group # count postings per group
my %Postings; my %Postings;
while (($_) = $DBQuery->fetchrow_array) { while (($_) = $DBQuery->fetchrow_array) {
# get list oft newsgroups and hierarchies from Newsgroups: # get list oft newsgroups and hierarchies from Newsgroups:
my %Newsgroups = ListNewsgroups($_,$TLH,$Options{'l'} ? \%ValidGroups : ''); my %Newsgroups = ListNewsgroups($_,$TLH,
$OptCheckgroupsFile ? \%ValidGroups : '');
# count each newsgroup and hierarchy once # count each newsgroup and hierarchy once
foreach (sort keys %Newsgroups) { foreach (sort keys %Newsgroups) {
$Postings{$_}++; $Postings{$_}++;
}; };
}; };
# add valid but empty groups if -l is set # add valid but empty groups if --checkgroups is set
if (%ValidGroups) { if (%ValidGroups) {
foreach (sort keys %ValidGroups) { foreach (sort keys %ValidGroups) {
if (!defined($Postings{$_})) { if (!defined($Postings{$_})) {
@ -116,19 +145,29 @@ foreach my $Month (&ListMonth($StartMonth,$EndMonth)) {
}; };
# delete old data for that month # delete old data for that month
if (!$Options{'o'}) { if (!$OptTest) {
$DBQuery = $DBHandle->do(sprintf("DELETE FROM %s.%s WHERE month = ?",$Conf{'DBDatabase'},$Conf{'DBTableGrps'}),undef,$Month) $DBQuery = $DBHandle->do(sprintf("DELETE FROM %s.%s WHERE month = ?",
or warn sprintf("$MySelf: E: Can't delete old groups data for %s from %s.%s: $DBI::errstr\n",$Month,$Conf{'DBDatabase'},$Conf{'DBTableGrps'}); $Conf{'DBDatabase'},$Conf{'DBTableGrps'}),
undef,$Month)
or &Bleat(2,sprintf("Can't delete old groups data for %s from %s.%s: ".
"$DBI::errstr\n",$Month,
$Conf{'DBDatabase'},$Conf{'DBTableGrps'}));
}; };
print "----- GroupStats -----\n" if $Options{'d'}; print "----- GroupStats -----\n" if $OptDebug;
foreach my $Newsgroup (sort keys %Postings) { foreach my $Newsgroup (sort keys %Postings) {
print "$Newsgroup => $Postings{$Newsgroup}\n" if $Options{'d'}; print "$Newsgroup => $Postings{$Newsgroup}\n" if $OptDebug;
if (!$Options{'o'}) { if (!$OptTest) {
# write to database # write to database
$DBQuery = $DBHandle->prepare(sprintf("INSERT INTO %s.%s (month,newsgroup,postings) VALUES (?, ?, ?)",$Conf{'DBDatabase'},$Conf{'DBTableGrps'})); $DBQuery = $DBHandle->prepare(sprintf("INSERT INTO %s.%s ".
# $DBQuery = $DBHandle->prepare(sprintf("REPLACE INTO %s.%s (month,newsgroup,postings) VALUES (?, ?, ?)",$Conf{'DBDatabase'},$Conf{'DBTableGrps'})); "(month,newsgroup,postings) ".
$DBQuery->execute($Month, $Newsgroup, $Postings{$Newsgroup}) or die sprintf("$MySelf: E: Can't write groups data for %s/%s to %s.%s: $DBI::errstr\n",$Month,$Newsgroup,$Conf{'DBDatabase'},$Conf{'DBTableGrps'}); "VALUES (?, ?, ?)",
$Conf{'DBDatabase'},
$Conf{'DBTableGrps'}));
$DBQuery->execute($Month, $Newsgroup, $Postings{$Newsgroup})
or &Bleat(2,sprintf("Can't write groups data for %s/%s to %s.%s: ".
"$DBI::errstr\n",$Month,$Newsgroup,
$Conf{'DBDatabase'},$Conf{'DBTableGrps'}));
$DBQuery->finish; $DBQuery->finish;
}; };
}; };
@ -150,43 +189,31 @@ gatherstats - process statistical data from a raw source
=head1 SYNOPSIS =head1 SYNOPSIS
B<gatherstats> [B<-Vhdo>] [B<-m> I<YYYY-MM>] [B<-p> I<YYYY-MM:YYYY-MM>] [B<-t> I<type>] [B<-l> I<filename>] [B<-n> I<TLH>] [B<-r> I<database table>] [B<-g> I<database table>] [B<-c> I<database table>] [B<-s> I<database table>] B<gatherstats> [B<-Vhdt>] [B<-m> I<YYYY-MM> | I<YYYY-MM:YYYY-MM>] [B<-s> I<stats] [B<-c> I<checkgroups file>]] [B<--hierarchy> I<TLH>] [B<--rawdb> I<database table>] [B<-groupsdb> I<database table>] [B<--clientsdb> I<database table>] [B<--hostsdb> I<database table>]
=head1 REQUIREMENTS =head1 REQUIREMENTS
See doc/README: Perl 5.8.x itself and the following modules from CPAN: See L<doc/README>.
=over 2
=item -
Config::Auto
=item -
DBI
=back
=head1 DESCRIPTION =head1 DESCRIPTION
This script will extract and process statistical information from a This script will extract and process statistical information from a
database table which is fed from F<feedlog.pl> for a given time period database table which is fed from F<feedlog.pl> for a given time period
and write its results to (an)other database table(s). Entries marked and write its results to (an)other database table(s). Entries marked
with I<'disregard'> in the database will be ignored; currently, you have with I<'disregard'> in the database will be ignored; currently, you
to set this flag yourself, using your database management tools. You have to set this flag yourself, using your database management tools.
can exclude erroneous entries that way (e.g. automatic reposts (think You can exclude erroneous entries that way (e.g. automatic reposts
of cancels flood and resurrectors); spam; ...). (think of cancels flood and resurrectors); spam; ...).
The time period to act on defaults to last month; you can assign The time period to act on defaults to last month; you can assign
another month via the B<-m> switch or a time period via the B<-p> another time period or a single month via the B<--month> option (see
switch; the latter takes preference. below).
By default B<gatherstats> will process all types of information; you By default B<gatherstats> will process all types of information; you
can change that using the B<-t> switch and assigning the type of can change that using the B<--stats> option and assigning the type of
information to process. Currently only processing of the number of information to process. Currently that doesn't matter yet as only
postings per group per month is implemented anyway, so that doesn't processing of the number of postings per group per month is
matter yet. implemented anyway.
Possible information types include: Possible information types include:
@ -205,59 +232,58 @@ respectively. A crossposting to de.alt.test and de.alt.admin, on the
other hand, will be counted for de.alt.test and de.alt.admin each, but other hand, will be counted for de.alt.test and de.alt.admin each, but
only once for de.alt.ALL and de.ALL. only once for de.alt.ALL and de.ALL.
Data is written to I<DBTableGrps> (see doc/INSTALL). Data is written to I<DBTableGrps> (see L<doc/INSTALL>); you can
override that default through the B<--groupsdb> option.
=back =back
=head2 Configuration =head2 Configuration
F<gatherstats.pl> will read its configuration from F<newsstats.conf> B<gatherstats> will read its configuration from F<newsstats.conf>
which should be present in the same directory via Config::Auto. which should be present in the same directory via Config::Auto.
See doc/INSTALL for an overview of possible configuration options. See L<doc/INSTALL> for an overview of possible configuration options.
You can override configuration options via the B<-n>, B<-r>, B<-g>, You can override configuration options via the B<--hierarchy>,
B<-c> and B<-s> switches, respectively. B<--rawdb>, B<--groupsdb>, B<--clientsdb> and B<--hostsdb> options,
respectively.
=head1 OPTIONS =head1 OPTIONS
=over 3 =over 3
=item B<-V> (version) =item B<-V>, B<--version>
Print out version and copyright information on B<yapfaq> and exit. Print out version and copyright information and exit.
=item B<-h> (help) =item B<-h>, B<--help>
Print this man page and exit. Print this man page and exit.
=item B<-d> (debug) =item B<-d>, B<--debug>
Output debugging information to STDOUT while processing (number of Output debugging information to STDOUT while processing (number of
postings per group). postings per group).
=item B<-o> (output only) =item B<-t>, B<--test>
Do not write results to database. You should use B<-d> in conjunction Do not write results to database. You should use B<--debug> in
with B<-o> ... everything else seems a bit pointless. conjunction with B<--test> ... everything else seems a bit pointless.
=item B<-m> I<YYYY-MM> (month) =item B<-m>, B<--month> I<YYYY-MM[:YYYY-MM]>
Set processing period to a month in YYYY-MM format. Ignored if B<-p> Set processing period to a single month in YYYY-MM format or to a time
is set. period between two month in YYYY-MM:YYYY-MM format (two month, separated
by a colon).
=item B<-p> I<YYYY-MM:YYYY-MM> (period)
Set processing period to a time period between two month, each in =item B<-s>, B<--stats> I<type>
YYYY-MM format, separated by a colon. Overrides B<-m>.
=item B<-t> I<type> (type)
Set processing type to one of I<all> and I<groups>. Defaults to all Set processing type to one of I<all> and I<groups>. Defaults to all
(and is currently rather pointless as only I<groups> has been (and is currently rather pointless as only I<groups> has been
implemented). implemented).
=item B<-l> I<filename> (check against list) =item B<-c>, B<--checkgroups> I<filename>
Check each group against a list of valid newsgroups read from Check each group against a list of valid newsgroups read from
I<filename>, one group on each line and ignoring everything after the I<filename>, one group on each line and ignoring everything after the
@ -268,23 +294,23 @@ Newsgroups not found in I<filename> will be dropped (and logged to
STDERR), and newsgroups found in I<filename> but having no postings STDERR), and newsgroups found in I<filename> but having no postings
will be added with a count of 0 (and logged to STDERR). will be added with a count of 0 (and logged to STDERR).
=item B<-n> I<TLH> (newsgroup hierarchy) =item B<--hierarchy> I<TLH> (newsgroup hierarchy)
Override I<TLH> from F<newsstats.conf>. Override I<TLH> from F<newsstats.conf>.
=item B<-r> I<table> (raw data table) =item B<--rawdb> I<table> (raw data table)
Override I<DBTableRaw> from F<newsstats.conf>. Override I<DBTableRaw> from F<newsstats.conf>.
=item B<-g> I<table> (postings per group table) =item B<--groupsdb> I<table> (postings per group table)
Override I<DBTableGrps> from F<newsstats.conf>. Override I<DBTableGrps> from F<newsstats.conf>.
=item B<-c> I<table> (client data table) =item B<--clientsdb> I<table> (client data table)
Override I<DBTableClnts> from F<newsstats.conf>. Override I<DBTableClnts> from F<newsstats.conf>.
=item B<-s> I<table> (server/host data table) =item B<--hostsdb> I<table> (host data table)
Override I<DBTableHosts> from F<newsstats.conf>. Override I<DBTableHosts> from F<newsstats.conf>.
@ -292,7 +318,7 @@ Override I<DBTableHosts> from F<newsstats.conf>.
=head1 INSTALLATION =head1 INSTALLATION
See doc/INSTALL. See L<doc/INSTALL>.
=head1 EXAMPLES =head1 EXAMPLES
@ -302,16 +328,16 @@ Process all types of information for lasth month:
Do a dry run, showing results of processing: Do a dry run, showing results of processing:
gatherstats -do gatherstats --debug --test
Process all types of information for January of 2010: Process all types of information for January of 2010:
gatherstats -m 2010-01 gatherstats --month 2010-01
Process only number of postings for the year of 2010, Process only number of postings for the year of 2010,
checking against checkgroups-2010.txt: checking against checkgroups-2010.txt:
gatherstats -p 2010-01:2010-12 -t groups -l checkgroups-2010.txt gatherstats -m 2010-01:2010-12 -s groups -c checkgroups-2010.txt
=head1 FILES =head1 FILES
@ -327,7 +353,7 @@ Library functions for the NewsStats package.
=item F<newsstats.conf> =item F<newsstats.conf>
Runtime configuration file for B<yapfaq>. Runtime configuration file.
=back =back
@ -342,11 +368,11 @@ bug tracker at L<http://bugs.th-h.de/>!
=item - =item -
doc/README L<doc/README>
=item - =item -
doc/INSTALL L<doc/INSTALL>
=back =back
@ -358,7 +384,7 @@ Thomas Hochstein <thh@inter.net>
=head1 COPYRIGHT AND LICENSE =head1 COPYRIGHT AND LICENSE
Copyright (c) 2010 Thomas Hochstein <thh@inter.net> Copyright (c) 2010-2012 Thomas Hochstein <thh@inter.net>
This program is free software; you may redistribute it and/or modify it This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself. under the same terms as Perl itself.