Commit | Line | Data |
---|---|---|
741336c2 TH |
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); | |
b221278d TH |
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); | |
741336c2 TH |
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 |