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

Compare commits

base: thh:5a6a3e58bff6a76dc723bac7b4c0a5275dfb8bdf
Branches Tags
thh:master
thh:next
thh:0.4.0
thh:0.3.0
thh:0.2.0
thh:0.01
..
compare: thh:4cdb7718661c655f0ca73d739278b8c55e8121f2
Branches Tags
thh:next
thh:master
thh:0.4.0
thh:0.3.0
thh:0.2.0
thh:0.01

No commits in common. "5a6a3e58bff6a76dc723bac7b4c0a5275dfb8bdf" and "4cdb7718661c655f0ca73d739278b8c55e8121f2" have entirely different histories.
5a6a3e58bf ... 4cdb771866

14 changed files with 193 additions and 2888 deletions
Download patch file Download diff file Expand all files Collapse all files

537
bin/cliservstats.pl
View file

@ -1,537 +0,0 @@
#! /usr/bin/perl
#
# cliservstats.pl
#
# This script will get statistical data on client (newsreader) and
# server (host) usage from a database.
#
# It is part of the NewsStats package.
#
# Copyright (c) 2025 Thomas Hochstein <thh@thh.name>
#
# It can be redistributed and/or modified under the same terms under
# which Perl itself is published.
BEGIN {
use File::Basename;
# we're in .../bin, so our module is in ../lib
push(@INC, dirname($0).'/../lib');
}
use strict;
use warnings;
use NewsStats qw(:DEFAULT :TimePeriods :Output :SQLHelper ReadGroupList);
use DBI;
use Getopt::Long qw(GetOptions);
Getopt::Long::config ('bundling');
################################# Main program #################################
### read commandline options
my ($OptCaptions,$OptComments,$OptDB,$OptFileTemplate,$OptFormat,
$OptGroupBy,$LowBound,$OptMonth,$OptNames,$OptOrderBy,
$OptReportType,$OptSums,$OptType,$UppBound,$OptConfFile);
GetOptions ('c|captions!' => \$OptCaptions,
'comments!' => \$OptComments,
'db=s' => \$OptDB,
'filetemplate=s' => \$OptFileTemplate,
'f|format=s' => \$OptFormat,
'g|group-by=s' => \$OptGroupBy,
'l|lower=i' => \$LowBound,
'm|month=s' => \$OptMonth,
'n|names=s' => \$OptNames,
'o|order-by=s' => \$OptOrderBy,
'r|report=s' => \$OptReportType,
's|sums!' => \$OptSums,
't|type=s' => \$OptType,
'u|upper=i' => \$UppBound,
'conffile=s' => \$OptConfFile,
'h|help' => \&ShowPOD,
'V|version' => \&ShowVersion) or exit 1;
# parse parameters
# $OptComments defaults to TRUE if --filetemplate is not used
$OptComments = 1 if (!$OptFileTemplate && !defined($OptComments));
# parse $OptType
if ($OptType) {
if ($OptType =~ /(host|server)s?/i) {
$OptType = 'host';
} elsif ($OptType =~ /(newsreader|client)s?/i) {
$OptType = 'client';
}
}
&Bleat(2, "Please use '--type server' or '-type newsreader'.") if !$OptType;
# parse $OptReportType
if ($OptReportType) {
if ($OptReportType =~ /sums?/i) {
$OptReportType = 'sum';
} else {
$OptReportType = 'default';
}
}
### read configuration
my %Conf = %{ReadConfig($OptConfFile)};
### set DBTable
if ($OptDB) {
$Conf{'DBTable'} = $OptDB;
}
elsif ($OptType eq 'host') {
$Conf{'DBTable'} = $Conf{'DBTableHosts'};
} else {
$Conf{'DBTable'} = $Conf{'DBTableClnts'};
}
### init database
my $DBHandle = InitDB(\%Conf,1);
### get time period and names, prepare SQL 'WHERE' clause
# get time period
# and set caption for output and expression for SQL 'WHERE' clause
my ($CaptionPeriod,$SQLWherePeriod) = &GetTimePeriod($OptMonth);
# bail out if --month is invalid
&Bleat(2,"--month option has an invalid format - ".
"please use 'YYYY-MM', 'YYYY-MM:YYYY-MM' or 'ALL'!") if !$CaptionPeriod;
# get list of hosts and set expression for SQL 'WHERE' clause
# with placeholders as well as a list of names to bind to them
my ($SQLWhereNames,@SQLBindNames);
if ($OptNames) {
($SQLWhereNames,@SQLBindNames) = &SQLGroupList($OptNames,$OptType);
# bail out if --names is invalid
&Bleat(2,"--names option has an invalid format!")
if !$SQLWhereNames;
}
### build SQL WHERE clause
my $ExcludeSums = $OptSums ? '' : sprintf("%s != 'ALL'",$OptType);
my $SQLWhereClause = SQLBuildClause('where',$SQLWherePeriod,$SQLWhereNames,
$ExcludeSums,
&SQLSetBounds('default',$LowBound,$UppBound));
### get sort order and build SQL 'ORDER BY' clause
# force to 'month' for $OptReportType 'sum'
$OptGroupBy = 'month' if ($OptReportType and $OptReportType ne 'default');
# default to 'name' if $OptGroupBy is not set and
# just one name is requested, but more than one month
$OptGroupBy = 'name' if (!$OptGroupBy and $OptMonth and $OptMonth =~ /:/
and $OptNames and $OptNames !~ /[:*%]/);
# parse $OptGroupBy to $GroupBy, create ORDER BY clause $SQLOrderClause
# if $OptGroupBy is still not set, SQLSortOrder() will default to 'month'
my ($GroupBy,$SQLOrderClause) = SQLSortOrder($OptGroupBy, $OptOrderBy, $OptType);
# $GroupBy will contain 'month' or 'host'/'client' (parsed result of $OptGroupBy)
# set it to 'month' or 'key' for OutputData()
$GroupBy = ($GroupBy eq 'month') ? 'month' : 'key';
### get report type and build SQL 'SELECT' query
my $SQLSelect;
my $SQLGroupClause = '';
my $Precision = 0; # number of digits right of decimal point for output
if ($OptReportType and $OptReportType ne 'default') {
$SQLGroupClause = "GROUP BY $OptType";
# change $SQLOrderClause: replace everything before 'postings'
$SQLOrderClause =~ s/BY.+postings/BY postings/;
$SQLSelect = "'All months',$OptType,SUM(postings)";
# change $SQLOrderClause: replace 'postings' with 'SUM(postings)'
$SQLOrderClause =~ s/postings/SUM(postings)/;
} else {
$SQLSelect = "month,$OptType,postings";
};
### get length of longest name delivered by query
### for formatting purposes
my $Field = ($GroupBy eq 'month') ? $OptType : 'month';
my ($MaxLength,$MaxValLength) = &GetMaxLength($DBHandle,$Conf{'DBTable'},
$Field,'postings',$SQLWhereClause,
'',@SQLBindNames);
### build and execute SQL query
my ($DBQuery);
# prepare query
$DBQuery = $DBHandle->prepare(sprintf('SELECT %s FROM %s.%s %s %s %s',
$SQLSelect,
$Conf{'DBDatabase'},$Conf{'DBTable'},
$SQLWhereClause,$SQLGroupClause,
$SQLOrderClause));
# execute query
$DBQuery->execute(@SQLBindNames)
or &Bleat(2,sprintf("Can't get %s data for %s from %s.%s: %s\n",
$OptType,$CaptionPeriod,$Conf{'DBDatabase'},$Conf{'DBTable'},
$DBI::errstr));
### output results
# set default to 'pretty'
$OptFormat = 'pretty' if !$OptFormat;
# print captions if --caption is set
my $LeadIn;
if ($OptCaptions && $OptComments) {
# print time period with report type
my $CaptionReportType = '(number of postings for each month)';
if ($OptReportType and $OptReportType ne 'default') {
$CaptionReportType = '(number of all postings for that time period)';
}
$LeadIn .= sprintf("# ----- Report for %s %s\n",$CaptionPeriod,$CaptionReportType);
# print name list if --names is set
$LeadIn .= sprintf("# ----- Names: %s\n",join(',',split(/:/,$OptNames)))
if $OptNames;
# print boundaries, if set
my $CaptionBoundary= '(counting only month fulfilling this condition)';
$LeadIn .= sprintf("# ----- Threshold: %s %s x %s %s %s\n",
$LowBound ? $LowBound : '',$LowBound ? '=>' : '',
$UppBound ? '<=' : '',$UppBound ? $UppBound : '',$CaptionBoundary)
if ($LowBound or $UppBound);
# print primary and secondary sort order
$LeadIn .= sprintf("# ----- Grouped by %s (%s), sorted %s%s\n",
($GroupBy eq 'month') ? 'Months' : 'Names',
($OptGroupBy and $OptGroupBy =~ /-?desc$/i) ? 'descending' : 'ascending',
($OptOrderBy and $OptOrderBy =~ /posting/i) ? 'by number of postings ' : '',
($OptOrderBy and $OptOrderBy =~ /-?desc$/i) ? 'descending' : 'ascending');
}
# output data
&OutputData($OptFormat,$OptComments,$GroupBy,$Precision,'',$LeadIn,
$OptFileTemplate,$DBQuery,$MaxLength,$MaxValLength);
### close handles
$DBHandle->disconnect;
__END__
################################ Documentation #################################
=head1 NAME
cliservstats - create reports on host or client usage
=head1 SYNOPSIS
B<cliservstats> B<-t> I<host|client> [B<-Vhcs> B<--comments>] [B<-m> I<YYYY-MM>[:I<YYYY-MM>] | I<all>] [B<-n> I<server(s)|client(s)>] [B<-r> I<report type>] [B<-l> I<lower boundary>] [B<-u> I<upper boundary>] [B<-g> I<group by>] [B<-o> I<order by>] [B<-f> I<output format>] [B<--filetemplate> I<filename template>] [B<--db> I<database table>] [B<--conffile> I<filename>]
=head1 REQUIREMENTS
See L<doc/README>.
=head1 DESCRIPTION
This script create reports on newsgroup usage (number of postings from
each host or using each client per month) taken from result tables
created by B<gatherstats.pl>.
=head2 Features and options
=head3 Time period and names
The time period to act on defaults to last month; you can assign another
time period or a single month (or drop all time constraints) via the
B<--month> option (see below).
B<cliservstats> will process all hosts or clients by default; you can
limit processing to only some hosts or clients by supplying a list of
those names by using the B<--names> option (see below).
=head3 Report type
You can choose between different B<--report> types: postings per month
or all postings summed up; for details, see below.
=head3 Upper and lower boundaries
Furthermore you can set an upper and/or lower boundary to exclude some
results from output via the B<--lower> and B<--upper> options,
respectively. By default, all hosts/clients with more and/or less
postings per month will be excluded from the result set (i.e. not
shown and not considered forsum reports).
=head3 Sorting and formatting the output
By default, all results are grouped by month; you can group results by
hosts/clients instead via the B<--group-by> option. Within those
groups, the list of hosts/clients (or months) is sorted alphabetically
(or chronologically, respectively) ascending. You can change that order
(and sort by number of postings) with the B<--order-by> option. For
details and exceptions, please see below.
The results will be formatted as a kind of table; you can change the
output format to a simple list or just a list of names and number of
postings with the B<--format> option. Captions will be added by means of
the B<--caption> option; all comments (and captions) can be supressed by
using B<--nocomments>.
Last but not least you can redirect all output to a number of files, e.g.
one for each month, by submitting the B<--filetemplate> option, see below.
=head2 Configuration
B<cliservstats> will read its configuration from F<newsstats.conf>
which should be present in etc/ via Config::Auto or from a configuration file
submitted by the B<--conffile> option.
See doc/INSTALL for an overview of possible configuration options.
You can override some configuration options via the B<--db> option.
=head1 OPTIONS
=over 3
=item B<-V>, B<--version>
Print out version and copyright information and exit.
=item B<-h>, B<--help>
Print this man page and exit.
=item B<-t>, B<--type> I<host|client>
Create report for hosts (servers) or clients (newsreaders), using
I<DBTableHosts> or I<DBTableClnts> respectively.
=item B<-m>, B<--month> I<YYYY-MM[:YYYY-MM]|all>
Set processing period to a single month in YYYY-MM format or to a time
period between two month in YYYY-MM:YYYY-MM format (two month, separated
by a colon). By using the keyword I<all> instead, you can set no
processing period to process the whole database.
=item B<-n>, B<--names> I<name(s)>
Limit processing to a certain set of host or client names. I<names(s)>
can be a single name (eternal-september.org), a group of names
(*.inka.de) or a list of either of these, separated by colons, for
example
eternal-september.org:solani.org:*.inka.de
=item B<-s>, B<--sums|--nosums> (sum per month)
Include a "virtual" host named "ALL" for every month in output,
containing the sum of all detected hosts for that month.
=item B<-r>, B<--report> I<default|sums>
Choose the report type: I<default> or I<sums>
By default, B<cliservstats> will report the number of postings for each
host/client in each month. But it can also report the total sum of postings
per host/client for all months.
For report type I<sums>, the B<group-by> option has no meaning and
will be silently ignored (see below).
=item B<-l>, B<--lower> I<lower boundary>
Set the lower boundary. See below.
=item B<-l>, B<--upper> I<upper boundary>
Set the upper boundary.
By default, all hosts/clients with more postings per month than the
upper boundary and/or less postings per month than the lower boundary
will be excluded from further processing. For the default report that
means each month only hosts/clients with a number of postings between
the boundaries will be displayed. For the sums report, hosts/clients
with a number of postings exceeding the boundaries in all (!) months
will not be considered.
=item B<-g>, B<--group-by> I<month[-desc]|name[-desc]>
By default, all results are grouped by month, sorted chronologically in
ascending order, like this:
# ----- 2012-01:
arcor-online.net : 9379
individual.net : 19525
news.albasani.net: 9063
# ----- 2012-02:
arcor-online.net : 8606
individual.net : 16768
news.albasani.net: 7879
The results can be grouped by host/client instead via
B<--group-by> I<name>:
----- individual.net
2012-01: 19525
2012-02: 16768
----- arcor-online.net
2012-01: 9379
2012-02: 8606
----- news.albasani.net
2012-01: 9063
2012-02: 7879
By appending I<-desc> to the group-by option parameter, you can reverse
the sort order - e.g. B<--group-by> I<month-desc> will give:
# ----- 2012-02:
arcor-online.net : 8606
individual.net : 16768
news.albasani.net: 7879
# ----- 2012-01:
arcor-online.net : 9379
individual.net : 19525
news.albasani.net: 9063
Sums reports (see above) will always be grouped by months; this option
will therefore be ignored.
=item B<-o>, B<--order-by> I<default[-desc]|postings[-desc]>
Within each group (a single month or single host/client, see above),
the report will be sorted by name (or month) in ascending alphabetical
order by default. You can change the sort order to descending or sort
by number of postings instead.
=item B<-f>, B<--format> I<pretty|list|dump>
Select the output format, I<pretty> being the default:
# ----- 2012-01:
arcor-online.net : 9379
individual.net : 19525
# ----- 2012-02:
arcor-online.net : 8606
individual.net : 16768
I<list> format looks like this:
2012-01 arcor-online.net 9379
2012-01 individual.net 19525
2012-02 arcor-online.net 8606
2012-02 individual.net 16768
And I<dump> format looks like this:
# 2012-01:
arcor-online.net 9379
individual.net 19525
# 2012-02:
arcor-online.net 8606
individual.net 16768
You can remove the comments by using B<--nocomments>, see below.
=item B<-c>, B<--captions|--nocaptions>
Add captions to output, like this:
----- Report for 2012-01 to 2012-02 (number of postings for each month)
----- Names: individual.net
----- Threshold: 8000 => x (counting only month fulfilling this condition)
----- Grouped by Month (ascending), sorted by number of postings descending
False by default.
=item B<--comments|--nocomments>
Add comments (group headers) to I<dump> and I<pretty> output. True by default
as logn as B<--filetemplate> is not set.
Use I<--nocomments> to suppress anything except host/client names or months and
numbers of postings.
=item B<--filetemplate> I<filename template>
Save output to file(s) instead of dumping it to STDOUT. B<cliservstats> will
create one file for each month (or each host/client, accordant to the
setting of B<--group-by>, see above), with filenames composed by adding
year and month (or host/client names) to the I<filename template>, for
example with B<--filetemplate> I<stats>:
stats-2012-01
stats-2012-02
... and so on
=item B<--db> I<database table>
Override I<DBTableHosts> or I<DBTableClnts> from F<newsstats.conf>.
=item B<--conffile> I<filename>
Load configuration from I<filename> instead of F<newsstats.conf>.
=back
=head1 INSTALLATION
See L<doc/INSTALL>.
=head1 EXAMPLES
Show number of postings per group for lasth month in I<pretty> format:
cliservstats --type host
Show that report for January of 2010 and *.inka plus individual.net:
cliservstats --type host --month 2010-01 --names *.inka:individual.net:
Only show clients with 30 postings or less last month, ordered
by number of postings, descending, in I<pretty> format:
cliservstats --type client --upper 30 --order-by postings-desc
List number of postings per host for each month of 2010 and redirect
output to one file for each month, named hosts-2010-01 and so on, in
machine-readable form (without formatting):
cliservstats -t host -m 2010-01:2010-12 -f dump --filetemplate hosts
=head1 FILES
=over 4
=item F<bin/cliservstats.pl>
The script itself.
=item F<lib/NewsStats.pm>
Library functions for the NewsStats package.
=item F<etc/newsstats.conf>
Runtime configuration file.
=back
=head1 BUGS
Please report any bugs or feature requests to the author or use the
bug tracker at L<https://code.virtcomm.de/thh/newsstats/issues>!
=head1 SEE ALSO
=over 2
=item -
L<doc/README>
=item -
l>doc/INSTALL>
=item -
gatherstats -h
=back
This script is part of the B<NewsStats> package.
=head1 AUTHOR
Thomas Hochstein <thh@thh.name>
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2025 Thomas Hochstein <thh@thh.name>
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
=cut

