NewsStats.pm: Warn when -p takes precedence over -m.
[usenet/newsstats.git] / NewsStats.pm
1 # NewsStats.pm
2 #
3 # Library functions for the NewsStats package.
4 #
5 # Copyright (c) 2010 Thomas Hochstein <thh@inter.net>
6 #
7 # This module can be redistributed and/or modified under the same terms under 
8 # which Perl itself is published.
9
10 package NewsStats;
11
12 use strict;
13 use warnings;
14 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
15
16 require Exporter;
17 @ISA = qw(Exporter);
18 @EXPORT = qw(
19   $MySelf
20   $MyVersion
21   ReadOptions
22   ReadConfig
23   OverrideConfig
24   InitDB
25 );
26 @EXPORT_OK = qw(
27   GetTimePeriod
28   LastMonth
29   CheckMonth
30   SplitPeriod
31   ListMonth
32   ListNewsgroups
33   OutputData
34   FormatOutput
35   SQLHierarchies
36   SQLGroupList
37   GetMaxLenght
38 );
39 %EXPORT_TAGS = ( TimePeriods => [qw(GetTimePeriod LastMonth CheckMonth SplitPeriod ListMonth)],
40                  Output      => [qw(OutputData FormatOutput)],
41                  SQLHelper   => [qw(SQLHierarchies SQLGroupList GetMaxLenght)]);
42 $VERSION = '0.1';
43
44 use Data::Dumper;
45 use File::Basename;
46 use Getopt::Std;
47
48 use Config::Auto;
49 use DBI;
50
51 #####-------------------------------- Vars --------------------------------#####
52
53 our $MySelf = fileparse($0, '.pl');
54 our $MyVersion = "$MySelf $::VERSION (NewsStats.pm $VERSION)";
55
56 #####------------------------------- Basics -------------------------------#####
57
58 ################################################################################
59 sub ReadOptions {
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;
65
66   my ($Params) = @_;
67   my %Options;
68   
69   getopts('Vh'.$Params, \%Options);
70
71   # -V: display version
72   &ShowVersion if ($Options{'V'});
73
74   # -h: feed myself to perldoc
75   &ShowPOD if ($Options{'h'});
76
77   return %Options;
78 };
79 ################################################################################
80
81 ################################################################################
82 sub ShowVersion {
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";
87   exit(100);
88 };
89 ################################################################################
90
91 ################################################################################
92 sub ShowPOD {
93 ################################################################################
94 ### feed myself to perldoc and exit
95   exec('perldoc', $0);
96   exit(100);
97 };
98 ################################################################################
99
100 ################################################################################
101 sub ReadConfig {
102 ################################################################################
103 ### read config via Config::Auto
104 ### IN : $ConfFile: config filename
105 ### OUT: reference to a hash containing the configuration
106   my ($ConfFile) = @_;
107   return Config::Auto::parse($ConfFile, format => 'equal');
108 };
109 ################################################################################
110
111 ################################################################################
112 sub OverrideConfig  {
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};
123   };
124 };
125 ################################################################################
126
127 ################################################################################
128 sub InitDB {
129 ################################################################################
130 ### initialise database connection
131 ### IN : $ConfigR: reference to configuration hash
132 ###      $Die    : if TRUE, die if connection failed
133 ### OUT: DBHandle
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 });
137   if (!$DBHandle) {
138     die ("$MySelf: E: $DBI::errstr\n") if (defined($Die) and $Die);
139     warn("$MySelf: W: $DBI::errstr\n");
140   };
141   return $DBHandle;
142 };
143 ################################################################################
144
145 #####------------------------------ GetStats ------------------------------#####
146
147 ################################################################################
148 sub ListNewsgroups {
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) = @_;
154   my %Newsgroups;
155   chomp($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
161     $Newsgroups{$_} = 1;
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;
166     }
167   };
168   return %Newsgroups;
169 };
170
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) = @_;
178   my @Hierarchies;
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;
186   };
187   return @Hierarchies;
188 };
189
190 ################################################################################
191
192 #####----------------------------- TimePeriods ----------------------------#####
193
194 ################################################################################
195 sub GetTimePeriod {
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);
209   if ($Period) {
210     # -p: get date range
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);
213   } else {
214     # set $StartMonth = $EndMonth = $Month if -p is not set
215     $StartMonth = $EndMonth = $Month;
216   };
217   return ($StartMonth, $EndMonth);
218 };
219
220 ################################################################################
221 sub LastMonth {
222 ################################################################################
223 ### get last month from today in YYYY-MM format
224 ### OUT: last month as YYYY-MM
225   # get today's date
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
228   $Year += 1900;
229   if ($Month < 1) {
230     $Month = 12;
231     $Year--;
232   };
233   # return last month
234   return sprintf('%4d-%02d',$Year,$Month);
235 };
236
237 ################################################################################
238 sub CheckMonth {
239 ################################################################################
240 ### check for valid month
241 ### IN : $Month: month
242 ### OUT: TRUE / FALSE
243   my ($Month) = @_;
244   return 0 if (defined($Month) and $Month !~ /^\d{4}-\d{2}$/);
245   return 1;
246 };
247
248 ################################################################################
249 sub SplitPeriod {
250 ################################################################################
251 ### split a time period YYYY-MM:YYYY-MM into start and end month
252 ### IN : $Period: time period
253 ### OUT: $StartMonth, Â$EndMonth
254   my ($Period) = @_;
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);
260   } else {
261     return ($EndMonth, $StartMonth);
262   };
263 };
264
265 ################################################################################
266 sub ListMonth {
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;
277   # define @Months
278   my (@Months);
279   until ("$Year-$Month" gt $EndMonth) {
280     push @Months, "$Year-$Month";
281     $Month = "$Month"; # force string context
282     $Month++;
283     if ($Month > 12) {
284       $Month = '01';
285       $Year++;
286     };
287   };
288   return @Months;
289 };
290
291 #####---------------------------- OutputFormats ---------------------------#####
292
293 ################################################################################
294 sub OutputData {
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);
305   };
306 };
307
308 ################################################################################
309 sub FormatOutput {
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) = @_;
319
320   # define output types
321   my %LegalOutput;
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});
325
326   my ($Output);
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') {
338     # output as table
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);
342   };
343   return $Output;
344 };
345
346 #####------------------------- QueryModifications -------------------------#####
347
348 ################################################################################
349 sub SQLHierarchies {
350 ################################################################################
351 ### amend WHERE clause to include hierarchies
352 ### IN : $ShowHierarchies: boolean value
353 ### OUT: SQL code
354   my ($ShowHierarchies) = @_;
355   return $ShowHierarchies ? '' : "AND newsgroup NOT LIKE '%.ALL'";
356 };
357
358 ################################################################################
359 sub GetMaxLenght {
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;
372   return $Length;
373 };
374
375 ################################################################################
376 sub SQLGroupList {
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 !~ /:/;
384   my $SQL = '(';
385   my @GroupList = split /:/, $Newsgroups;
386   foreach (@GroupList) {
387      $SQL .= ' OR ' if $SQL gt '(';
388      $SQL .= 'newsgroup LIKE ?';
389   };
390   $SQL .= ')';
391   return ($SQL,@GroupList);
392 };
393
394 #####------------------------------- done ---------------------------------#####
395 1;
396
397
This page took 0.020571 seconds and 3 git commands to generate.