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 -h and -V
62 ### IN : $Params: list of legal 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;
120 warn "$MySelf W: Empty configuration hash passed to OverrideConfig().\n" if ( keys %$ConfigR < 1);
121 # return if no overrides
122 return if (keys %Override < 1 or keys %$ConfigR < 1);
123 foreach my $Key (keys %Override) {
124 $$ConfigR{$Key} = $Override{$Key};
127 ################################################################################
129 ################################################################################
131 ################################################################################
132 ### initialise database connection
133 ### IN : $ConfigR: reference to configuration hash
134 ### $Die : if TRUE, die if connection fails
136 my ($ConfigR,$Die) = @_;
137 my %Conf = %$ConfigR;
138 my $DBHandle = DBI->connect(sprintf('DBI:%s:database=%s;host=%s',$Conf{'DBDriver'},$Conf{'DBDatabase'},$Conf{'DBHost'}), $Conf{'DBUser'}, $Conf{'DBPw'}, { PrintError => 0 });
140 die ("$MySelf: E: $DBI::errstr\n") if (defined($Die) and $Die);
141 warn("$MySelf: W: $DBI::errstr\n");
145 ################################################################################
147 #####------------------------------ GetStats ------------------------------#####
149 ################################################################################
151 ################################################################################
152 ### explode a (scalar) list of newsgroup names to a list of newsgroup and
153 ### hierarchy names where every newsgroup and hierarchy appears only once:
154 ### de.alt.test,de.alt.admin -> de.ALL, de.alt.ALL, de.alt.test, de.alt.admin
155 ### IN : $Newsgroups: a list of newsgroups (content of Newsgroups: header)
156 ### OUT: %Newsgroups: hash containing all newsgroup and hierarchy names as keys
157 my ($Newsgroups) = @_;
160 # remove whitespace from contents of Newsgroups:
161 $Newsgroups =~ s/\s//;
162 # call &HierarchyCount for each newsgroup in $Newsgroups:
163 for (split /,/, $Newsgroups) {
164 # add original newsgroup to %Newsgroups
166 # add all hierarchy elements to %Newsgroups, amended by '.ALL',
167 # i.e. de.alt.ALL and de.ALL
168 foreach (ParseHierarchies($_)) {
169 $Newsgroups{$_.'.ALL'} = 1;
175 ################################################################################
176 sub ParseHierarchies {
177 ################################################################################
178 ### return a list of all hierarchy levels a newsgroup belongs to
179 ### (for de.alt.test.moderated that would be de/de.alt/de.alt.test)
180 ### IN : $Newsgroup : a newsgroup name
181 ### OUT: @Hierarchies: array containing all hierarchies the newsgroup belongs to
182 my ($Newsgroup) = @_;
184 # strip trailing dots
185 $Newsgroup =~ s/(.+)\.+$/$1/;
186 # butcher newsgroup name by "." and add each hierarchy to @Hierarchies
187 # i.e. de.alt.test: "de.alt" and "de"
188 while ($Newsgroup =~ /\./) {
189 $Newsgroup =~ s/^((?:\.?[^.]+)*)\.[^.]+$/$1/;
190 push @Hierarchies, $Newsgroup;
195 ################################################################################
197 #####----------------------------- TimePeriods ----------------------------#####
199 ################################################################################
201 ################################################################################
202 ### get a time period to act on, in order of preference: by default the
203 ### last month; or a month submitted by -m YYYY-MM; or a time period submitted
204 ### by -p YYYY-MM:YYYY-MM
205 ### IN : $Month,$Period: contents of -m and -p
206 ### OUT: $StartMonth, $EndMonth (identical if period is just one month)
207 my ($Month,$Period) = @_;
208 # exit if -m is set and not like YYYY-MM
209 die "$MySelf: E: Wrong date format - use '$MySelf -m YYYY-MM'!\n" if not &CheckMonth($Month);
210 # warn if -m and -p is set
211 warn "$MySelf: W: Time period assigned by '-p' takes precendece over month assigned by '-m'.\n" if ($Month && $Period);
212 # default: set -m to last month
213 $Month = &LastMonth if (!defined($Month) and !defined($Period));
214 # set $StartMonth, $EndMonth
215 my ($StartMonth, $EndMonth);
218 ($StartMonth, $EndMonth) = &SplitPeriod($Period);
219 die "$MySelf: E: Wrong format for time period - use '$MySelf -p YYYY-MM:YYYY-MM'!\n" if !defined($StartMonth);
221 # set $StartMonth = $EndMonth = $Month if -p is not set
222 $StartMonth = $EndMonth = $Month;
224 return ($StartMonth, $EndMonth);
227 ################################################################################
229 ################################################################################
230 ### get last month from todays date in YYYY-MM format
231 ### OUT: last month as YYYY-MM
233 my (undef,undef,undef,undef,$Month,$Year,undef,undef,undef) = localtime(time);
234 # $Month is already defined from 0 to 11, so no need to decrease it by 1
241 return sprintf('%4d-%02d',$Year,$Month);
244 ################################################################################
246 ################################################################################
247 ### check if input is a valid month in YYYY-MM form
248 ### IN : $Month: month
249 ### OUT: TRUE / FALSE
251 return 0 if (defined($Month) and $Month !~ /^\d{4}-\d{2}$/);
255 ################################################################################
257 ################################################################################
258 ### split a time period denoted by YYYY-MM:YYYY-MM into start and end month
259 ### IN : $Period: time period
260 ### OUT: $StartMonth, Â$EndMonth
262 return (undef,undef) if $Period !~ /^\d{4}-\d{2}:\d{4}-\d{2}$/;
263 my ($StartMonth, $EndMonth) = split /:/, $Period;
264 # switch parameters as necessary
265 if ($EndMonth gt $StartMonth) {
266 return ($StartMonth, $EndMonth);
268 return ($EndMonth, $StartMonth);
272 ################################################################################
274 ################################################################################
275 ### return a list of months (YYYY-MM) between start and end month
276 ### IN : $StartMonth, $EndMonth
277 ### OUT: @Months: array containing all months from $StartMonth to $EndMonth
278 my ($StartMonth, $EndMonth) = @_;
279 return (undef,undef) if ($StartMonth !~ /^\d{4}-\d{2}$/ or $EndMonth !~ /^\d{4}-\d{2}$/);
280 # return if $StartMonth = $EndMonth
281 return ($StartMonth) if ($StartMonth eq $EndMonth);
282 # set $Year, $Month from $StartMonth
283 my ($Year, $Month) = split /-/, $StartMonth;
286 until ("$Year-$Month" gt $EndMonth) {
287 push @Months, "$Year-$Month";
288 $Month = "$Month"; # force string context
298 #####---------------------------- OutputFormats ---------------------------#####
300 ################################################################################
302 ################################################################################
303 ### read database query results from DBHandle and print results with formatting
304 ### IN : $Format : format specifier
305 ### $DBQuery: database query handle with executed query,
306 ### containing $Month, $Key, $Value
307 ### $PadGroup: padding length for newsgroups field (optional) for 'pretty'
308 my ($Format, $DBQuery,$PadGroup) = @_;
309 while (my ($Month, $Key, $Value) = $DBQuery->fetchrow_array) {
310 print &FormatOutput($Format, $Month, $Key, $Value, $PadGroup);
314 ################################################################################
316 ################################################################################
317 ### format information for output according to format specifier
318 ### IN : $Format : format specifier
319 ### $Month : month (as YYYY-MM)
320 ### $Key : newsgroup, client, ...
321 ### $Value : number of postings with that attribute
322 ### $PadGroup: padding length for key field (optional) for 'pretty'
323 ### OUT: $Output: formatted output
324 my ($Format, $Month, $Key, $Value, $PadGroup) = @_;
326 # define output types
328 @LegalOutput{('dump','dumpgroup','list','pretty')} = ();
329 # bail out if format is unknown
330 die "$MySelf: E: Unknown output type '$Format'!\n" if !exists($LegalOutput{$Format});
333 # keep last month in mind
334 our ($LastIteration);
335 if ($Format eq 'dump') {
336 # output as dump (ng nnnnn)
337 $Output = sprintf ("%s %u\n",$Key,$Value);
338 } elsif ($Format eq 'dumpgroup') {
339 # output as dump (YYYY-NN: nnnnn)
340 $Output = sprintf ("%s: %5u\n",$Month,$Value);
341 } elsif ($Format eq 'list') {
342 # output as list (YYYY-NN: ng nnnnn)
343 $Output = sprintf ("%s: %s %u\n",$Month,$Key,$Value);
344 } elsif ($Format eq 'pretty') {
346 $Output = sprintf ("----- %s:\n",$Month) if (!defined($LastIteration) or $Month ne $LastIteration);
347 $LastIteration = $Month;
348 $Output .= sprintf ($PadGroup ? sprintf("%%-%us %%5u\n",$PadGroup) : "%s %u\n",$Key,$Value);
353 #####------------------------- QueryModifications -------------------------#####
355 ################################################################################
357 ################################################################################
358 ### add exclusion of hierarchy levels (de.alt.ALL) from SQL query by
359 ### amending the WHERE clause if $ShowHierarchies is false (or don't, if it is
360 ### true, accordingly)
361 ### IN : $ShowHierarchies: boolean value
363 my ($ShowHierarchies) = @_;
364 return $ShowHierarchies ? '' : "AND newsgroup NOT LIKE '%.ALL'";
367 ################################################################################
369 ################################################################################
370 ### get length of longest field in future query result
371 ### IN : $DBHandle : database handel
372 ### $Table : table to query
373 ### $Field : field to check
374 ### $WhereClause: WHERE clause
375 ### @BindVars : bind variables for WHERE clause
376 ### OUT: $Length: length of longest instnace of $Field
377 my ($DBHandle,$Table,$Field,$WhereClause,@BindVars) = @_;
378 my $DBQuery = $DBHandle->prepare(sprintf("SELECT MAX(LENGTH(%s)) FROM %s WHERE %s",$Field,$Table,$WhereClause));
379 $DBQuery->execute(@BindVars) or warn sprintf("$MySelf: W: Can't get field length for %s from table %s: $DBI::errstr\n",$Field,$Table);
380 my ($Length) = $DBQuery->fetchrow_array;
384 ################################################################################
386 ################################################################################
387 ### explode list of newsgroups separated by : (with wildcards) to a SQL WHERE
389 ### IN : $Newsgroups: list of newsgroups (group.one.*:group.two:group.three.*)
390 ### OUT: SQL code, list of newsgroups
391 my ($Newsgroups) = @_;
392 $Newsgroups =~ s/\*/%/g;
393 return ('newsgroup LIKE ?', $Newsgroups) if $Newsgroups !~ /:/;
395 my @GroupList = split /:/, $Newsgroups;
396 foreach (@GroupList) {
397 $SQL .= ' OR ' if $SQL gt '(';
398 $SQL .= 'newsgroup LIKE ?';
401 return ($SQL,@GroupList);
404 #####------------------------------- done ---------------------------------#####