364
bin/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-2013, 2025 Thomas Hochstein <thh@thh.name> # Copyright (c) 2010-2013 Thomas Hochstein <thh@thh.name>
# #
# 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.
@ -20,7 +20,7 @@ BEGIN {
use strict; use strict;
use warnings; use warnings;
use NewsStats qw(:DEFAULT :TimePeriods ListNewsgroups ParseHierarchies ReadGroupList ParseHeaders); use NewsStats qw(:DEFAULT :TimePeriods ListNewsgroups ParseHierarchies ReadGroupList);
use DBI; use DBI;
use Getopt::Long qw(GetOptions); use Getopt::Long qw(GetOptions);
@ -31,21 +31,19 @@ Getopt::Long::config ('bundling');
# 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 %LegalStats; my %LegalStats;
@LegalStats{('all','groups','hosts')} = (); @LegalStats{('all','groups')} = ();
################################# Main program ################################# ################################# Main program #################################
### read commandline options ### read commandline options
my ($OptCheckgroupsFile,$OptClientsDB,$OptDebug,$OptGroupsDB,$OptTLH, my ($OptCheckgroupsFile,$OptClientsDB,$OptDebug,$OptGroupsDB,$OptTLH,
$OptHostsDB,$OptMID,$OptMonth,$OptRawDB,$OptStatsType,$OptTest, $OptHostsDB,$OptMonth,$OptRawDB,$OptStatsType,$OptTest,$OptConfFile);
$OptConfFile);
GetOptions ('c|checkgroups=s' => \$OptCheckgroupsFile, GetOptions ('c|checkgroups=s' => \$OptCheckgroupsFile,
'clientsdb=s' => \$OptClientsDB, 'clientsdb=s' => \$OptClientsDB,
'd|debug+' => \$OptDebug, 'd|debug!' => \$OptDebug,
'groupsdb=s' => \$OptGroupsDB, 'groupsdb=s' => \$OptGroupsDB,
'hierarchy=s' => \$OptTLH, 'hierarchy=s' => \$OptTLH,
'hostsdb=s' => \$OptHostsDB, 'hostsdb=s' => \$OptHostsDB,
'mid=s' => \$OptMID,
'm|month=s' => \$OptMonth, 'm|month=s' => \$OptMonth,
'rawdb=s' => \$OptRawDB, 'rawdb=s' => \$OptRawDB,
's|stats=s' => \$OptStatsType, 's|stats=s' => \$OptStatsType,
@ -66,11 +64,6 @@ $ConfOverride{'DBTableHosts'} = $OptHostsDB if $OptHostsDB;
$ConfOverride{'TLH'} = $OptTLH if $OptTLH; $ConfOverride{'TLH'} = $OptTLH if $OptTLH;
&OverrideConfig(\%Conf,\%ConfOverride); &OverrideConfig(\%Conf,\%ConfOverride);
# set --debug and --test if --mid is set
if ($OptMID) {
$OptDebug = 1; $OptTest = 1;
}
### get type of information to gather, defaulting to 'all' ### get type of information to gather, defaulting to 'all'
$OptStatsType = 'all' if !$OptStatsType; $OptStatsType = 'all' if !$OptStatsType;
&Bleat(2, sprintf("Unknown type '%s'!", $OptStatsType)) &Bleat(2, sprintf("Unknown type '%s'!", $OptStatsType))
@ -115,9 +108,6 @@ if ($Conf{'TLH'}) {
### init database ### init database
my $DBHandle = InitDB(\%Conf,1); my $DBHandle = InitDB(\%Conf,1);
my $DBRaw = sprintf('%s.%s',$Conf{'DBDatabase'},$Conf{'DBTableRaw'});
my $DBGrps = sprintf('%s.%s',$Conf{'DBDatabase'},$Conf{'DBTableGrps'});
my $DBHosts = sprintf('%s.%s',$Conf{'DBDatabase'},$Conf{'DBTableHosts'});
### get data for each month ### get data for each month
&Bleat(1,'Test mode. Database is not updated.') if $OptTest; &Bleat(1,'Test mode. Database is not updated.') if $OptTest;
@ -125,262 +115,90 @@ foreach my $Month (&ListMonth($Period)) {
print "---------- $Month ----------\n" if $OptDebug; print "---------- $Month ----------\n" if $OptDebug;
### GroupStats
if ($OptStatsType eq 'all' or $OptStatsType eq 'groups') { if ($OptStatsType eq 'all' or $OptStatsType eq 'groups') {
&GroupStats($DBHandle,$DBRaw,$DBGrps,$Month,$TLH,$OptCheckgroupsFile,$OptMID,$OptTest,$OptDebug); # read list of newsgroups from --checkgroups
}; # into a hash
my %ValidGroups = %{ReadGroupList(sprintf('%s-%s',$OptCheckgroupsFile,$Month))}
if $OptCheckgroupsFile;
### HostStats ### ----------------------------------------------
if ($OptStatsType eq 'all' or $OptStatsType eq 'hosts') { ### get groups data (number of postings per group)
# define known hosts using subdomains # get groups data from raw table for given month
my @KnownHosts = qw(abavia.com aioe.org arcor-online.net arcor-ip.de astraweb.com read.cnntp.org my $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s.%s ".
easynews.com eternal-september.org euro.net fernuni-hagen.de free.fr newsread.freenet.ag "WHERE day LIKE ? AND NOT disregard",
googlegroups.com heirich.name news.neostrada.pl netcologne.de newsdawg.com newscene.com $Conf{'DBDatabase'},
news-service.com octanews.com readnews.com wieslauf.sub.de highway.telekom.at $Conf{'DBTableRaw'}));
united-newsserver.de xennanews.com xlned.com xsnews.nl news.xs4all.nl); $DBQuery->execute($Month.'-%')
&HostStats($DBHandle,$DBRaw,$DBHosts,$Month,$OptMID,$OptTest,$OptDebug,@KnownHosts); 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
my %Postings;
while (($_) = $DBQuery->fetchrow_array) {
# get list of newsgroups and hierarchies from Newsgroups:
my %Newsgroups = ListNewsgroups($_,$TLH,
$OptCheckgroupsFile ? \%ValidGroups : '');
# count each newsgroup and hierarchy once
foreach (sort keys %Newsgroups) {
$Postings{$_}++;
};
};
# add valid but empty groups if --checkgroups is set
if (%ValidGroups) {
foreach (sort keys %ValidGroups) {
if (!defined($Postings{$_})) {
# add current newsgroup as empty group
$Postings{$_} = 0;
warn (sprintf("ADDED: %s as empty group\n",$_));
# add empty hierarchies for current newsgroup as needed
foreach (ParseHierarchies($_)) {
my $Hierarchy = $_ . '.ALL';
if (!defined($Postings{$Hierarchy})) {
$Postings{$Hierarchy} = 0;
warn (sprintf("ADDED: %s as empty group\n",$Hierarchy));
};
};
}
};
};
# delete old data for that month
if (!$OptTest) {
$DBQuery = $DBHandle->do(sprintf("DELETE FROM %s.%s WHERE month = ?",
$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 $OptDebug;
foreach my $Newsgroup (sort keys %Postings) {
print "$Newsgroup => $Postings{$Newsgroup}\n" if $OptDebug;
if (!$OptTest) {
# write to database
$DBQuery = $DBHandle->prepare(sprintf("INSERT INTO %s.%s ".
"(month,newsgroup,postings) ".
"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;
};
};
} else {
# other types of information go here - later on
}; };
}; };
### close handles ### close handles
$DBHandle->disconnect; $DBHandle->disconnect;
################################# Subroutines ##################################
sub GroupStats {
### ----------------------------------------------------------------------------
### collect number of postings per group
### IN : $DBHandle : database handle
### $DBRaw : database table for raw data (to read from)
### $DBGrps : database table for groups data (to write to)
### $Month : current month to do
### $MID : specific Message-ID to fetch (testing purposes)
### $TLH : TLHs to collect
### $Checkgroupsfile : filename template for checkgroups file
### (expanded to $Checkgroupsfile-$Month)
### $Test : test mode
### $Debug : debug mode
### OUT: (nothing)
my ($DBHandle,$DBRaw,$DBGrps,$Month,$TLH,$CheckgroupsFile,$MID,$Test,$Debug) = @_;
# read list of newsgroups from --checkgroups
# into a hash
my %ValidGroups = %{ReadGroupList(sprintf('%s-%s',$CheckgroupsFile,$Month))}
if $CheckgroupsFile;
my $DBQuery;
if (!$MID) {
### ----------------------------------------------
### get groups data (number of postings per group)
# get groups data from raw table for given month
$DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s ".
"WHERE day LIKE ? AND NOT disregard",
$DBRaw));
$DBQuery->execute($Month.'-%')
or &Bleat(2,sprintf("Can't get groups data for %s from %s: ".
"$DBI::errstr\n",$Month,
$DBRaw));
} else {
$DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s ".
"WHERE mid = ?", $DBRaw));
$DBQuery->execute($MID)
or &Bleat(2,sprintf("Can't get groups data for %s from %s: ".
"$DBI::errstr\n",$MID,
$DBRaw));
}
# count postings per group
my %Postings;
while (($_) = $DBQuery->fetchrow_array) {
# get list of newsgroups and hierarchies from Newsgroups:
my %Newsgroups = ListNewsgroups($_,$TLH,
$CheckgroupsFile ? \%ValidGroups : '');
# count each newsgroup and hierarchy once
foreach (sort keys %Newsgroups) {
$Postings{$_}++;
};
};
# add valid but empty groups if --checkgroups is set
if (%ValidGroups) {
foreach (sort keys %ValidGroups) {
if (!defined($Postings{$_})) {
# add current newsgroup as empty group
$Postings{$_} = 0;
warn (sprintf("ADDED: %s as empty group\n",$_));
# add empty hierarchies for current newsgroup as needed
foreach (ParseHierarchies($_)) {
my $Hierarchy = $_ . '.ALL';
if (!defined($Postings{$Hierarchy})) {
$Postings{$Hierarchy} = 0;
warn (sprintf("ADDED: %s as empty group\n",$Hierarchy));
};
};
}
};
};
# delete old data for that month
if (!$Test) {
$DBQuery = $DBHandle->do(sprintf("DELETE FROM %s WHERE month = ?",
$DBGrps), undef,$Month)
or &Bleat(2,sprintf("Can't delete old groups data for %s from %s: ".
"$DBI::errstr\n",$Month,$DBGrps));
};
print "----- GroupStats -----\n" if $Debug;
foreach my $Newsgroup (sort keys %Postings) {
print "$Newsgroup => $Postings{$Newsgroup}\n" if $Debug;
if (!$Test) {
# write to database
$DBQuery = $DBHandle->prepare(sprintf("INSERT INTO %s ".
"(month,newsgroup,postings) ".
"VALUES (?, ?, ?)",$DBGrps));
$DBQuery->execute($Month, $Newsgroup, $Postings{$Newsgroup})
or &Bleat(2,sprintf("Can't write groups data for %s/%s to %s: ".
"$DBI::errstr\n",$Month,$Newsgroup,$DBGrps));
$DBQuery->finish;
};
};
};
### ----------------------------------------------------------------------------
sub HostStats {
### ----------------------------------------------------------------------------
### collect number of postings per server
### IN : $DBHandle : database handle
### $DBRaw : database table for raw data (to read from)
### $DBHosts : database table for hosts data (to write to)
### $Month : current month to do
### $MID : specific Message-ID to fetch (testing purposes)
### $Test : test mode
### $Debug : debug mode
### @KnownHosts : list of known hosts with subdomains
### OUT: (nothing)
my ($DBHandle,$DBRaw,$DBHosts,$Month,$MID,$Test,$Debug,@KnownHosts) = @_;
my (%Postings,$DBQuery);
if (!$MID) {
# get raw header data from raw table for given month
$DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups,headers FROM %s ".
"WHERE day LIKE ? AND NOT disregard",
$DBRaw));
$DBQuery->execute($Month.'-%')
or &Bleat(2,sprintf("Can't get hosts data for %s from %s: ".
"$DBI::errstr\n",$Month,$DBRaw));
} else {
$DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups,headers FROM %s ".
"WHERE mid = ?", $DBRaw));
$DBQuery->execute($MID)
or &Bleat(2,sprintf("Can't get hosts data for %s from %s: ".
"$DBI::errstr\n",$MID,$DBRaw));
}
### ----------------------------------------------
print "----- HostStats -----\n" if $Debug;
### parse headers
while (my ($Newsgroups,$Headers) = $DBQuery->fetchrow_array) {
### skip postings with wrong TLH
# remove whitespace from contents of Newsgroups:
chomp($Newsgroups);
$Newsgroups =~ s/\s//;
my $GroupCount;
for (split /,/, $Newsgroups) {
# don't count newsgroup/hierarchy in wrong TLH
next if($TLH and !/^$TLH/);
$GroupCount++;
};
next if !$GroupCount;
my $Host;
my %Header = ParseHeaders(split(/\n/,$Headers));
# ([a-z0-9-_]+\.[a-z0-9-_.]+) tries to match a hostname
# Injection-Info
if($Header{'injection-info'}) {
($Host) = $Header{'injection-info'} =~ /^\s*([a-z0-9-_]+\.[a-z0-9-_.]+);/i;
# reset if IP address
undef($Host) if $Host && $Host !~ /[g-z]/i;
}
# X-Trace
if (!$Host && $Header{'x-trace'}) {
(undef, $Host) = $Header{'x-trace'} =~ /^(\s|\d)*([a-z0-9-_]+\.[a-z0-9-_.]+)/i;
# reset if IP address
undef($Host) if $Host && $Host !~ /[g-z]/i;
}
# Path
if (!$Host) {
if ($Header{'path'} =~ /!([^!]+)!.POSTED!/) {
$Host = "$1";
} elsif ($Header{'path'} =~ /([^!]+)!.POSTED.[^!]+!?/) {
$Host = "$1";
} else {
# iterate on the Path: header until we have a host name or no more
# path elements
while (!$Host && $Header{'path'} =~ /!/) {
($Host) = $Header{'path'} =~ /!?([a-z0-9-_]+\.[a-z0-9-_.]+)!!?[^!]+!?$/i;
undef($Host) if $Host && $Host =~ /\.MISMATCH/;
# remove last path element
$Header{'path'} =~ s/!!?[^!]+$//;
};
}
}
# trailing .POSTED
($Host) = $Host =~ /(\S+)\.POSTED$/ if $Host =~ /\.POSTED$/;
# special cases
$Host = 'news.highwinds-media.com' if $Host =~ /f(e|x)\d\d\.\S{3}\d?$/
or $Host =~ /(newsfe|fed)\d+\.(iad|ams2)$/;
$Host = 'newshosting.com' if $Host =~ /post\d*\.iad$/;
$Host = 'eternal-september.org' if $Host =~ /dont-email\.me$/;
# normalize hosts
foreach (@KnownHosts) {
if ($Host =~ /\.$_$/) {
($Host) = $_ ;
last;
}
}
# lowercase
$Host = lc($Host);
# count host
if ($Host) {
$Postings{$Host}++;
$Postings{'ALL'}++;
} else {
&Bleat(2,sprintf("%s FAILED", $Header{'message-id'})) if !$Host;
}
printf("%s: %s\n", $Header{'message-id'}, $Host) if ($MID or $Debug && $Debug >1);
};
# delete old data for that month
if (!$Test) {
$DBQuery = $DBHandle->do(sprintf("DELETE FROM %s WHERE month = ?",
$DBHosts),undef,$Month)
or &Bleat(2,sprintf("Can't delete old hosts data for %s from %s: ".
"$DBI::errstr\n",$Month,$DBHosts));
};
foreach my $Host (sort keys %Postings) {
print "$Host => $Postings{$Host}\n" if $Debug;
if (!$Test) {
# write to database
$DBQuery = $DBHandle->prepare(sprintf("INSERT INTO %s ".
"(month,host,postings) ".
"VALUES (?, ?, ?)",$DBHosts));
$DBQuery->execute($Month, $Host, $Postings{$Host})
or &Bleat(2,sprintf("Can't write groups data for %s/%s to %s: ".
"$DBI::errstr\n",$Month,$Host,$DBHosts));
$DBQuery->finish;
};
};
};
__END__ __END__
################################ Documentation ################################# ################################ Documentation #################################
@ -413,7 +231,9 @@ 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<--stats> option and assigning the type of can change that using the B<--stats> option and assigning the type of
information to process. information to process. Currently that doesn't matter yet as only
processing of the number of postings per group per month is
implemented anyway.
Possible information types include: Possible information types include:
@ -435,15 +255,6 @@ only once for de.alt.ALL and de.ALL.
Data is written to I<DBTableGrps> (see L<doc/INSTALL>); you can Data is written to I<DBTableGrps> (see L<doc/INSTALL>); you can
override that default through the B<--groupsdb> option. override that default through the B<--groupsdb> option.
=item B<hosts> (postings from host per month)
B<gatherstats> will examine Injection-Info:, X-Trace: and Path:
headers and try to normalize them. Groups not in I<TLH> will be
ignored. The sum of all detected hosts will also saved for each month.
Data is written to I<DBTableHosts> (see L<doc/INSTALL>); you can
override that default through the B<--hostsdb> option.
=back =back
=head2 Configuration =head2 Configuration
@ -488,8 +299,9 @@ by a colon).
=item B<-s>, B<--stats> I<type> =item B<-s>, B<--stats> I<type>
Set processing type to one of I<all>, I<groups> or I<hosts>. Defaults Set processing type to one of I<all> and I<groups>. Defaults to all
to all. (and is currently rather pointless as only I<groups> has been
implemented).
=item B<-c>, B<--checkgroups> I<filename template> =item B<-c>, B<--checkgroups> I<filename template>
@ -605,7 +417,7 @@ Thomas Hochstein <thh@thh.name>
=head1 COPYRIGHT AND LICENSE =head1 COPYRIGHT AND LICENSE
Copyright (c) 2010-2013, 2025 Thomas Hochstein <thh@thh.name> Copyright (c) 2010-2013 Thomas Hochstein <thh@thh.name>
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.

29
bin/groupstats.pl
View file

@ -51,8 +51,10 @@ GetOptions ('b|boundary=s' => \$OptBoundType,
'h|help' => \&ShowPOD, 'h|help' => \&ShowPOD,
'V|version' => \&ShowVersion) or exit 1; 'V|version' => \&ShowVersion) or exit 1;
# parse parameters # parse parameters
# $OptComments defaults to TRUE if --filetemplate is not used # $OptComments defaults to TRUE
$OptComments = 1 if (!$OptFileTemplate && !defined($OptComments)); $OptComments = 1 if (!defined($OptComments));
# force --nocomments when --filetemplate is used
$OptComments = 0 if ($OptFileTemplate);
# parse $OptBoundType # parse $OptBoundType
if ($OptBoundType) { if ($OptBoundType) {
if ($OptBoundType =~ /level/i) { if ($OptBoundType =~ /level/i) {
@ -108,7 +110,7 @@ my ($CaptionPeriod,$SQLWherePeriod) = &GetTimePeriod($OptMonth);
# with placeholders as well as a list of newsgroup to bind to them # with placeholders as well as a list of newsgroup to bind to them
my ($SQLWhereNewsgroups,@SQLBindNewsgroups); my ($SQLWhereNewsgroups,@SQLBindNewsgroups);
if ($OptNewsgroups) { if ($OptNewsgroups) {
($SQLWhereNewsgroups,@SQLBindNewsgroups) = &SQLGroupList($OptNewsgroups,'newsgroup'); ($SQLWhereNewsgroups,@SQLBindNewsgroups) = &SQLGroupList($OptNewsgroups);
# bail out if --newsgroups is invalid # bail out if --newsgroups is invalid
&Bleat(2,"--newsgroups option has an invalid format!") &Bleat(2,"--newsgroups option has an invalid format!")
if !$SQLWhereNewsgroups; if !$SQLWhereNewsgroups;
@ -141,7 +143,7 @@ $OptGroupBy = 'newsgroup' if (!$OptGroupBy and $OptMonth and $OptMonth =~ /:/
and $OptNewsgroups and $OptNewsgroups !~ /[:*%]/); and $OptNewsgroups and $OptNewsgroups !~ /[:*%]/);
# parse $OptGroupBy to $GroupBy, create ORDER BY clause $SQLOrderClause # parse $OptGroupBy to $GroupBy, create ORDER BY clause $SQLOrderClause
# if $OptGroupBy is still not set, SQLSortOrder() will default to 'month' # if $OptGroupBy is still not set, SQLSortOrder() will default to 'month'
my ($GroupBy,$SQLOrderClause) = SQLSortOrder($OptGroupBy, $OptOrderBy, 'newsgroup'); my ($GroupBy,$SQLOrderClause) = SQLSortOrder($OptGroupBy, $OptOrderBy);
# $GroupBy will contain 'month' or 'newsgroup' (parsed result of $OptGroupBy) # $GroupBy will contain 'month' or 'newsgroup' (parsed result of $OptGroupBy)
# set it to 'month' or 'key' for OutputData() # set it to 'month' or 'key' for OutputData()
$GroupBy = ($GroupBy eq 'month') ? 'month' : 'key'; $GroupBy = ($GroupBy eq 'month') ? 'month' : 'key';
@ -224,7 +226,6 @@ $DBQuery->execute(@SQLBindNewsgroups)
# set default to 'pretty' # set default to 'pretty'
$OptFormat = 'pretty' if !$OptFormat; $OptFormat = 'pretty' if !$OptFormat;
# print captions if --caption is set # print captions if --caption is set
my $LeadIn;
if ($OptCaptions && $OptComments) { if ($OptCaptions && $OptComments) {
# print time period with report type # print time period with report type
my $CaptionReportType= '(number of postings for each month)'; my $CaptionReportType= '(number of postings for each month)';
@ -234,9 +235,9 @@ if ($OptCaptions && $OptComments) {
$CaptionReportType= '(number of all postings for that time period)' $CaptionReportType= '(number of all postings for that time period)'
if $OptReportType eq 'sum'; if $OptReportType eq 'sum';
} }
$LeadIn .= sprintf("# ----- Report for %s %s\n",$CaptionPeriod,$CaptionReportType); printf("# ----- Report for %s %s\n",$CaptionPeriod,$CaptionReportType);
# print newsgroup list if --newsgroups is set # print newsgroup list if --newsgroups is set
$LeadIn .= sprintf("# ----- Newsgroups: %s\n",join(',',split(/:/,$OptNewsgroups))) printf("# ----- Newsgroups: %s\n",join(',',split(/:/,$OptNewsgroups)))
if $OptNewsgroups; if $OptNewsgroups;
# print boundaries, if set # print boundaries, if set
my $CaptionBoundary= '(counting only month fulfilling this condition)'; my $CaptionBoundary= '(counting only month fulfilling this condition)';
@ -245,12 +246,12 @@ if ($OptCaptions && $OptComments) {
$CaptionBoundary= '(on average)' if $OptBoundType eq 'average'; $CaptionBoundary= '(on average)' if $OptBoundType eq 'average';
$CaptionBoundary= '(all month summed up)' if $OptBoundType eq 'sum'; $CaptionBoundary= '(all month summed up)' if $OptBoundType eq 'sum';
} }
$LeadIn .= sprintf("# ----- Threshold: %s %s x %s %s %s\n", printf("# ----- Threshold: %s %s x %s %s %s\n",
$LowBound ? $LowBound : '',$LowBound ? '=>' : '', $LowBound ? $LowBound : '',$LowBound ? '=>' : '',
$UppBound ? '<=' : '',$UppBound ? $UppBound : '',$CaptionBoundary) $UppBound ? '<=' : '',$UppBound ? $UppBound : '',$CaptionBoundary)
if ($LowBound or $UppBound); if ($LowBound or $UppBound);
# print primary and secondary sort order # print primary and secondary sort order
$LeadIn .= sprintf("# ----- Grouped by %s (%s), sorted %s%s\n", printf("# ----- Grouped by %s (%s), sorted %s%s\n",
($GroupBy eq 'month') ? 'Months' : 'Newsgroups', ($GroupBy eq 'month') ? 'Months' : 'Newsgroups',
($OptGroupBy and $OptGroupBy =~ /-?desc$/i) ? 'descending' : 'ascending', ($OptGroupBy and $OptGroupBy =~ /-?desc$/i) ? 'descending' : 'ascending',
($OptOrderBy and $OptOrderBy =~ /posting/i) ? 'by number of postings ' : '', ($OptOrderBy and $OptOrderBy =~ /posting/i) ? 'by number of postings ' : '',
@ -259,7 +260,7 @@ if ($OptCaptions && $OptComments) {
# output data # output data
&OutputData($OptFormat,$OptComments,$GroupBy,$Precision, &OutputData($OptFormat,$OptComments,$GroupBy,$Precision,
$OptCheckgroupsFile ? $ValidGroups : '',$LeadIn, $OptCheckgroupsFile ? $ValidGroups : '',
$OptFileTemplate,$DBQuery,$MaxLength,$MaxValLength); $OptFileTemplate,$DBQuery,$MaxLength,$MaxValLength);
### close handles ### close handles
@ -335,6 +336,7 @@ using B<--nocomments>.
Last but not least you can redirect all output to a number of files, e.g. Last but not least you can redirect all output to a number of files, e.g.
one for each month, by submitting the B<--filetemplate> option, see below. one for each month, by submitting the B<--filetemplate> option, see below.
Captions and comments are automatically disabled in this case.
=head2 Configuration =head2 Configuration
@ -587,11 +589,10 @@ False by default.
=item B<--comments|--nocomments> =item B<--comments|--nocomments>
Add comments (group headers) to I<dump> and I<pretty> output. True by default Add comments (group headers) to I<dump> and I<pretty> output. True by default.
as logn as B<--filetemplate> is not set.
Use I<--nocomments> to suppress anything except newsgroup names/months and Use I<--nocomments> to suppress anything except newsgroup names/months and
numbers of postings. numbers of postings. This is enforced when using B<--filetemplate>, see below.
=item B<--filetemplate> I<filename template> =item B<--filetemplate> I<filename template>
@ -605,6 +606,8 @@ example with B<--filetemplate> I<stats>:
stats-2012-02 stats-2012-02
... and so on ... and so on
B<--nocomments> is enforced, see above.
=item B<--groupsdb> I<database table> =item B<--groupsdb> I<database table>
Override I<DBTableGrps> from F<newsstats.conf>. Override I<DBTableGrps> from F<newsstats.conf>.

354
bin/postingstats.pl
View file

@ -1,354 +0,0 @@
#!/usr/bin/perl
#
# postingstats.pl
#
# This script will create statistic postings from NewsStats output.
# It defaults to statistics for de.* posted to de.admin.lists, but
# defaults can be changed at ----- configuration -----.
#
# It is part of the NewsStats package.
#
# Copyright (c) 2010-2012, 2025 Thomas Hochstein <thh@thh.name>
#
# It can be redistributed and/or modified under the same terms under
# which Perl itself is published.
#
# Usage:
# $~ groupstats.pl --nocomments --sums --format dump | postingstats.pl -t groups
# $~ cliservstats.pl -t server --nocomments --sums --format dump | postingstats.pl -t hosts
#
BEGIN {
use File::Basename;
# we're in .../bin, so our module is in ../lib
push(@INC, dirname($0).'/../lib');
}
use strict;
use warnings;
use NewsStats qw(:DEFAULT LastMonth);
use Getopt::Long qw(GetOptions);
Getopt::Long::config ('bundling');
use constant TABLEWIDTH => 28; # width of table without newsgroup name
##### ----- pre-config -----------------------------------------------
### read commandline options
my ($Month, $Type);
GetOptions ('m|month=s' => \$Month,
't|type=s' => \$Type,
'h|help' => \&ShowPOD,
'V|version' => \&ShowVersion) or exit 1;
$Month = &LastMonth if !$Month;
if ($Month !~ /^\d{4}-\d{2}$/) {
$Month = &LastMonth;
&Bleat(1,"--month option has an invalid format - set to $Month.");
};
# parse $Type
if (!$Type) {
# default
$Type = 'GroupStats';
} elsif ($Type =~ /(news)?groups?/i) {
$Type = 'GroupStats';
} elsif ($Type =~ /(host|server)s?/i) {
$Type = 'HostStats';
};
my $Timestamp = time;
##### ----- configuration --------------------------------------------
my $TLH = 'de';
my %Heading = ('GroupStats' => 'Postingstatistik fuer de.* im Monat '.$Month,
'HostStats' => 'Serverstatistik fuer de.* im Monat '.$Month
);
my %TH = ('counter' => 'Nr.',
'value' => 'Anzahl',
'percentage' => 'Prozent'
);
my %LeadIn = ('GroupStats' => <<GROUPSIN, 'HostStats' => <<HOSTSIN);
From: Thomas Hochstein <thh\@thh.name>
Newsgroups: local.test
Subject: Postingstatistik fuer de.* im Monat $Month
Message-ID: <destat-postings-$Month.$Timestamp\@mid.news.szaf.org>
Approved: thh\@thh.name
Mime-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
User-Agent: postingstats.pl/$VERSION (NewsStats)
GROUPSIN
From: Thomas Hochstein <thh\@thh.name>
Newsgroups: local.test
Subject: Serverstatistik fuer de.* im Monat $Month
Message-ID: <destat-hosts-$Month.$Timestamp\@mid.news.szaf.org>
Approved: thh\@thh.name
Mime-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
User-Agent: postingstats.pl/$VERSION (NewsStats)
HOSTSIN
my %LeadOut = ('GroupStats' => <<GROUPSOUT, 'HostStats' => <<HOSTSOUT);
Alle Zahlen wurden ermittelt auf einem Newsserver mit redundanter Anbin-
dung fuer de.* unter Anwendung ueblicher Filtermassnahmen. Steuernach-
richten werden nicht erfasst; Postings, die supersedet oder gecancelt
wurden, bleiben erfasst, sofern sie das System ueberhaupt (und vor der
Loeschnachricht) erreicht haben. Crosspostings werden in jeder Gruppe,
in die sie gerichtet sind, gezaehlt, aber bei Ermittlung der Summe be-
reinigt; daher ist die Postinganzahl fuer de.* gesamt niedriger als die
Summe der Postinganzahlen der Einzelgruppen.
Die Daten stehen graphisch aufbereitet unter <http://usenet.dex.de/> zur
Verfuegung.
GROUPSOUT
Alle Zahlen wurden ermittelt auf einem Newsserver mit redundanter Anbin-
dung fuer de.* unter Anwendung ueblicher Filtermassnahmen. Steuernach-
richten werden nicht erfasst; Postings, die supersedet oder gecancelt
wurden, bleiben erfasst, sofern sie das System ueberhaupt (und vor der
Loeschnachricht) erreicht haben.
HOSTSOUT
##### ----- subroutines ----------------------------------------------
sub Percentage {
# calculate percentage rate from base value and percentage
my ($Base,$Percentage) = @_;
return ($Percentage * 100 / $Base);
}
sub Divider {
# build a divider line of $Symbol as wide as the table is
my ($Symbol,$MaxLength) = @_;
return ':' . $Symbol x ($MaxLength+TABLEWIDTH) . ":\n";
}
##### ----- main loop ------------------------------------------------
my (%Value, $SumName, $SumTotal, $MaxLength);
$MaxLength = 0;
if ($Type eq 'GroupStats') {
$SumName = "$TLH.ALL";
$TH{'name'} = 'Newsgroup'
} elsif ($Type eq 'HostStats') {
$SumName = 'ALL';
$TH{'name'} = 'Server'
}
# read from STDIN
while(<>) {
my ($Name, $Value) = split;
$SumTotal = $Value if $Name eq $SumName;
next if $Name =~ /ALL$/;
$Value{$Name} = $Value;
$MaxLength = length($Name) if length($Name) > $MaxLength;
}
# print to STDOUT
my $PaddingLeft = ' ' x int((($MaxLength+TABLEWIDTH-2-length($Heading{$Type}))/2));
my $PaddingRight = $PaddingLeft;
$PaddingLeft .= ' ' if (length($Heading{$Type}) + (length($PaddingLeft) * 2) < $MaxLength+TABLEWIDTH);
my $Counter = 0;
print $LeadIn{$Type};
print &Divider('=',$MaxLength);
printf(": %s%s%s :\n",$PaddingLeft,$Heading{$Type},$PaddingRight);
print &Divider('=',$MaxLength);
printf(": %-3s : %-6s : %-7s : %-*s :\n",
substr($TH{'counter'},0,3),
substr($TH{'value'},0,6),
substr($TH{'percentage'},0,7),
$MaxLength,$TH{'name'});
print &Divider('-',$MaxLength);
foreach my $Name (sort { $Value{$b} <=> $Value {$a}} keys %Value) {
$Counter++;
printf(": %3u. : %6u : %6.2f%% : %-*s :\n",$Counter,$Value{$Name},&Percentage($SumTotal,$Value{$Name}),$MaxLength,$Name);
}
print &Divider('-',$MaxLength);
printf(": : %6u : %s : %-*s :\n",$SumTotal,'100.00%',$MaxLength,'');
print &Divider('=',$MaxLength);
print $LeadOut{$Type};
__END__
################################ Documentation #################################
=head1 NAME
postingstats - format and post reports
=head1 SYNOPSIS
B<postingstats> B<-t> I<groups|hosts> [B<-Vh> [B<-m> I<YYYY-MM>]
=head1 REQUIREMENTS
See L<doc/README>.
=head1 DESCRIPTION
This script will re-format reports on newsgroup usage created by
B<groupstats.pl> or B<cliservstats.pl> and create a message that can
be posted to Usenet.
=head2 Features and options
B<postingstats> will create a table with entries numbered from most
to least and percentages calculated from the sum total of all values.
It depends on a sorted list on STDIN in I<dump> format with I<sums>.
B<postingstats> needs a B<--type> and a B<--month> to create a caption
and select matching lead-ins and lead-outs. B<--type> is also needed
to catch the correct sum total from input.
It will default to posting statistics (number of postings per group)
and last month.
Output from B<postingstats> can be piped to any C<inews> implementation,
e.g. C<tinews.pl> from L<ftp://ftp.tin.org/pub/news/clients/tin/tools/tinews.pl>
(present in C</contrib/>).
=head2 Configuration
Configuration is done by changing the code in the
C<----- configuration -----> section.
=over 3
=item C<$TLH>
Top level hierarchy the report was created for. Used for display and
sum total.
=item C<%Heading>
Hash with keys for I<GroupStats> and I<HostStats>. Used to display a
heading.
=item C<%TH>
Hash with keys for I<counter>, I<value> and I<percentage>. Used to
create the table header for I<number>, I<quantity> and I<percentage>.
I<counter> must not be longer than 3 characters, I<value> no longer
than 6 characters and I<percentage> no longer than 7 characters.
Output will be truncated otherwise.
=item C<%LeadIn>
Hash with keys for I<GroupStats> and I<HostStats>. Used to create the
headers for our posting. Can contain other text that will be shown
before C<%Heading>.
=item C<%LeadOut>
Hash with keys for I<GroupStats> and I<HostStats>. Will be shown at the
end of our posting.
=back
=head1 OPTIONS
=over 3
=item B<-V>, B<--version>
Print out version and copyright information and exit.
=item B<-h>, B<--help>
Print this man page and exit.
=item B<-t>, B<--type> I<groups|hosts>
Set report type to posting statistics or hosts statistics accordingly.
=item B<-m>, B<--month> I<YYYY-MM>
Set month for display.
=back
=head1 INSTALLATION
See L<doc/INSTALL>.
=head1 USAGE
Create a posting from a posting statistics report for last month:
groupstats.pl --nocomments --sums --format dump | postingstats.pl -t groups
Create a posting from a posting statistics report for 2012-01:
groupstats.pl --nocomments --sums --format dump | postingstats.pl -t groups -m 2012-01
Create a posting from a host statistics report for last month:
cliservstats.pl -t server --nocomments --sums --format dump | postingstats.pl -t hosts
=head1 FILES
=over 4
=item F<bin/postingstats.pl>
The script itself.
=item F<lib/NewsStats.pm>
Library functions for the NewsStats package.
=item F<etc/newsstats.conf>
Runtime configuration file.
=back
=head1 BUGS
Please report any bugs or feature requests to the author or use the
bug tracker at L<https://code.virtcomm.de/thh/newsstats/issues>!
=head1 SEE ALSO
=over 2
=item -
L<doc/README>
=item -
l>doc/INSTALL>
=item -
groupstats -h
=item -
cliservstats -h
=back
This script is part of the B<NewsStats> package.
=head1 AUTHOR
Thomas Hochstein <thh@thh.name>
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2010-2012, 2025 Thomas Hochstein <thh@thh.name>
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
=cut

9
contrib/dopostingstats.sh
View file

@ -1,9 +0,0 @@
#!/bin/bash
# installation path is /srv/newsstats/, please adjust accordingly
if [[ $1 =~ [0-9]{4}-[0-9]{2} ]]; then
/srv/newsstats/bin/groupstats.pl --nocomments --sums --format dump --month $1 | /srv/newsstats/bin/postingstats.pl --month $1 | /srv/newsstats/contrib/tinews.pl -X -Y
/srv/newsstats/bin/cliservstats.pl -t server --nocomments --sums --format dump --month $1 | /srv/newsstats/bin/postingstats.pl -t server --month $1 | /srv/newsstats/contrib/tinews.pl -X -Y
else
echo 'Input error, please use dopostingstats.sh YYYY-MM'
fi

1506
contrib/tinews.pl
View file

File diff suppressed because it is too large Load diff

11
contrib/yearstats.sh
View file

@ -1,11 +0,0 @@
#!/bin/bash
# installation path is /srv/newsstats/, please adjust accordingly
# $1: newsgroup
echo "Stats for $1"
cd /srv/newsstats/
for year in {2012..2022}
do
echo -n "${year}: "
bin/groupstats.pl -m $year-01:$year-12 -r sums -n $1
done

25
doc/ChangeLog
View file

@ -1,28 +1,3 @@
NewsStats 0.3.0 (2025-05-18)
* Extract GroupStats (in gatherstats) to subroutine.
* Add ParseHeader() to library.
* Add HostStats to gatherstats.
* Add DBTableHosts structure to install script.
* Add cliservstats (for hosts and clients).
- Refactor SQL generators.
* Add --mid option to gatherstats for debugging purposes.
* Don't parse NNTP-Posting-Host to determine the server name.
* Add more known hosts.
* Implement hierarchy check on gatherstats.
* Add sums per month to HostStats.
* Add postingstats and refactor it:
- Make all text configurable (i18n).
- Generalize to make it usable for HostStats.
- Fallback to last month if no month is given.
- Add option handling, import VERSION, add POD.
* Update README, INSTALL and ChangeLog.
* Don't enforce --nocomment for --filetemplate, just default to it.
Change caption handling, update documentation accordingly.
* Fix call to GetMaxLength() in cliservstats.
* Fix typos in documentation, update sample config file.
* Move database creation from install/install.pl to bin/dbcreate.pl
* Add tinews.pl and some shell scripts to /contrib.
NewsStats 0.2.0 (2025-05-10) NewsStats 0.2.0 (2025-05-10)
* Redo directory structure: * Redo directory structure:
- Move all scripts to /bin - Move all scripts to /bin

11
doc/INSTALL
View file

@ -1,4 +1,4 @@
NewsStats (c) 2010-2013, 2025 Thomas Hochstein <thh@thh.name> NewsStats (c) 2010-2013 Thomas Hochstein <thh@thh.name>
NewsStats is a software package used to gather statistical information NewsStats is a software package used to gather statistical information
from a live Usenet feed and for its subsequent examination. from a live Usenet feed and for its subsequent examination.
@ -14,7 +14,7 @@ INSTALLATION INSTRUCTIONS
1) Install the scripts 1) Install the scripts
* Download the current version of NewsStats from * Download the current version of NewsStats from
<https://th-h.de/net/software/newsstats/>. <http://th-h.de/download/scripts.php>.
* Untar it into a directory of your choice: * Untar it into a directory of your choice:
@ -57,9 +57,6 @@ INSTALLATION INSTRUCTIONS
* DBTableGrps = groups_de * DBTableGrps = groups_de
Table holding data on postings per group. Table holding data on postings per group.
* DBTableHosts = hosts_de
Table holding data on postings per server.
b) Optional configuration options b) Optional configuration options
* TLH = de * TLH = de
@ -70,9 +67,9 @@ INSTALLATION INSTRUCTIONS
* Setup your database server with a username, password and * Setup your database server with a username, password and
database matching the NewsStats configuration (see 2 a). database matching the NewsStats configuration (see 2 a).
* Start the database creation script: * Start the installation script:
# bin/dbcreate.pl # install/install.pl
It will setup the necessary database tables and display some It will setup the necessary database tables and display some
information on the next steps. information on the next steps.

28
doc/README
View file

@ -1,4 +1,4 @@
NewsStats (c) 2010-2013, 2025 Thomas Hochstein <thh@thh.name> NewsStats (c) 2010-2013 Thomas Hochstein <thh@thh.name>
NewsStats is a software package for gathering statistical data live NewsStats is a software package for gathering statistical data live
from a Usenet feed and subsequent examination. from a Usenet feed and subsequent examination.
@ -13,7 +13,7 @@ What's that?
There's a multitude of tools for the statistical examination of There's a multitude of tools for the statistical examination of
newsgroups: number of postings per month or per person, longest newsgroups: number of postings per month or per person, longest
threads, and so on (see <https://th-h.de/net/usenet/stats/> threads, and so on (see <http://th-h.de/infos/usenet/stats.php>
[German language] for an incomplete list). Most of them use a per- [German language] for an incomplete list). Most of them use a per-
newsgroup approach while NewsStats is hierarchy oriented. newsgroup approach while NewsStats is hierarchy oriented.
@ -43,7 +43,7 @@ Prerequisites
- File::Basename - File::Basename
- Sys::Syslog - Sys::Syslog
* Perl modules from CPAN * Perl modules form CPAN
- Config::Auto - Config::Auto
- Date::Format - Date::Format
- DBI - DBI
@ -54,28 +54,21 @@ Prerequisites
Installation instructions Installation instructions
See INSTALL. See INSTALL.
Documentation is in /doc, configuration in /etc, the NewsStats
module in /lib and most scripts in /bin, while /contrib has some
sample scripts that may have to be adjusted to work in your
configuration.
Getting Started Getting Started
'feedlog.pl' will continuously feed raw data to your raw data 'feedlog.pl' will continuously feed raw data to your raw data
table. See the feedlog.pl man page for more information. table. See the feedlog.pl man page for more information.
You can process that data via 'gatherstats.pl'; currently the You can process that data via 'gatherstats.pl'; currently only the
tabulation of postings per group and injection server per month is tabulation of postings per group and month is supported. More to
supported. Tabulation of clients (newsreaders) is planned. See come. See the gatherstats.pl man page for more information.
the gatherstats.pl man page for more information.
Report generation is handled by specialised scripts for each Report generation is handled by specialised scripts for each
report type. Currently reports on the number of postings per group report type. Currently only reports on the number of postings per
and month and injection server and month are supported; you can group and month are supported; you can use 'groupstats.pl' for
use 'groupstats.pl' and 'cliservstats.pl' for that. See the this. See the groupstats.pl man page for more information.
groupstats.pl and cliservstats.pl man pages for more information.
Reporting Bugs Reporting Bugs
@ -100,3 +93,4 @@ Author
Thomas Hochstein <thh@thh.name> Thomas Hochstein <thh@thh.name>
<https://th-h.de/> <https://th-h.de/>

5
doc/TODO
View file

@ -28,7 +28,8 @@ NewsStats.
mentioned information; and you should be able to get the history of any mentioned information; and you should be able to get the history of any
group. group.
- Add other reports - Add other reports
NewsStats should include some other kinds of reports (stats on used clients) NewsStats should include some other kinds of reports (stats on used clients,
on postings hosts/servers, ...)
- Add tools for database management - Add tools for database management
NewsStats should offer tools e.g. to inject postings into the 'raw' database, NewsStats should offer tools e.g. to inject postings into the 'raw' database,
or to split databases. or to split databases.
@ -64,7 +65,7 @@ NewsStats.
+ gatherstats.pl + gatherstats.pl
- Use hierarchy information (see GroupInfo above) - Use hierarchy information (see GroupInfo above)
- Add gathering of other stats (clients, ...) - Add gathering of other stats (clients, hosts, ...)
- better modularisation (code reuse for other reports!) - better modularisation (code reuse for other reports!)
- Add / enhance / test error handling - Add / enhance / test error handling
- General tests and optimisations - General tests and optimisations

2
etc/newsstats.conf.sample
View file

@ -12,8 +12,8 @@ DBDatabase = newsstats
# #
DBTableRaw = raw_de DBTableRaw = raw_de
DBTableGrps = groups_de DBTableGrps = groups_de
DBTableHosts = hosts_de
#DBTableClnts = #DBTableClnts =
#DBTableHosts =
### hierarchy configuration ### hierarchy configuration
TLH = de TLH = de

51
bin/dbcreate.pl → install/install.pl
View file

@ -1,19 +1,19 @@
#! /usr/bin/perl #! /usr/bin/perl
# #
# dbcreate.pl # install.pl
# #
# This script will create database tables as necessary. # This script will create database tables as necessary.
# #
# It is part of the NewsStats package. # It is part of the NewsStats package.
# #
# Copyright (c) 2010-2013, 2025 Thomas Hochstein <thh@thh.name> # Copyright (c) 2010-2013 Thomas Hochstein <thh@thh.name>
# #
# 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.
BEGIN { BEGIN {
use File::Basename; use File::Basename;
# we're in .../bin, so our module is in ../lib # we're in .../install, so our module is in ../lib
push(@INC, dirname($0).'/../lib'); push(@INC, dirname($0).'/../lib');
} }
use strict; use strict;
@ -46,7 +46,7 @@ my $DBCreate = <<SQLDB;
CREATE DATABASE IF NOT EXISTS `$Conf{'DBDatabase'}` DEFAULT CHARSET=utf8; CREATE DATABASE IF NOT EXISTS `$Conf{'DBDatabase'}` DEFAULT CHARSET=utf8;
SQLDB SQLDB
my %DBCreate = ('DBTableRaw' => <<RAW, 'DBTableGrps' => <<GRPS, 'DBTableHosts' => <<HOSTS); my %DBCreate = ('DBTableRaw' => <<RAW, 'DBTableGrps' => <<GRPS);
-- --
-- Table structure for table DBTableRaw -- Table structure for table DBTableRaw
-- --
@ -82,26 +82,10 @@ CREATE TABLE IF NOT EXISTS `$Conf{'DBTableGrps'}` (
`revision` timestamp NOT NULL default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP, `revision` timestamp NOT NULL default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP,
PRIMARY KEY (`id`), PRIMARY KEY (`id`),
UNIQUE KEY `month_newsgroup` (`month`,`newsgroup`), UNIQUE KEY `month_newsgroup` (`month`,`newsgroup`),
KEY `month` (`month`), KEY `newsgroup` (`newsgroup`),
KEY `newsgroup` (`newsgroup`) KEY `postings` (`postings`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Postings per newsgroup'; ) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Postings per newsgroup';
GRPS GRPS
--
-- Table structure for table DBTableHosts
--
CREATE TABLE IF NOT EXISTS `$Conf{'DBTableHosts'}` (
`id` bigint(20) unsigned NOT NULL auto_increment,
`month` varchar(7) character set ascii NOT NULL,
`host` varchar(100) NOT NULL,
`postings` int(11) NOT NULL,
`revision` timestamp NOT NULL default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP,
PRIMARY KEY (`id`),
UNIQUE KEY `month_host` (`month`,`host`),
KEY `month` (`month`),
KEY `host` (`host`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 COMMENT='Postings per server';
HOSTS
##### -------------------------------------------------------------------------- ##### --------------------------------------------------------------------------
##### Installation / upgrade instructions ##### Installation / upgrade instructions
@ -169,8 +153,8 @@ UPGRADE
if (!$OptUpdate) { if (!$OptUpdate) {
print "----------\nStarting database creation.\n"; print "----------\nStarting database creation.\n";
# create database # create database
# we can't use InitDB() as that will use the database name of # we can't use InitDB() as that will use a table name of
# the database that doesn't exist yet ... # the table that doesn't exist yet ...
my $DBHandle = DBI->connect(sprintf('DBI:%s:host=%s',$Conf{'DBDriver'}, my $DBHandle = DBI->connect(sprintf('DBI:%s:host=%s',$Conf{'DBDriver'},
$Conf{'DBHost'}), $Conf{'DBUser'}, $Conf{'DBHost'}), $Conf{'DBUser'},
$Conf{'DBPw'}, { PrintError => 0 }); $Conf{'DBPw'}, { PrintError => 0 });
@ -178,7 +162,7 @@ if (!$OptUpdate) {
$DBQuery->execute() or &Bleat(2, sprintf("Can't create database %s: %s%\n", $DBQuery->execute() or &Bleat(2, sprintf("Can't create database %s: %s%\n",
$Conf{'DBDatabase'}, $DBI::errstr)); $Conf{'DBDatabase'}, $DBI::errstr));
printf("Database %s created succesfully.\n",$Conf{'DBDatabase'}); printf("Database table %s created succesfully.\n",$Conf{'DBDatabase'});
$DBHandle->disconnect; $DBHandle->disconnect;
}; };
@ -201,7 +185,7 @@ if (!$OptUpdate) {
} else { } else {
##### upgrade mode ##### upgrade mode
print "----------\nStarting upgrade process.\n"; print "----------\nStarting upgrade process.\n";
my $PackageVersion = '0.03'; $PackageVersion = '0.03';
if ($OptUpdate < $PackageVersion) { if ($OptUpdate < $PackageVersion) {
if ($OptUpdate < 0.02) { if ($OptUpdate < 0.02) {
# 0.01 -> 0.02 # 0.01 -> 0.02
@ -231,7 +215,7 @@ sub CreateTable {
}; };
my $DBQuery = $DBHandle->prepare($DBCreate{$Table}); my $DBQuery = $DBHandle->prepare($DBCreate{$Table});
$DBQuery->execute() or $DBQuery->execute() or
&Bleat(2, sprintf("Can't create table %s in database %s: %s\n",$Table, &Bleat(2, sprintf("Can't create table %s in database %s: %s%\n",$Table,
$Conf{'DBDatabase'},$DBI::errstr)); $Conf{'DBDatabase'},$DBI::errstr));
printf("Database table %s.%s created succesfully.\n", printf("Database table %s.%s created succesfully.\n",
$Conf{'DBDatabase'},$Conf{$Table}); $Conf{'DBDatabase'},$Conf{$Table});
@ -261,11 +245,11 @@ __END__
=head1 NAME =head1 NAME
dbcreate - database creation script install - installation script
=head1 SYNOPSIS =head1 SYNOPSIS
B<dbcreate> [B<-Vh> [--update I<version>] [B<--conffile> I<filename>] B<install> [B<-Vh> [--update I<version>] [B<--conffile> I<filename>]
=head1 REQUIREMENTS =head1 REQUIREMENTS
@ -273,12 +257,11 @@ See L<doc/README>.
=head1 DESCRIPTION =head1 DESCRIPTION
This script will create a database and database tables as necessary This script will create database tables as necessary and configured.
and configured.
=head2 Configuration =head2 Configuration
B<dbcreate> will read its configuration from F<newsstats.conf> which should B<install> will read its configuration from F<newsstats.conf> which should
be present in etc/ via Config::Auto or from a configuration file submitted be present in etc/ via Config::Auto or from a configuration file submitted
by the B<--conffile> option. by the B<--conffile> option.
@ -310,7 +293,7 @@ Load configuration from I<filename> instead of F<newsstats.conf>.
=over 4 =over 4
=item F<bin/dbcreate.pl> =item F<install/install.pl>
The script itself. The script itself.
@ -351,7 +334,7 @@ Thomas Hochstein <thh@thh.name>
=head1 COPYRIGHT AND LICENSE =head1 COPYRIGHT AND LICENSE
Copyright (c) 2010-2013, 2025 Thomas Hochstein <thh@thh.name> Copyright (c) 2010-2013 Thomas Hochstein <thh@thh.name>
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.

149
lib/NewsStats.pm
View file

@ -2,7 +2,7 @@
# #
# Library functions for the NewsStats package. # Library functions for the NewsStats package.
# #
# Copyright (c) 2010-2013, 2025 Thomas Hochstein <thh@thh.name> # Copyright (c) 2010-2013 Thomas Hochstein <thh@thh.name>
# #
# This module can be redistributed and/or modified under the same terms under # This module can be redistributed and/or modified under the same terms under
# which Perl itself is published. # which Perl itself is published.
@ -34,7 +34,6 @@ require Exporter;
ListNewsgroups ListNewsgroups
ParseHierarchies ParseHierarchies
ReadGroupList ReadGroupList
ParseHeaders
OutputData OutputData
FormatOutput FormatOutput
SQLHierarchies SQLHierarchies
@ -49,7 +48,7 @@ require Exporter;
Output => [qw(OutputData FormatOutput)], Output => [qw(OutputData FormatOutput)],
SQLHelper => [qw(SQLHierarchies SQLSortOrder SQLGroupList SQLHelper => [qw(SQLHierarchies SQLSortOrder SQLGroupList
SQLSetBounds SQLBuildClause GetMaxLength)]); SQLSetBounds SQLBuildClause GetMaxLength)]);
$VERSION = '0.3.0'; $VERSION = '0.2.0';
use Data::Dumper; use Data::Dumper;
use File::Basename; use File::Basename;
@ -77,7 +76,7 @@ sub ShowVersion {
################################################################################ ################################################################################
### display version and exit ### display version and exit
print "$0 from NewsStats v$VERSION\n"; print "$0 from NewsStats v$VERSION\n";
print "Copyright (c) 2010-2013, 2025 Thomas Hochstein <thh\@thh.name>\n"; print "Copyright (c) 2010-2013 Thomas Hochstein <thh\@thh.name>\n";
print "This program is free software; you may redistribute it ". print "This program is free software; you may redistribute it ".
"and/or modify it under the same terms as Perl itself.\n"; "and/or modify it under the same terms as Perl itself.\n";
exit(100); exit(100);
@ -255,42 +254,6 @@ sub ReadGroupList {
return \%ValidGroups; return \%ValidGroups;
}; };
################################################################################
sub ParseHeaders {
################################################################################
### return a hash of all headers (ignoring duplicate headers)
### parsed from raw headers
### -> taken and modified from pgpverify
### -> Written April 1996, <tale@isc.org> (David C Lawrence)
### -> Currently maintained by Russ Allbery <eagle@eyrie.org>
### IN : $RawHeaders : raw headers as found in posting
### OUT: %Headers : hash containing header contents,
### keyed by lower-case header name
my (%Header, $Label, $Value);
foreach (@_) {
s/\r?\n$//;
last if /^$/;
if (/^(\S+):[ \t](.+)/) {
($Label, $Value) = ($1, $2);
# discard all duplicate headers
next if $Header{lc($Label)};
$Header{lc($Label)} = $Value;
} elsif (/^\s/) {
# continuation lines
if ($Label) {
$Header{lc($Label)} .= "\n$_";
} else {
warn (sprintf("Non-header line: %s\n",$_));
}
} else {
warn (sprintf("Non-header line: %s\n",$_));
}
}
return %Header;
};
################################################################################ ################################################################################
#####----------------------------- TimePeriods ----------------------------##### #####----------------------------- TimePeriods ----------------------------#####
@ -430,13 +393,12 @@ sub OutputData {
### $GroupBy : primary sorting order (month or key) ### $GroupBy : primary sorting order (month or key)
### $Precision: number of digits right of decimal point (0 or 2) ### $Precision: number of digits right of decimal point (0 or 2)
### $ValidKeys: reference to a hash containing all valid keys ### $ValidKeys: reference to a hash containing all valid keys
### $LeadIn : print at start of output
### $FileTempl: file name template (--filetemplate): filetempl-YYYY-MM ### $FileTempl: file name template (--filetemplate): filetempl-YYYY-MM
### $DBQuery : database query handle with executed query, ### $DBQuery : database query handle with executed query,
### containing $Month, $Key, $Value ### containing $Month, $Key, $Value
### $PadField : padding length for key field (optional) for 'pretty' ### $PadField : padding length for key field (optional) for 'pretty'
### $PadValue : padding length for value field (optional) for 'pretty' ### $PadValue : padding length for value field (optional) for 'pretty'
my ($Format, $Comments, $GroupBy, $Precision, $ValidKeys, $LeadIn, $FileTempl, my ($Format, $Comments, $GroupBy, $Precision, $ValidKeys, $FileTempl,
$DBQuery, $PadField, $PadValue) = @_; $DBQuery, $PadField, $PadValue) = @_;
my %ValidKeys = %{$ValidKeys} if $ValidKeys; my %ValidKeys = %{$ValidKeys} if $ValidKeys;
my ($FileName, $Handle, $OUT); my ($FileName, $Handle, $OUT);
@ -479,8 +441,8 @@ sub OutputData {
$FileName)); $FileName));
$Handle = $OUT; $Handle = $OUT;
}; };
print $Handle &FormatOutput($Format, $Comments, $LeadIn, $Caption, print $Handle &FormatOutput($Format, $Comments, $Caption, $Key, $Value,
$Key, $Value, $Precision, $PadField, $PadValue); $Precision, $PadField, $PadValue);
$LastIteration = $Caption; $LastIteration = $Caption;
}; };
close $OUT if ($FileTempl); close $OUT if ($FileTempl);
@ -499,7 +461,7 @@ sub FormatOutput {
### $PadField : padding length for key field (optional) for 'pretty' ### $PadField : padding length for key field (optional) for 'pretty'
### $PadValue : padding length for value field (optional) for 'pretty' ### $PadValue : padding length for value field (optional) for 'pretty'
### OUT: $Output: formatted output ### OUT: $Output: formatted output
my ($Format, $Comments, $LeadIn, $Caption, $Key, $Value, $Precision, $PadField, my ($Format, $Comments, $Caption, $Key, $Value, $Precision, $PadField,
$PadValue) = @_; $PadValue) = @_;
my ($Output); my ($Output);
# keep last caption in mind # keep last caption in mind
@ -515,10 +477,8 @@ sub FormatOutput {
$Output = sprintf ("%s %s %u\n",$Caption,$Key,$Value); $Output = sprintf ("%s %s %u\n",$Caption,$Key,$Value);
} elsif ($Format eq 'pretty') { } elsif ($Format eq 'pretty') {
# output as a table # output as a table
if ($Comments and (!defined($LastIteration) or $Caption ne $LastIteration)) { $Output = sprintf ("# ----- %s:\n",$Caption)
$Output = $LeadIn; if ($Comments and (!defined($LastIteration) or $Caption ne $LastIteration));
$Output .= sprintf ("# ----- %s:\n",$Caption);
}
# increase $PadValue for numbers with decimal point # increase $PadValue for numbers with decimal point
$PadValue += $Precision+1 if $Precision; $PadValue += $Precision+1 if $Precision;
# add padding if $PadField is set; $PadValue HAS to be set then # add padding if $PadField is set; $PadValue HAS to be set then
@ -582,22 +542,21 @@ sub SQLSortOrder {
### IN : $GroupBy: primary sort by 'month' (default) or 'newsgroups' ### IN : $GroupBy: primary sort by 'month' (default) or 'newsgroups'
### $OrderBy: secondary sort by month/newsgroups (default) ### $OrderBy: secondary sort by month/newsgroups (default)
### or number of 'postings' ### or number of 'postings'
### $Type : newsgroup, host, client
### OUT: a SQL ORDER BY clause ### OUT: a SQL ORDER BY clause
my ($GroupBy,$OrderBy,$Type) = @_; my ($GroupBy,$OrderBy) = @_;
my ($GroupSort,$OrderSort) = ('',''); my ($GroupSort,$OrderSort) = ('','');
# $GroupBy (primary sorting) # $GroupBy (primary sorting)
if (!$GroupBy) { if (!$GroupBy) {
$GroupBy = 'month'; $GroupBy = 'month';
} else { } else {
($GroupBy, $GroupSort) = SQLParseOrder($GroupBy); ($GroupBy, $GroupSort) = SQLParseOrder($GroupBy);
if ($GroupBy =~ /name/i) { if ($GroupBy =~ /group/i) {
$GroupBy = $Type; $GroupBy = 'newsgroup';
} else { } else {
$GroupBy = 'month'; $GroupBy = 'month';
} }
} }
my $Secondary = ($GroupBy eq 'month') ? $Type : 'month'; my $Secondary = ($GroupBy eq 'month') ? 'newsgroup' : 'month';
# $OrderBy (secondary sorting) # $OrderBy (secondary sorting)
if (!$OrderBy) { if (!$OrderBy) {
$OrderBy = $Secondary; $OrderBy = $Secondary;
@ -633,45 +592,44 @@ sub SQLParseOrder {
################################################################################ ################################################################################
sub SQLGroupList { sub SQLGroupList {
################################################################################ ################################################################################
### explode list of names separated by : (with wildcards) ### explode list of newsgroups separated by : (with wildcards)
### to a SQL 'WHERE' expression ### to a SQL 'WHERE' expression
### IN : $Names: list of names, e.g. newsgroups (group.one.*:group.two:group.three.*) ### IN : $Newsgroups: list of newsgroups (group.one.*:group.two:group.three.*)
### $Type : newsgroup, host, client
### OUT: SQL code to become part of a 'WHERE' clause, ### OUT: SQL code to become part of a 'WHERE' clause,
### list of names for SQL bindings ### list of newsgroups for SQL bindings
my ($Names,$Type) = @_; my ($Newsgroups) = @_;
# substitute '*' wildcard with SQL wildcard character '%' # substitute '*' wildcard with SQL wildcard character '%'
$Names =~ s/\*/%/g; $Newsgroups =~ s/\*/%/g;
return (undef,undef) if !CheckValidNames($Names); return (undef,undef) if !CheckValidNewsgroups($Newsgroups);
# just one name/newsgroup? # just one newsgroup?
return (SQLGroupWildcard($Names,$Type),$Names) if $Names !~ /:/; return (SQLGroupWildcard($Newsgroups),$Newsgroups) if $Newsgroups !~ /:/;
my ($SQL,@WildcardNames,@NoWildcardNames); my ($SQL,@WildcardGroups,@NoWildcardGroups);
# list of names/newsgroups separated by ':' # list of newsgroups separated by ':'
my @NameList = split /:/, $Names; my @GroupList = split /:/, $Newsgroups;
foreach (@NameList) { foreach (@GroupList) {
if ($_ !~ /%/) { if ($_ !~ /%/) {
# add to list of names/newsgroup names WITHOUT wildcard # add to list of newsgroup names WITHOUT wildcard
push (@NoWildcardNames,$_); push (@NoWildcardGroups,$_);
} else { } else {
# add to list of names WITH wildcard # add to list of newsgroup names WITH wildcard
push (@WildcardNames,$_); push (@WildcardGroups,$_);
# add wildcard to SQL clause # add wildcard to SQL clause
# 'OR' if SQL clause is not empty # 'OR' if SQL clause is not empty
$SQL .= ' OR ' if $SQL; $SQL .= ' OR ' if $SQL;
$SQL .= "$Type LIKE ?" $SQL .= 'newsgroup LIKE ?'
} }
}; };
if (scalar(@NoWildcardNames)) { if (scalar(@NoWildcardGroups)) {
# add 'OR' if SQL clause is not empty # add 'OR' if SQL clause is not empty
$SQL .= ' OR ' if $SQL; $SQL .= ' OR ' if $SQL;
if (scalar(@NoWildcardNames) < 2) { if (scalar(@NoWildcardGroups) < 2) {
# special case: just one name without wildcard # special case: just one newsgroup without wildcard
$SQL .= "$Type = ?"; $SQL .= 'newsgroup = ?';
} else { } else {
# create list of names to include: e.g. 'newsgroup IN (...)' # create list of newsgroups to include: 'newsgroup IN (...)'
$SQL .= "$Type IN ("; $SQL .= 'newsgroup IN (';
my $SQLin; my $SQLin;
foreach (@NoWildcardNames) { foreach (@NoWildcardGroups) {
$SQLin .= ',' if $SQLin; $SQLin .= ',' if $SQLin;
$SQLin .= '?'; $SQLin .= '?';
} }
@ -679,28 +637,27 @@ sub SQLGroupList {
$SQL .= $SQLin .= ')'; $SQL .= $SQLin .= ')';
} }
} }
# add brackets '()' to SQL clause as needed (more than one wildcard name) # add brackets '()' to SQL clause as needed (more than one wildcard group)
if (scalar(@WildcardNames)) { if (scalar(@WildcardGroups)) {
$SQL = '(' . $SQL .')'; $SQL = '(' . $SQL .')';
} }
# rebuild @NameList in (now) correct order # rebuild @GroupList in (now) correct order
@NameList = (@WildcardNames,@NoWildcardNames); @GroupList = (@WildcardGroups,@NoWildcardGroups);
return ($SQL,@NameList); return ($SQL,@GroupList);
}; };
################################################################################ ################################################################################
sub SQLGroupWildcard { sub SQLGroupWildcard {
################################################################################ ################################################################################
### build a valid SQL 'WHERE' expression with or without wildcards ### build a valid SQL 'WHERE' expression with or without wildcards
### IN : $Name: expression, probably with wildcard ### IN : $Newsgroup: newsgroup expression, probably with wildcard
### (group.name or group.name.%) ### (group.name or group.name.%)
### $Type: newsgroup, host, client
### OUT: SQL code to become part of a 'WHERE' clause ### OUT: SQL code to become part of a 'WHERE' clause
my ($Name,$Type) = @_; my ($Newsgroup) = @_;
if ($Name !~ /%/) { if ($Newsgroup !~ /%/) {
return "$Type = ?"; return 'newsgroup = ?';
} else { } else {
return "$Type LIKE ?"; return 'newsgroup LIKE ?';
} }
}; };
@ -802,14 +759,14 @@ sub SQLBuildClause {
#####--------------------------- Verifications ----------------------------##### #####--------------------------- Verifications ----------------------------#####
################################################################################ ################################################################################
sub CheckValidNames { sub CheckValidNewsgroups {
################################################################################ ################################################################################
### syntax check of a list ### syntax check of newgroup list
### IN : $Names: list of names, e.g. newsgroups (group.one.*:group.two:group.three.*) ### IN : $Newsgroups: list of newsgroups (group.one.*:group.two:group.three.*)
### OUT: boolean ### OUT: boolean
my ($Names) = @_; my ($Newsgroups) = @_;
my $InvalidCharRegExp = ',; '; my $InvalidCharRegExp = ',; ';
return ($Names =~ /[$InvalidCharRegExp]/) ? 0 : 1; return ($Newsgroups =~ /[$InvalidCharRegExp]/) ? 0 : 1;
}; };