Initial checkin of working branch.
[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   # default: set -m to last month
204   $Month = &LastMonth if (!defined($Month) and !defined($Period));
205   # set $StartMonth, $EndMonth
206   my ($StartMonth, $EndMonth);
207   if ($Period) {
208     # -p: get date range
209     ($StartMonth, $EndMonth) = &SplitPeriod($Period);
210     die "$MySelf: E: Wrong format for time period - use '$MySelf -p YYYY-MM:YYYY-MM'!\n" if !defined($StartMonth);
211   } else {
212     # set $StartMonth = $EndMonth = $Month if -p is not set
213     $StartMonth = $EndMonth = $Month;
214   };
215   return ($StartMonth, $EndMonth);
216 };
217
218 ################################################################################
219 sub LastMonth {
220 ################################################################################
221 ### get last month from today in YYYY-MM format
222 ### OUT: last month as YYYY-MM
223   # get today's date
224   my (undef,undef,undef,undef,$Month,$Year,undef,undef,undef) = localtime(time);
225   # $Month is already defined from 0 to 11, so no need to decrease it by 1
226   $Year += 1900;
227   if ($Month < 1) {
228     $Month = 12;
229     $Year--;
230   };
231   # return last month
232   return sprintf('%4d-%02d',$Year,$Month);
233 };
234
235 ################################################################################
236 sub CheckMonth {
237 ################################################################################
238 ### check for valid month
239 ### IN : $Month: month
240 ### OUT: TRUE / FALSE
241   my ($Month) = @_;
242   return 0 if (defined($Month) and $Month !~ /^\d{4}-\d{2}$/);
243   return 1;
244 };
245
246 ################################################################################
247 sub SplitPeriod {
248 ################################################################################
249 ### split a time period YYYY-MM:YYYY-MM into start and end month
250 ### IN : $Period: time period
251 ### OUT: $StartMonth, Â$EndMonth
252   my ($Period) = @_;
253   return (undef,undef) if $Period !~ /^\d{4}-\d{2}:\d{4}-\d{2}$/;
254   my ($StartMonth, $EndMonth) = split /:/, $Period;
255   # switch parameters as necessary
256   if ($EndMonth gt $StartMonth) {
257     return ($StartMonth, $EndMonth);
258   } else {
259     return ($EndMonth, $StartMonth);
260   };
261 };
262
263 ################################################################################
264 sub ListMonth {
265 ################################################################################
266 ### return a list of month (YYYY-MM) between start and end month
267 ### IN : $StartMonth, $EndMonth
268 ### OUT: @Months: array containing all months from $StartMonth to $EndMonth
269   my ($StartMonth, $EndMonth) = @_;
270   return (undef,undef) if ($StartMonth !~ /^\d{4}-\d{2}$/ or $EndMonth !~ /^\d{4}-\d{2}$/);
271   # return if $StartMonth = $EndMonth
272   return ($StartMonth) if ($StartMonth eq $EndMonth);
273   # set $Year, $Month from $StartMonth
274   my ($Year, $Month) = split /-/, $StartMonth;
275   # define @Months
276   my (@Months);
277   until ("$Year-$Month" gt $EndMonth) {
278     push @Months, "$Year-$Month";
279     $Month = "$Month"; # force string context
280     $Month++;
281     if ($Month > 12) {
282       $Month = '01';
283       $Year++;
284     };
285   };
286   return @Months;
287 };
288
289 #####---------------------------- OutputFormats ---------------------------#####
290
291 ################################################################################
292 sub OutputData {
293 ################################################################################
294 ### output information with formatting from DBHandle
295 ### IN : $Format : format specifier
296 ###      $DBQuery: database query handle with executed query,
297 ###                containing $Month, $Key, $Value
298 ###      $PadGroup: padding length for newsgroups field (optional) for 'pretty'
299 ### OUT: $Output: formatted output
300   my ($Format, $DBQuery,$PadGroup) = @_;
301   while (my ($Month, $Key, $Value) = $DBQuery->fetchrow_array) {
302     print &FormatOutput($Format, $Month, $Key, $Value, $PadGroup);
303   };
304 };
305
306 ################################################################################
307 sub FormatOutput {
308 ################################################################################
309 ### format information for output
310 ### IN : $Format  : format specifier
311 ###      $PadGroup: padding length for newsgroups field (optional) for 'pretty'
312 ###      $Month   : month (as YYYY-MM)
313 ###      $Key     : newsgroup, client, ...
314 ###      $Value   : number of postings with that attribute
315 ### OUT: $Output: formatted output
316   my ($Format, $Month, $Key, $Value, $PadGroup) = @_;
317
318   # define output types
319   my %LegalOutput;
320   @LegalOutput{('dump','dumpgroup','list','pretty')} = ();
321   # bail out if format is unknown
322   die "$MySelf: E: Unknown output type '$Format'!\n" if !exists($LegalOutput{$Format});
323
324   my ($Output);
325   our ($LastIteration);
326   if ($Format eq 'dump') {
327     # output as dump (ng nnnnn)
328     $Output = sprintf ("%s %u\n",$Key,$Value);
329   } elsif ($Format eq 'dumpgroup') {
330     # output as dump (YYYY-NN: nnnnn)
331     $Output = sprintf ("%s: %5u\n",$Month,$Value);
332   } elsif ($Format eq 'list') {
333     # output as list (YYYY-NN: ng nnnnn)
334     $Output = sprintf ("%s: %s %u\n",$Month,$Key,$Value);
335   } elsif ($Format eq 'pretty') {
336     # output as table
337     $Output = sprintf ("----- %s:\n",$Month) if (!defined($LastIteration) or $Month ne $LastIteration);
338     $LastIteration = $Month;
339     $Output .= sprintf ($PadGroup ? sprintf("%%-%us %%5u\n",$PadGroup) : "%s %u\n",$Key,$Value);
340   };
341   return $Output;
342 };
343
344 #####------------------------- QueryModifications -------------------------#####
345
346 ################################################################################
347 sub SQLHierarchies {
348 ################################################################################
349 ### amend WHERE clause to include hierarchies
350 ### IN : $ShowHierarchies: boolean value
351 ### OUT: SQL code
352   my ($ShowHierarchies) = @_;
353   return $ShowHierarchies ? '' : "AND newsgroup NOT LIKE '%.ALL'";
354 };
355
356 ################################################################################
357 sub GetMaxLenght {
358 ################################################################################
359 ### get length of longest field in query
360 ### IN : $DBHandle   : database handel
361 ###      $Table      : table to query
362 ###      $Field      : field to check
363 ###      $WhereClause: WHERE clause
364 ###      @BindVars   : bind variables for WHERE clause
365 ### OUT: $Length: length of longest instnace of $Field
366   my ($DBHandle,$Table,$Field,$WhereClause,@BindVars) = @_;
367   my $DBQuery = $DBHandle->prepare(sprintf("SELECT MAX(LENGTH(%s)) FROM %s WHERE %s",$Field,$Table,$WhereClause));
368   $DBQuery->execute(@BindVars) or warn sprintf("$MySelf: W: Can't get field length for %s from table %s: $DBI::errstr\n",$Field,$Table);
369   my ($Length) = $DBQuery->fetchrow_array;
370   return $Length;
371 };
372
373 ################################################################################
374 sub SQLGroupList {
375 ################################################################################
376 ### create part of WHERE clause for list of newsgroups separated by :
377 ### IN : $Newsgroups: list of newsgroups (group.one.*:group.two:group.three.*)
378 ### OUT: SQL code, list of newsgroups
379   my ($Newsgroups) = @_;
380   $Newsgroups =~ s/\*/%/g;
381   return ('newsgroup LIKE ?', $Newsgroups) if $Newsgroups !~ /:/;
382   my $SQL = '(';
383   my @GroupList = split /:/, $Newsgroups;
384   foreach (@GroupList) {
385      $SQL .= ' OR ' if $SQL gt '(';
386      $SQL .= 'newsgroup LIKE ?';
387   };
388   $SQL .= ')';
389   return ($SQL,@GroupList);
390 };
391
392 #####------------------------------- done ---------------------------------#####
393 1;
394
395
This page took 0.019789 seconds and 3 git commands to generate.