Compare commits
30 commits
4cdb771866
...
5a6a3e58bf
| Author | SHA1 | Date | |
|---|---|---|---|
| 5a6a3e58bf | |||
| 8c9d450d47 | |||
| 9b6bf3e194 | |||
| 4ad63fcb4e | |||
| 6afa9a62b9 | |||
| 7169e2636f | |||
| 0ee389fc42 | |||
| 28157570f1 | |||
| 7dd8a95be3 | |||
| 29e9784048 | |||
| 83d4da5e30 | |||
| 53c2032850 | |||
| c6346470f9 | |||
| ea493f3da0 | |||
| e40e96a1e2 | |||
| f7485561dd | |||
| f6b7a1d000 | |||
| c7206a2eaf | |||
| 799eddab5b | |||
| c1e6b0161e | |||
| f5aa649810 | |||
| 93b8d564ba | |||
| c6432dcd44 | |||
| 57af475b80 | |||
| 867498fdc8 | |||
| 713db80545 | |||
| 9ccb915d77 | |||
| 73a2d70f16 | |||
| 0a0e615ede | |||
| a31e86444a |
14 changed files with 2888 additions and 193 deletions
537
bin/cliservstats.pl
Normal file
537
bin/cliservstats.pl
Normal file
|
|
@ -0,0 +1,537 @@
|
||||||
|
#! /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
|
||||||
|
|
@ -1,19 +1,19 @@
|
||||||
#! /usr/bin/perl
|
#! /usr/bin/perl
|
||||||
#
|
#
|
||||||
# install.pl
|
# dbcreate.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 Thomas Hochstein <thh@thh.name>
|
# Copyright (c) 2010-2013, 2025 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 .../install, so our module is in ../lib
|
# we're in .../bin, 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);
|
my %DBCreate = ('DBTableRaw' => <<RAW, 'DBTableGrps' => <<GRPS, 'DBTableHosts' => <<HOSTS);
|
||||||
--
|
--
|
||||||
-- Table structure for table DBTableRaw
|
-- Table structure for table DBTableRaw
|
||||||
--
|
--
|
||||||
|
|
@ -82,10 +82,26 @@ 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 `newsgroup` (`newsgroup`),
|
KEY `month` (`month`),
|
||||||
KEY `postings` (`postings`)
|
KEY `newsgroup` (`newsgroup`)
|
||||||
) 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
|
||||||
|
|
@ -153,8 +169,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 a table name of
|
# we can't use InitDB() as that will use the database name of
|
||||||
# the table that doesn't exist yet ...
|
# the database 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 });
|
||||||
|
|
@ -162,7 +178,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 table %s created succesfully.\n",$Conf{'DBDatabase'});
|
printf("Database %s created succesfully.\n",$Conf{'DBDatabase'});
|
||||||
$DBHandle->disconnect;
|
$DBHandle->disconnect;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
@ -185,7 +201,7 @@ if (!$OptUpdate) {
|
||||||
} else {
|
} else {
|
||||||
##### upgrade mode
|
##### upgrade mode
|
||||||
print "----------\nStarting upgrade process.\n";
|
print "----------\nStarting upgrade process.\n";
|
||||||
$PackageVersion = '0.03';
|
my $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
|
||||||
|
|
@ -215,7 +231,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});
|
||||||
|
|
@ -245,11 +261,11 @@ __END__
|
||||||
|
|
||||||
=head1 NAME
|
=head1 NAME
|
||||||
|
|
||||||
install - installation script
|
dbcreate - database creation script
|
||||||
|
|
||||||
=head1 SYNOPSIS
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
B<install> [B<-Vh> [--update I<version>] [B<--conffile> I<filename>]
|
B<dbcreate> [B<-Vh> [--update I<version>] [B<--conffile> I<filename>]
|
||||||
|
|
||||||
=head1 REQUIREMENTS
|
=head1 REQUIREMENTS
|
||||||
|
|
||||||
|
|
@ -257,11 +273,12 @@ See L<doc/README>.
|
||||||
|
|
||||||
=head1 DESCRIPTION
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
This script will create database tables as necessary and configured.
|
This script will create a database and database tables as necessary
|
||||||
|
and configured.
|
||||||
|
|
||||||
=head2 Configuration
|
=head2 Configuration
|
||||||
|
|
||||||
B<install> will read its configuration from F<newsstats.conf> which should
|
B<dbcreate> 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.
|
||||||
|
|
||||||
|
|
@ -293,7 +310,7 @@ Load configuration from I<filename> instead of F<newsstats.conf>.
|
||||||
|
|
||||||
=over 4
|
=over 4
|
||||||
|
|
||||||
=item F<install/install.pl>
|
=item F<bin/dbcreate.pl>
|
||||||
|
|
||||||
The script itself.
|
The script itself.
|
||||||
|
|
||||||
|
|
@ -334,7 +351,7 @@ Thomas Hochstein <thh@thh.name>
|
||||||
|
|
||||||
=head1 COPYRIGHT AND LICENSE
|
=head1 COPYRIGHT AND LICENSE
|
||||||
|
|
||||||
Copyright (c) 2010-2013 Thomas Hochstein <thh@thh.name>
|
Copyright (c) 2010-2013, 2025 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.
|
||||||
|
|
@ -7,7 +7,7 @@
|
||||||
#
|
#
|
||||||
# It is part of the NewsStats package.
|
# It is part of the NewsStats package.
|
||||||
#
|
#
|
||||||
# Copyright (c) 2010-2013 Thomas Hochstein <thh@thh.name>
|
# Copyright (c) 2010-2013, 2025 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);
|
use NewsStats qw(:DEFAULT :TimePeriods ListNewsgroups ParseHierarchies ReadGroupList ParseHeaders);
|
||||||
|
|
||||||
use DBI;
|
use DBI;
|
||||||
use Getopt::Long qw(GetOptions);
|
use Getopt::Long qw(GetOptions);
|
||||||
|
|
@ -31,19 +31,21 @@ 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')} = ();
|
@LegalStats{('all','groups','hosts')} = ();
|
||||||
|
|
||||||
################################# Main program #################################
|
################################# Main program #################################
|
||||||
|
|
||||||
### read commandline options
|
### read commandline options
|
||||||
my ($OptCheckgroupsFile,$OptClientsDB,$OptDebug,$OptGroupsDB,$OptTLH,
|
my ($OptCheckgroupsFile,$OptClientsDB,$OptDebug,$OptGroupsDB,$OptTLH,
|
||||||
$OptHostsDB,$OptMonth,$OptRawDB,$OptStatsType,$OptTest,$OptConfFile);
|
$OptHostsDB,$OptMID,$OptMonth,$OptRawDB,$OptStatsType,$OptTest,
|
||||||
|
$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,
|
||||||
|
|
@ -64,6 +66,11 @@ $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))
|
||||||
|
|
@ -108,6 +115,9 @@ 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;
|
||||||
|
|
@ -115,90 +125,262 @@ 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') {
|
||||||
# read list of newsgroups from --checkgroups
|
&GroupStats($DBHandle,$DBRaw,$DBGrps,$Month,$TLH,$OptCheckgroupsFile,$OptMID,$OptTest,$OptDebug);
|
||||||
# into a hash
|
};
|
||||||
my %ValidGroups = %{ReadGroupList(sprintf('%s-%s',$OptCheckgroupsFile,$Month))}
|
|
||||||
if $OptCheckgroupsFile;
|
|
||||||
|
|
||||||
### ----------------------------------------------
|
### HostStats
|
||||||
### get groups data (number of postings per group)
|
if ($OptStatsType eq 'all' or $OptStatsType eq 'hosts') {
|
||||||
# get groups data from raw table for given month
|
# define known hosts using subdomains
|
||||||
my $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s.%s ".
|
my @KnownHosts = qw(abavia.com aioe.org arcor-online.net arcor-ip.de astraweb.com read.cnntp.org
|
||||||
"WHERE day LIKE ? AND NOT disregard",
|
easynews.com eternal-september.org euro.net fernuni-hagen.de free.fr newsread.freenet.ag
|
||||||
$Conf{'DBDatabase'},
|
googlegroups.com heirich.name news.neostrada.pl netcologne.de newsdawg.com newscene.com
|
||||||
$Conf{'DBTableRaw'}));
|
news-service.com octanews.com readnews.com wieslauf.sub.de highway.telekom.at
|
||||||
$DBQuery->execute($Month.'-%')
|
united-newsserver.de xennanews.com xlned.com xsnews.nl news.xs4all.nl);
|
||||||
or &Bleat(2,sprintf("Can't get groups data for %s from %s.%s: ".
|
&HostStats($DBHandle,$DBRaw,$DBHosts,$Month,$OptMID,$OptTest,$OptDebug,@KnownHosts);
|
||||||
"$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 #################################
|
||||||
|
|
@ -231,9 +413,7 @@ 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. Currently that doesn't matter yet as only
|
information to process.
|
||||||
processing of the number of postings per group per month is
|
|
||||||
implemented anyway.
|
|
||||||
|
|
||||||
Possible information types include:
|
Possible information types include:
|
||||||
|
|
||||||
|
|
@ -255,6 +435,15 @@ 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
|
||||||
|
|
@ -299,9 +488,8 @@ 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> and I<groups>. Defaults to all
|
Set processing type to one of I<all>, I<groups> or I<hosts>. Defaults
|
||||||
(and is currently rather pointless as only I<groups> has been
|
to all.
|
||||||
implemented).
|
|
||||||
|
|
||||||
=item B<-c>, B<--checkgroups> I<filename template>
|
=item B<-c>, B<--checkgroups> I<filename template>
|
||||||
|
|
||||||
|
|
@ -417,7 +605,7 @@ Thomas Hochstein <thh@thh.name>
|
||||||
|
|
||||||
=head1 COPYRIGHT AND LICENSE
|
=head1 COPYRIGHT AND LICENSE
|
||||||
|
|
||||||
Copyright (c) 2010-2013 Thomas Hochstein <thh@thh.name>
|
Copyright (c) 2010-2013, 2025 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.
|
||||||
|
|
|
||||||
|
|
@ -51,10 +51,8 @@ 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
|
# $OptComments defaults to TRUE if --filetemplate is not used
|
||||||
$OptComments = 1 if (!defined($OptComments));
|
$OptComments = 1 if (!$OptFileTemplate && !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) {
|
||||||
|
|
@ -110,7 +108,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);
|
($SQLWhereNewsgroups,@SQLBindNewsgroups) = &SQLGroupList($OptNewsgroups,'newsgroup');
|
||||||
# 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;
|
||||||
|
|
@ -143,7 +141,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);
|
my ($GroupBy,$SQLOrderClause) = SQLSortOrder($OptGroupBy, $OptOrderBy, 'newsgroup');
|
||||||
# $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';
|
||||||
|
|
@ -226,6 +224,7 @@ $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)';
|
||||||
|
|
@ -235,9 +234,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';
|
||||||
}
|
}
|
||||||
printf("# ----- Report for %s %s\n",$CaptionPeriod,$CaptionReportType);
|
$LeadIn .= sprintf("# ----- Report for %s %s\n",$CaptionPeriod,$CaptionReportType);
|
||||||
# print newsgroup list if --newsgroups is set
|
# print newsgroup list if --newsgroups is set
|
||||||
printf("# ----- Newsgroups: %s\n",join(',',split(/:/,$OptNewsgroups)))
|
$LeadIn .= sprintf("# ----- 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)';
|
||||||
|
|
@ -246,12 +245,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';
|
||||||
}
|
}
|
||||||
printf("# ----- Threshold: %s %s x %s %s %s\n",
|
$LeadIn .= sprintf("# ----- 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
|
||||||
printf("# ----- Grouped by %s (%s), sorted %s%s\n",
|
$LeadIn .= sprintf("# ----- 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 ' : '',
|
||||||
|
|
@ -260,7 +259,7 @@ if ($OptCaptions && $OptComments) {
|
||||||
|
|
||||||
# output data
|
# output data
|
||||||
&OutputData($OptFormat,$OptComments,$GroupBy,$Precision,
|
&OutputData($OptFormat,$OptComments,$GroupBy,$Precision,
|
||||||
$OptCheckgroupsFile ? $ValidGroups : '',
|
$OptCheckgroupsFile ? $ValidGroups : '',$LeadIn,
|
||||||
$OptFileTemplate,$DBQuery,$MaxLength,$MaxValLength);
|
$OptFileTemplate,$DBQuery,$MaxLength,$MaxValLength);
|
||||||
|
|
||||||
### close handles
|
### close handles
|
||||||
|
|
@ -336,7 +335,6 @@ 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
|
||||||
|
|
||||||
|
|
@ -589,10 +587,11 @@ 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. This is enforced when using B<--filetemplate>, see below.
|
numbers of postings.
|
||||||
|
|
||||||
=item B<--filetemplate> I<filename template>
|
=item B<--filetemplate> I<filename template>
|
||||||
|
|
||||||
|
|
@ -606,8 +605,6 @@ 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
Normal file
354
bin/postingstats.pl
Normal file
|
|
@ -0,0 +1,354 @@
|
||||||
|
#!/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
Normal file
9
contrib/dopostingstats.sh
Normal file
|
|
@ -0,0 +1,9 @@
|
||||||
|
#!/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
Normal file
1506
contrib/tinews.pl
Normal file
File diff suppressed because it is too large
Load diff
11
contrib/yearstats.sh
Normal file
11
contrib/yearstats.sh
Normal file
|
|
@ -0,0 +1,11 @@
|
||||||
|
#!/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
|
||||||
|
|
||||||
|
|
@ -1,3 +1,28 @@
|
||||||
|
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
11
doc/INSTALL
|
|
@ -1,4 +1,4 @@
|
||||||
NewsStats (c) 2010-2013 Thomas Hochstein <thh@thh.name>
|
NewsStats (c) 2010-2013, 2025 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
|
||||||
<http://th-h.de/download/scripts.php>.
|
<https://th-h.de/net/software/newsstats/>.
|
||||||
|
|
||||||
* Untar it into a directory of your choice:
|
* Untar it into a directory of your choice:
|
||||||
|
|
||||||
|
|
@ -57,6 +57,9 @@ 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
|
||||||
|
|
@ -67,9 +70,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 installation script:
|
* Start the database creation script:
|
||||||
|
|
||||||
# install/install.pl
|
# bin/dbcreate.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
28
doc/README
|
|
@ -1,4 +1,4 @@
|
||||||
NewsStats (c) 2010-2013 Thomas Hochstein <thh@thh.name>
|
NewsStats (c) 2010-2013, 2025 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 <http://th-h.de/infos/usenet/stats.php>
|
threads, and so on (see <https://th-h.de/net/usenet/stats/>
|
||||||
[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 form CPAN
|
* Perl modules from CPAN
|
||||||
- Config::Auto
|
- Config::Auto
|
||||||
- Date::Format
|
- Date::Format
|
||||||
- DBI
|
- DBI
|
||||||
|
|
@ -54,21 +54,28 @@ 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 only the
|
You can process that data via 'gatherstats.pl'; currently the
|
||||||
tabulation of postings per group and month is supported. More to
|
tabulation of postings per group and injection server per month is
|
||||||
come. See the gatherstats.pl man page for more information.
|
supported. Tabulation of clients (newsreaders) is planned. See
|
||||||
|
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 only reports on the number of postings per
|
report type. Currently reports on the number of postings per group
|
||||||
group and month are supported; you can use 'groupstats.pl' for
|
and month and injection server and month are supported; you can
|
||||||
this. See the groupstats.pl man page for more information.
|
use 'groupstats.pl' and 'cliservstats.pl' for that. See the
|
||||||
|
groupstats.pl and cliservstats.pl man pages for more information.
|
||||||
|
|
||||||
Reporting Bugs
|
Reporting Bugs
|
||||||
|
|
||||||
|
|
@ -93,4 +100,3 @@ Author
|
||||||
|
|
||||||
Thomas Hochstein <thh@thh.name>
|
Thomas Hochstein <thh@thh.name>
|
||||||
<https://th-h.de/>
|
<https://th-h.de/>
|
||||||
|
|
||||||
|
|
|
||||||
5
doc/TODO
5
doc/TODO
|
|
@ -28,8 +28,7 @@ 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.
|
||||||
|
|
@ -65,7 +64,7 @@ NewsStats.
|
||||||
|
|
||||||
+ gatherstats.pl
|
+ gatherstats.pl
|
||||||
- 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, ...)
|
||||||
- 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
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
149
lib/NewsStats.pm
149
lib/NewsStats.pm
|
|
@ -2,7 +2,7 @@
|
||||||
#
|
#
|
||||||
# Library functions for the NewsStats package.
|
# Library functions for the NewsStats package.
|
||||||
#
|
#
|
||||||
# Copyright (c) 2010-2013 Thomas Hochstein <thh@thh.name>
|
# Copyright (c) 2010-2013, 2025 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,6 +34,7 @@ require Exporter;
|
||||||
ListNewsgroups
|
ListNewsgroups
|
||||||
ParseHierarchies
|
ParseHierarchies
|
||||||
ReadGroupList
|
ReadGroupList
|
||||||
|
ParseHeaders
|
||||||
OutputData
|
OutputData
|
||||||
FormatOutput
|
FormatOutput
|
||||||
SQLHierarchies
|
SQLHierarchies
|
||||||
|
|
@ -48,7 +49,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.2.0';
|
$VERSION = '0.3.0';
|
||||||
|
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
use File::Basename;
|
use File::Basename;
|
||||||
|
|
@ -76,7 +77,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 Thomas Hochstein <thh\@thh.name>\n";
|
print "Copyright (c) 2010-2013, 2025 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);
|
||||||
|
|
@ -254,6 +255,42 @@ 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 ----------------------------#####
|
||||||
|
|
@ -393,12 +430,13 @@ 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, $FileTempl,
|
my ($Format, $Comments, $GroupBy, $Precision, $ValidKeys, $LeadIn, $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);
|
||||||
|
|
@ -441,8 +479,8 @@ sub OutputData {
|
||||||
$FileName));
|
$FileName));
|
||||||
$Handle = $OUT;
|
$Handle = $OUT;
|
||||||
};
|
};
|
||||||
print $Handle &FormatOutput($Format, $Comments, $Caption, $Key, $Value,
|
print $Handle &FormatOutput($Format, $Comments, $LeadIn, $Caption,
|
||||||
$Precision, $PadField, $PadValue);
|
$Key, $Value, $Precision, $PadField, $PadValue);
|
||||||
$LastIteration = $Caption;
|
$LastIteration = $Caption;
|
||||||
};
|
};
|
||||||
close $OUT if ($FileTempl);
|
close $OUT if ($FileTempl);
|
||||||
|
|
@ -461,7 +499,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, $Caption, $Key, $Value, $Precision, $PadField,
|
my ($Format, $Comments, $LeadIn, $Caption, $Key, $Value, $Precision, $PadField,
|
||||||
$PadValue) = @_;
|
$PadValue) = @_;
|
||||||
my ($Output);
|
my ($Output);
|
||||||
# keep last caption in mind
|
# keep last caption in mind
|
||||||
|
|
@ -477,8 +515,10 @@ 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
|
||||||
$Output = sprintf ("# ----- %s:\n",$Caption)
|
if ($Comments and (!defined($LastIteration) or $Caption ne $LastIteration)) {
|
||||||
if ($Comments and (!defined($LastIteration) or $Caption ne $LastIteration));
|
$Output = $LeadIn;
|
||||||
|
$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
|
||||||
|
|
@ -542,21 +582,22 @@ 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) = @_;
|
my ($GroupBy,$OrderBy,$Type) = @_;
|
||||||
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 =~ /group/i) {
|
if ($GroupBy =~ /name/i) {
|
||||||
$GroupBy = 'newsgroup';
|
$GroupBy = $Type;
|
||||||
} else {
|
} else {
|
||||||
$GroupBy = 'month';
|
$GroupBy = 'month';
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
my $Secondary = ($GroupBy eq 'month') ? 'newsgroup' : 'month';
|
my $Secondary = ($GroupBy eq 'month') ? $Type : 'month';
|
||||||
# $OrderBy (secondary sorting)
|
# $OrderBy (secondary sorting)
|
||||||
if (!$OrderBy) {
|
if (!$OrderBy) {
|
||||||
$OrderBy = $Secondary;
|
$OrderBy = $Secondary;
|
||||||
|
|
@ -592,44 +633,45 @@ sub SQLParseOrder {
|
||||||
################################################################################
|
################################################################################
|
||||||
sub SQLGroupList {
|
sub SQLGroupList {
|
||||||
################################################################################
|
################################################################################
|
||||||
### explode list of newsgroups separated by : (with wildcards)
|
### explode list of names separated by : (with wildcards)
|
||||||
### to a SQL 'WHERE' expression
|
### to a SQL 'WHERE' expression
|
||||||
### IN : $Newsgroups: list of newsgroups (group.one.*:group.two:group.three.*)
|
### IN : $Names: list of names, e.g. 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 newsgroups for SQL bindings
|
### list of names for SQL bindings
|
||||||
my ($Newsgroups) = @_;
|
my ($Names,$Type) = @_;
|
||||||
# substitute '*' wildcard with SQL wildcard character '%'
|
# substitute '*' wildcard with SQL wildcard character '%'
|
||||||
$Newsgroups =~ s/\*/%/g;
|
$Names =~ s/\*/%/g;
|
||||||
return (undef,undef) if !CheckValidNewsgroups($Newsgroups);
|
return (undef,undef) if !CheckValidNames($Names);
|
||||||
# just one newsgroup?
|
# just one name/newsgroup?
|
||||||
return (SQLGroupWildcard($Newsgroups),$Newsgroups) if $Newsgroups !~ /:/;
|
return (SQLGroupWildcard($Names,$Type),$Names) if $Names !~ /:/;
|
||||||
my ($SQL,@WildcardGroups,@NoWildcardGroups);
|
my ($SQL,@WildcardNames,@NoWildcardNames);
|
||||||
# list of newsgroups separated by ':'
|
# list of names/newsgroups separated by ':'
|
||||||
my @GroupList = split /:/, $Newsgroups;
|
my @NameList = split /:/, $Names;
|
||||||
foreach (@GroupList) {
|
foreach (@NameList) {
|
||||||
if ($_ !~ /%/) {
|
if ($_ !~ /%/) {
|
||||||
# add to list of newsgroup names WITHOUT wildcard
|
# add to list of names/newsgroup names WITHOUT wildcard
|
||||||
push (@NoWildcardGroups,$_);
|
push (@NoWildcardNames,$_);
|
||||||
} else {
|
} else {
|
||||||
# add to list of newsgroup names WITH wildcard
|
# add to list of names WITH wildcard
|
||||||
push (@WildcardGroups,$_);
|
push (@WildcardNames,$_);
|
||||||
# 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 .= 'newsgroup LIKE ?'
|
$SQL .= "$Type LIKE ?"
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
if (scalar(@NoWildcardGroups)) {
|
if (scalar(@NoWildcardNames)) {
|
||||||
# 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(@NoWildcardGroups) < 2) {
|
if (scalar(@NoWildcardNames) < 2) {
|
||||||
# special case: just one newsgroup without wildcard
|
# special case: just one name without wildcard
|
||||||
$SQL .= 'newsgroup = ?';
|
$SQL .= "$Type = ?";
|
||||||
} else {
|
} else {
|
||||||
# create list of newsgroups to include: 'newsgroup IN (...)'
|
# create list of names to include: e.g. 'newsgroup IN (...)'
|
||||||
$SQL .= 'newsgroup IN (';
|
$SQL .= "$Type IN (";
|
||||||
my $SQLin;
|
my $SQLin;
|
||||||
foreach (@NoWildcardGroups) {
|
foreach (@NoWildcardNames) {
|
||||||
$SQLin .= ',' if $SQLin;
|
$SQLin .= ',' if $SQLin;
|
||||||
$SQLin .= '?';
|
$SQLin .= '?';
|
||||||
}
|
}
|
||||||
|
|
@ -637,27 +679,28 @@ sub SQLGroupList {
|
||||||
$SQL .= $SQLin .= ')';
|
$SQL .= $SQLin .= ')';
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
# add brackets '()' to SQL clause as needed (more than one wildcard group)
|
# add brackets '()' to SQL clause as needed (more than one wildcard name)
|
||||||
if (scalar(@WildcardGroups)) {
|
if (scalar(@WildcardNames)) {
|
||||||
$SQL = '(' . $SQL .')';
|
$SQL = '(' . $SQL .')';
|
||||||
}
|
}
|
||||||
# rebuild @GroupList in (now) correct order
|
# rebuild @NameList in (now) correct order
|
||||||
@GroupList = (@WildcardGroups,@NoWildcardGroups);
|
@NameList = (@WildcardNames,@NoWildcardNames);
|
||||||
return ($SQL,@GroupList);
|
return ($SQL,@NameList);
|
||||||
};
|
};
|
||||||
|
|
||||||
################################################################################
|
################################################################################
|
||||||
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 : $Newsgroup: newsgroup expression, probably with wildcard
|
### IN : $Name: 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 ($Newsgroup) = @_;
|
my ($Name,$Type) = @_;
|
||||||
if ($Newsgroup !~ /%/) {
|
if ($Name !~ /%/) {
|
||||||
return 'newsgroup = ?';
|
return "$Type = ?";
|
||||||
} else {
|
} else {
|
||||||
return 'newsgroup LIKE ?';
|
return "$Type LIKE ?";
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
@ -759,14 +802,14 @@ sub SQLBuildClause {
|
||||||
#####--------------------------- Verifications ----------------------------#####
|
#####--------------------------- Verifications ----------------------------#####
|
||||||
|
|
||||||
################################################################################
|
################################################################################
|
||||||
sub CheckValidNewsgroups {
|
sub CheckValidNames {
|
||||||
################################################################################
|
################################################################################
|
||||||
### syntax check of newgroup list
|
### syntax check of a list
|
||||||
### IN : $Newsgroups: list of newsgroups (group.one.*:group.two:group.three.*)
|
### IN : $Names: list of names, e.g. newsgroups (group.one.*:group.two:group.three.*)
|
||||||
### OUT: boolean
|
### OUT: boolean
|
||||||
my ($Newsgroups) = @_;
|
my ($Names) = @_;
|
||||||
my $InvalidCharRegExp = ',; ';
|
my $InvalidCharRegExp = ',; ';
|
||||||
return ($Newsgroups =~ /[$InvalidCharRegExp]/) ? 0 : 1;
|
return ($Names =~ /[$InvalidCharRegExp]/) ? 0 : 1;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue