3 # Library functions for the NewsStats package.
5 # Copyright (c) 2010 Thomas Hochstein <thh@inter.net>
7 # This module can be redistributed and/or modified under the same terms under
8 # which Perl itself is published.
14 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
39 %EXPORT_TAGS = ( TimePeriods => [qw(GetTimePeriod LastMonth CheckMonth SplitPeriod ListMonth)],
40 Output => [qw(OutputData FormatOutput)],
41 SQLHelper => [qw(SQLHierarchies SQLGroupList GetMaxLenght)]);
51 #####-------------------------------- Vars --------------------------------#####
53 our $MySelf = fileparse($0, '.pl');
54 our $MyVersion = "$MySelf $::VERSION (NewsStats.pm $VERSION)";
56 #####------------------------------- Basics -------------------------------#####
58 ################################################################################
60 ################################################################################
61 ### read commandline options and act on standard options
62 ### IN : $Params: containing list of commandline paramaters (without -h and -V)
63 ### OUT: a hash containing the commandline options
64 $Getopt::Std::STANDARD_HELP_VERSION = 1;
69 getopts('Vh'.$Params, \%Options);
72 &ShowVersion if ($Options{'V'});
74 # -h: feed myself to perldoc
75 &ShowPOD if ($Options{'h'});
79 ################################################################################
81 ################################################################################
83 ################################################################################
84 ### display version and exit
85 print "$MyVersion\nCopyright (c) 2010 Thomas Hochstein <thh\@inter.net>\n";
86 print "This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.\n";
89 ################################################################################
91 ################################################################################
93 ################################################################################
94 ### feed myself to perldoc and exit
98 ################################################################################
100 ################################################################################
102 ################################################################################
103 ### read config via Config::Auto
104 ### IN : $ConfFile: config filename
105 ### OUT: reference to a hash containing the configuration
107 return Config::Auto::parse($ConfFile, format => 'equal');
109 ################################################################################
111 ################################################################################
113 ################################################################################
114 ### override configuration values
115 ### IN : $ConfigR : reference to configuration hash
116 ### $OverrideR: reference to a hash containing overrides
117 my ($ConfigR,$OverrideR) = @_;
118 my %Override = %$OverrideR;
119 warn "$MySelf W: Empty configuration hash passed to OverrideConfig().\n" if ( keys %$ConfigR < 1);
120 return if (keys %Override < 1 or keys %$ConfigR < 1);
121 foreach my $Key (keys %Override) {
122 $$ConfigR{$Key} = $Override{$Key};
125 ################################################################################
127 ################################################################################
129 ################################################################################
130 ### initialise database connection
131 ### IN : $ConfigR: reference to configuration hash
132 ### $Die : if TRUE, die if connection failed
134 my ($ConfigR,$Die) = @_;
135 my %Conf = %$ConfigR;
136 my $DBHandle = DBI->connect(sprintf('DBI:%s:database=%s;host=%s',$Conf{'DBDriver'},$Conf{'DBDatabase'},$Conf{'DBHost'}), $Conf{'DBUser'}, $Conf{'DBPw'}, { PrintError => 0 });
138 die ("$MySelf: E: $DBI::errstr\n") if (defined($Die) and $Die);
139 warn("$MySelf: W: $DBI::errstr\n");
143 ################################################################################
145 #####------------------------------ GetStats ------------------------------#####
147 ################################################################################
149 ################################################################################
150 ### count each newsgroup and each hierarchy level, but only once
151 ### IN : $Newsgroups: a list of newsgroups (content of Newsgroups:)
152 ### OUT: %Newsgroups: hash containing all newsgroup and hierarchy names as keys
153 my ($Newsgroups) = @_;
156 # remove whitespace from contents of Newsgroups:
157 $Newsgroups =~ s/\s//;
158 # call &HierarchyCount for each newsgroup in $Newsgroups:
159 for (split /,/, $Newsgroups) {
160 # add original newsgroup to %Newsgroups
162 # add all hierarchy elements to %Newsgroups, amended by '.ALL',
163 # i.e. de.alt.ALL and de.ALL
164 foreach (ParseHierarchies($_)) {
165 $Newsgroups{$_.'.ALL'} = 1;
171 ################################################################################
172 sub ParseHierarchies {
173 ################################################################################
174 ### get all hierarchies a newsgroup belongs to
175 ### IN : $Newsgroup : a newsgroup name
176 ### OUT: @Hierarchies: array containing all hierarchies the newsgroup belongs to
177 my ($Newsgroup) = @_;
179 # strip trailing dots
180 $Newsgroup =~ s/(.+)\.+$/$1/;
181 # butcher newsgroup name by "." and add each hierarchy to @Hierarchies
182 # i.e. de.alt.test: "de.alt" and "de"
183 while ($Newsgroup =~ /\./) {
184 $Newsgroup =~ s/^((?:\.?[^.]+)*)\.[^.]+$/$1/;
185 push @Hierarchies, $Newsgroup;
190 ################################################################################
192 #####----------------------------- TimePeriods ----------------------------#####
194 ################################################################################
196 ################################################################################
197 ### get time period using -m / -p
198 ### IN : $Month,$Period: contents of -m and -p
199 ### OUT: $StartMonth, $EndMonth
200 my ($Month,$Period) = @_;
201 # exit if -m is set and not like YYYY-MM
202 die "$MySelf: E: Wrong date format - use '$MySelf -m YYYY-MM'!\n" if not &CheckMonth($Month);
203 # warn if -m and -p is set
204 warn "$MySelf: W: Time period assigned by '-p' takes precendece over month assigned by '-m'.\n" if ($Month && $Period);
205 # default: set -m to last month
206 $Month = &LastMonth if (!defined($Month) and !defined($Period));
207 # set $StartMonth, $EndMonth
208 my ($StartMonth, $EndMonth);
211 ($StartMonth, $EndMonth) = &SplitPeriod($Period);
212 die "$MySelf: E: Wrong format for time period - use '$MySelf -p YYYY-MM:YYYY-MM'!\n" if !defined($StartMonth);
214 # set $StartMonth = $EndMonth = $Month if -p is not set
215 $StartMonth = $EndMonth = $Month;
217 return ($StartMonth, $EndMonth);
220 ################################################################################
222 ################################################################################
223 ### get last month from today in YYYY-MM format
224 ### OUT: last month as YYYY-MM
226 my (undef,undef,undef,undef,$Month,$Year,undef,undef,undef) = localtime(time);
227 # $Month is already defined from 0 to 11, so no need to decrease it by 1
234 return sprintf('%4d-%02d',$Year,$Month);
237 ################################################################################
239 ################################################################################
240 ### check for valid month
241 ### IN : $Month: month
242 ### OUT: TRUE / FALSE
244 return 0 if (defined($Month) and $Month !~ /^\d{4}-\d{2}$/);
248 ################################################################################
250 ################################################################################
251 ### split a time period YYYY-MM:YYYY-MM into start and end month
252 ### IN : $Period: time period
253 ### OUT: $StartMonth, Â$EndMonth
255 return (undef,undef) if $Period !~ /^\d{4}-\d{2}:\d{4}-\d{2}$/;
256 my ($StartMonth, $EndMonth) = split /:/, $Period;
257 # switch parameters as necessary
258 if ($EndMonth gt $StartMonth) {
259 return ($StartMonth, $EndMonth);
261 return ($EndMonth, $StartMonth);
265 ################################################################################
267 ################################################################################
268 ### return a list of month (YYYY-MM) between start and end month
269 ### IN : $StartMonth, $EndMonth
270 ### OUT: @Months: array containing all months from $StartMonth to $EndMonth
271 my ($StartMonth, $EndMonth) = @_;
272 return (undef,undef) if ($StartMonth !~ /^\d{4}-\d{2}$/ or $EndMonth !~ /^\d{4}-\d{2}$/);
273 # return if $StartMonth = $EndMonth
274 return ($StartMonth) if ($StartMonth eq $EndMonth);
275 # set $Year, $Month from $StartMonth
276 my ($Year, $Month) = split /-/, $StartMonth;
279 until ("$Year-$Month" gt $EndMonth) {
280 push @Months, "$Year-$Month";
281 $Month = "$Month"; # force string context
291 #####---------------------------- OutputFormats ---------------------------#####
293 ################################################################################
295 ################################################################################
296 ### output information with formatting from DBHandle
297 ### IN : $Format : format specifier
298 ### $DBQuery: database query handle with executed query,
299 ### containing $Month, $Key, $Value
300 ### $PadGroup: padding length for newsgroups field (optional) for 'pretty'
301 ### OUT: $Output: formatted output
302 my ($Format, $DBQuery,$PadGroup) = @_;
303 while (my ($Month, $Key, $Value) = $DBQuery->fetchrow_array) {
304 print &FormatOutput($Format, $Month, $Key, $Value, $PadGroup);
308 ################################################################################
310 ################################################################################
311 ### format information for output
312 ### IN : $Format : format specifier
313 ### $PadGroup: padding length for newsgroups field (optional) for 'pretty'
314 ### $Month : month (as YYYY-MM)
315 ### $Key : newsgroup, client, ...
316 ### $Value : number of postings with that attribute
317 ### OUT: $Output: formatted output
318 my ($Format, $Month, $Key, $Value, $PadGroup) = @_;
320 # define output types
322 @LegalOutput{('dump','dumpgroup','list','pretty')} = ();
323 # bail out if format is unknown
324 die "$MySelf: E: Unknown output type '$Format'!\n" if !exists($LegalOutput{$Format});
327 our ($LastIteration);
328 if ($Format eq 'dump') {
329 # output as dump (ng nnnnn)
330 $Output = sprintf ("%s %u\n",$Key,$Value);
331 } elsif ($Format eq 'dumpgroup') {
332 # output as dump (YYYY-NN: nnnnn)
333 $Output = sprintf ("%s: %5u\n",$Month,$Value);
334 } elsif ($Format eq 'list') {
335 # output as list (YYYY-NN: ng nnnnn)
336 $Output = sprintf ("%s: %s %u\n",$Month,$Key,$Value);
337 } elsif ($Format eq 'pretty') {
339 $Output = sprintf ("----- %s:\n",$Month) if (!defined($LastIteration) or $Month ne $LastIteration);
340 $LastIteration = $Month;
341 $Output .= sprintf ($PadGroup ? sprintf("%%-%us %%5u\n",$PadGroup) : "%s %u\n",$Key,$Value);
346 #####------------------------- QueryModifications -------------------------#####
348 ################################################################################
350 ################################################################################
351 ### amend WHERE clause to include hierarchies
352 ### IN : $ShowHierarchies: boolean value
354 my ($ShowHierarchies) = @_;
355 return $ShowHierarchies ? '' : "AND newsgroup NOT LIKE '%.ALL'";
358 ################################################################################
360 ################################################################################
361 ### get length of longest field in query
362 ### IN : $DBHandle : database handel
363 ### $Table : table to query
364 ### $Field : field to check
365 ### $WhereClause: WHERE clause
366 ### @BindVars : bind variables for WHERE clause
367 ### OUT: $Length: length of longest instnace of $Field
368 my ($DBHandle,$Table,$Field,$WhereClause,@BindVars) = @_;
369 my $DBQuery = $DBHandle->prepare(sprintf("SELECT MAX(LENGTH(%s)) FROM %s WHERE %s",$Field,$Table,$WhereClause));
370 $DBQuery->execute(@BindVars) or warn sprintf("$MySelf: W: Can't get field length for %s from table %s: $DBI::errstr\n",$Field,$Table);
371 my ($Length) = $DBQuery->fetchrow_array;
375 ################################################################################
377 ################################################################################
378 ### create part of WHERE clause for list of newsgroups separated by :
379 ### IN : $Newsgroups: list of newsgroups (group.one.*:group.two:group.three.*)
380 ### OUT: SQL code, list of newsgroups
381 my ($Newsgroups) = @_;
382 $Newsgroups =~ s/\*/%/g;
383 return ('newsgroup LIKE ?', $Newsgroups) if $Newsgroups !~ /:/;
385 my @GroupList = split /:/, $Newsgroups;
386 foreach (@GroupList) {
387 $SQL .= ' OR ' if $SQL gt '(';
388 $SQL .= 'newsgroup LIKE ?';
391 return ($SQL,@GroupList);
394 #####------------------------------- done ---------------------------------#####