projects / usenet / newsstats.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Improve output padding.
[usenet/newsstats.git] / NewsStats.pm
CommitLineData
741336c2
TH		 1# NewsStats.pm
2#
3# Library functions for the NewsStats package.
4#
edd250f2 5# Copyright (c) 2010-2012 Thomas Hochstein <thh@inter.net>
741336c2
TH		 6#
7# This module can be redistributed and/or modified under the same terms under
8# which Perl itself is published.
9
10package NewsStats;
11
12use strict;
13use warnings;
14our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
15
16require Exporter;
17@ISA = qw(Exporter);
18@EXPORT = qw(
741336c2 19 $MyVersion
f6d15ca7 20 $PackageVersion
edd250f2
TH		 21 $FullPath
22 $HomePath
23 ShowVersion
24 ShowPOD
741336c2
TH		 25 ReadConfig
26 OverrideConfig
27 InitDB
edd250f2 28 Bleat
741336c2
TH		 29);
30@EXPORT_OK = qw(
31 GetTimePeriod
32 LastMonth
741336c2
TH		 33 SplitPeriod
34 ListMonth
35 ListNewsgroups
1703b8e3 36 ParseHierarchies
ad609792 37 ReadGroupList
741336c2
TH		 38 OutputData
39 FormatOutput
40 SQLHierarchies
edd250f2 41 SQLSortOrder
741336c2 42 SQLGroupList
edd250f2
TH		 43 SQLSetBounds
44 SQLBuildClause
d3b6810d 45 GetMaxLength
741336c2 46);
edd250f2
TH		 47%EXPORT_TAGS = ( TimePeriods => [qw(GetTimePeriod LastMonth SplitPeriod
48 ListMonth)],
741336c2 49 Output => [qw(OutputData FormatOutput)],
edd250f2
TH		 50 SQLHelper => [qw(SQLHierarchies SQLSortOrder SQLGroupList
51 SQLSetBounds SQLBuildClause GetMaxLength)]);
4bbd46d3
TH		 52$VERSION = '0.01';
53our $PackageVersion = '0.01';
741336c2
TH		 54
55use Data::Dumper;
56use File::Basename;
741336c2
TH		 57
58use Config::Auto;
59use DBI;
60
61#####-------------------------------- Vars --------------------------------#####
62
edd250f2
TH		 63# trim the path
64our $FullPath = $0;
65our $HomePath = dirname($0);
66$0 =~ s%.*/%%;
67# set version string
68our $MyVersion = "$0 $::VERSION (NewsStats.pm $VERSION)";
741336c2
TH		 69
70#####------------------------------- Basics -------------------------------#####
71
741336c2
TH		 72################################################################################
73
74################################################################################
75sub ShowVersion {
76################################################################################
77### display version and exit
edd250f2
TH		 78 print "NewsStats v$PackageVersion\n$MyVersion\n";
79 print "Copyright (c) 2010-2012 Thomas Hochstein <thh\@inter.net>\n";
80 print "This program is free software; you may redistribute it ".
81 "and/or modify it under the same terms as Perl itself.\n";
741336c2
TH		 82 exit(100);
83};
84################################################################################
85
86################################################################################
87sub ShowPOD {
88################################################################################
89### feed myself to perldoc and exit
edd250f2 90 exec('perldoc', $FullPath);
741336c2
TH		 91 exit(100);
92};
93################################################################################
94
95################################################################################
96sub ReadConfig {
97################################################################################
98### read config via Config::Auto
99### IN : $ConfFile: config filename
100### OUT: reference to a hash containing the configuration
101 my ($ConfFile) = @_;
102 return Config::Auto::parse($ConfFile, format => 'equal');
103};
104################################################################################
105
106################################################################################
edd250f2 107sub OverrideConfig {
741336c2
TH		 108################################################################################
109### override configuration values
110### IN : $ConfigR : reference to configuration hash
111### $OverrideR: reference to a hash containing overrides
112 my ($ConfigR,$OverrideR) = @_;
113 my %Override = %$OverrideR;
3430c898 114 # Config hash empty?
edd250f2
TH		 115 &Bleat(1,"Empty configuration hash passed to OverrideConfig()")
116 if ( keys %$ConfigR < 1);
3430c898 117 # return if no overrides
741336c2
TH		 118 return if (keys %Override < 1 or keys %$ConfigR < 1);
119 foreach my $Key (keys %Override) {
120 $$ConfigR{$Key} = $Override{$Key};
121 };
122};
123################################################################################
124
125################################################################################
126sub InitDB {
127################################################################################
128### initialise database connection
129### IN : $ConfigR: reference to configuration hash
3430c898 130### $Die : if TRUE, die if connection fails
741336c2
TH		 131### OUT: DBHandle
132 my ($ConfigR,$Die) = @_;
133 my %Conf = %$ConfigR;
edd250f2
TH		 134 my $DBHandle = DBI->connect(sprintf('DBI:%s:database=%s;host=%s',
135 $Conf{'DBDriver'},$Conf{'DBDatabase'},
136 $Conf{'DBHost'}), $Conf{'DBUser'},
137 $Conf{'DBPw'}, { PrintError => 0 });
741336c2 138 if (!$DBHandle) {
edd250f2
TH		 139 &Bleat(2,$DBI::errstr) if (defined($Die) and $Die);
140 &Bleat(1,$DBI::errstr);
741336c2
TH		 141 };
142 return $DBHandle;
143};
144################################################################################
145
edd250f2
TH		 146################################################################################
147sub Bleat {
148################################################################################
149### print warning or error messages and terminate in case of error
150### IN : $Level : 1 = warning, 2 = error
151### $Message: warning or error message
152 my ($Level,$Message) = @_;
153 if ($Level == 1) {
154 warn "$0 W: $Message\n"
155 } elsif ($Level == 2) {
156 die "$0 E: $Message\n"
157 } else {
158 print "$0: $Message\n"
159 }
160};
161################################################################################
162
741336c2
TH		 163#####------------------------------ GetStats ------------------------------#####
164
165################################################################################
166sub ListNewsgroups {
167################################################################################
3430c898
TH		 168### explode a (scalar) list of newsgroup names to a list of newsgroup and
169### hierarchy names where every newsgroup and hierarchy appears only once:
170### de.alt.test,de.alt.admin -> de.ALL, de.alt.ALL, de.alt.test, de.alt.admin
ad609792 171### IN : $Newsgroups : a list of newsgroups (content of Newsgroups: header)
89db2f90 172### $TLH : top level hierarchy (all other newsgroups are ignored)
ad609792
TH		 173### $ValidGroupsR: reference to a hash containing all valid newsgroups
174### as keys
175### OUT: %Newsgroups : hash containing all newsgroup and hierarchy names as keys
89db2f90 176 my ($Newsgroups,$TLH,$ValidGroupsR) = @_;
ad609792 177 my %ValidGroups = %{$ValidGroupsR} if $ValidGroupsR;
741336c2
TH		 178 my %Newsgroups;
179 chomp($Newsgroups);
180 # remove whitespace from contents of Newsgroups:
181 $Newsgroups =~ s/\s//;
182 # call &HierarchyCount for each newsgroup in $Newsgroups:
183 for (split /,/, $Newsgroups) {
89db2f90
TH		 184 # don't count newsgroup/hierarchy in wrong TLH
185 next if($TLH and !/^$TLH/);
ad609792
TH		 186 # don't count invalid newsgroups
187 if(%ValidGroups and !defined($ValidGroups{$_})) {
0dc13b39 188 warn (sprintf("DROPPED: %s\n",$_));
ad609792
TH		 189 next;
190 }
741336c2
TH		 191 # add original newsgroup to %Newsgroups
192 $Newsgroups{$_} = 1;
193 # add all hierarchy elements to %Newsgroups, amended by '.ALL',
194 # i.e. de.alt.ALL and de.ALL
195 foreach (ParseHierarchies($_)) {
196 $Newsgroups{$_.'.ALL'} = 1;
197 }
198 };
199 return %Newsgroups;
200};
201
202################################################################################
203sub ParseHierarchies {
204################################################################################
3430c898
TH		 205### return a list of all hierarchy levels a newsgroup belongs to
206### (for de.alt.test.moderated that would be de/de.alt/de.alt.test)
741336c2
TH		 207### IN : $Newsgroup : a newsgroup name
208### OUT: @Hierarchies: array containing all hierarchies the newsgroup belongs to
209 my ($Newsgroup) = @_;
210 my @Hierarchies;
211 # strip trailing dots
212 $Newsgroup =~ s/(.+)\.+$/$1/;
213 # butcher newsgroup name by "." and add each hierarchy to @Hierarchies
214 # i.e. de.alt.test: "de.alt" and "de"
215 while ($Newsgroup =~ /\./) {
216 $Newsgroup =~ s/^((?:\.?[^.]+)*)\.[^.]+$/$1/;
217 push @Hierarchies, $Newsgroup;
218 };
219 return @Hierarchies;
220};
221
ad609792
TH		 222################################################################################
223sub ReadGroupList {
224################################################################################
225### read a list of valid newsgroups from file (each group on one line,
226### ignoring everything after the first whitespace and so accepting files
227### in checkgroups format as well as (parts of) an INN active file)
228### IN : $Filename : file to read
229### OUT: \%ValidGroups: hash containing all valid newsgroups
230 my ($Filename) = @_;
231 my %ValidGroups;
edd250f2 232 open (my $LIST,"<$Filename") or &Bleat(2,"Cannot read $Filename: $!");
ad609792 233 while (<$LIST>) {
7662b106 234 s/^\s*(\S+).*$/$1/;
ad609792 235 chomp;
7662b106 236 next if /^$/;
ad609792
TH		 237 $ValidGroups{$_} = '1';
238 };
239 close $LIST;
240 return \%ValidGroups;
241};
242
741336c2
TH		 243################################################################################
244
245#####----------------------------- TimePeriods ----------------------------#####
246
247################################################################################
248sub GetTimePeriod {
249################################################################################
edd250f2
TH		 250### get a time period to act on from --month option;
251### if empty, default to last month
252### IN : $Month: may be empty, 'YYYY-MM', 'YYYY-MM:YYYY-MM' or 'all'
253### OUT: $Verbal,$SQL: verbal description and WHERE-clause
254### of the chosen time period
255 my ($Month) = @_;
256 # define result variables
257 my ($Verbal, $SQL);
258 # define a regular expression for a month
259 my $REMonth = '\d{4}-\d{2}';
260
261 # default to last month if option is not set
262 if(!$Month) {
263 $Month = &LastMonth;
264 }
265
266 # check for valid input
267 if ($Month =~ /^$REMonth$/) {
268 # single month (YYYY-MM)
269 ($Month) = &CheckMonth($Month);
270 $Verbal = $Month;
271 $SQL = sprintf("month = '%s'",$Month);
272 } elsif ($Month =~ /^$REMonth:$REMonth$/) {
273 # time period (YYYY-MM:YYYY-MM)
274 $Verbal = sprintf('%s to %s',&SplitPeriod($Month));
275 $SQL = sprintf("month BETWEEN '%s' AND '%s'",&SplitPeriod($Month));
276 } elsif ($Month =~ /^all$/i) {
277 # special case: ALL
278 $Verbal = 'all time';
279 $SQL = '';
741336c2 280 } else {
edd250f2
TH		 281 # invalid input
282 return (undef,undef);
283 }
284
285 return ($Verbal,$SQL);
741336c2
TH		 286};
287
288################################################################################
289sub LastMonth {
290################################################################################
3430c898 291### get last month from todays date in YYYY-MM format
741336c2
TH		 292### OUT: last month as YYYY-MM
293 # get today's date
294 my (undef,undef,undef,undef,$Month,$Year,undef,undef,undef) = localtime(time);
295 # $Month is already defined from 0 to 11, so no need to decrease it by 1
296 $Year += 1900;
297 if ($Month < 1) {
298 $Month = 12;
299 $Year--;
300 };
301 # return last month
302 return sprintf('%4d-%02d',$Year,$Month);
303};
304
305################################################################################
306sub CheckMonth {
307################################################################################
edd250f2
TH		 308### check if input (in YYYY-MM form) is valid with MM between 01 and 12;
309### otherwise, fix it
310### IN : @Month: array of month
311### OUT: @Month: a valid month
312 my (@Month) = @_;
313 foreach my $Month (@Month) {
314 my ($OldMonth) = $Month;
315 my ($CalMonth) = substr ($Month, -2);
316 if ($CalMonth < 1 or $CalMonth > 12) {
317 $CalMonth = '12' if $CalMonth > 12;
318 $CalMonth = '01' if $CalMonth < 1;
319 substr($Month, -2) = $CalMonth;
320 &Bleat(1,sprintf("'%s' is an invalid date (MM must be between '01' ".
321 "and '12'), set to '%s'.",$OldMonth,$Month));
322 }
323 }
324 return @Month;
741336c2
TH		 325};
326
327################################################################################
328sub SplitPeriod {
329################################################################################
3430c898 330### split a time period denoted by YYYY-MM:YYYY-MM into start and end month
741336c2 331### IN : $Period: time period
edd250f2 332### OUT: $StartMonth, $EndMonth
741336c2 333 my ($Period) = @_;
741336c2 334 my ($StartMonth, $EndMonth) = split /:/, $Period;
edd250f2 335 ($StartMonth,$EndMonth) = CheckMonth($StartMonth,$EndMonth);
741336c2
TH		 336 # switch parameters as necessary
337 if ($EndMonth gt $StartMonth) {
338 return ($StartMonth, $EndMonth);
339 } else {
340 return ($EndMonth, $StartMonth);
341 };
342};
343
344################################################################################
345sub ListMonth {
346################################################################################
3430c898 347### return a list of months (YYYY-MM) between start and end month
880c3eb2
TH		 348### IN : $MonthExpression ('YYYY-MM' or 'YYYY-MM to YYYY-MM')
349### OUT: @Months: array containing all months from $MonthExpression enumerated
350 my ($MonthExpression )= @_;
351 # return if single month
352 return ($MonthExpression) if ($MonthExpression =~ /^\d{4}-\d{2}$/);
353 # parse $MonthExpression
354 my ($StartMonth, $EndMonth) = split(' to ',$MonthExpression);
741336c2
TH		 355 # set $Year, $Month from $StartMonth
356 my ($Year, $Month) = split /-/, $StartMonth;
357 # define @Months
358 my (@Months);
359 until ("$Year-$Month" gt $EndMonth) {
360 push @Months, "$Year-$Month";
361 $Month = "$Month"; # force string context
362 $Month++;
363 if ($Month > 12) {
364 $Month = '01';
365 $Year++;
366 };
367 };
368 return @Months;
369};
370
371#####---------------------------- OutputFormats ---------------------------#####
372
373################################################################################
374sub OutputData {
375################################################################################
3430c898 376### read database query results from DBHandle and print results with formatting
edd250f2
TH		 377### IN : $Format : format specifier
378### $Comments : print or suppress all comments for machine-readable output
379### $GroupBy : primary sorting order (month or key)
380### $Precision: number of digits right of decimal point (0 or 2)
381### $ValidKeys: reference to a hash containing all valid keys
382### $FileTempl: file name template (--filetemplate): filetempl-YYYY-MM
383### $DBQuery : database query handle with executed query,
78389b28 384### containing $Month, $Key, $Value
b342fcf0
TH		 385### $PadField : padding length for key field (optional) for 'pretty'
386### $PadValue : padding length for value field (optional) for 'pretty'
edd250f2 387 my ($Format, $Comments, $GroupBy, $Precision, $ValidKeys, $FileTempl,
b342fcf0 388 $DBQuery, $PadField, $PadValue) = @_;
edd250f2
TH		 389 my %ValidKeys = %{$ValidKeys} if $ValidKeys;
390 my ($FileName, $Handle, $OUT);
78389b28 391 our $LastIteration;
edd250f2
TH		 392
393 # define output types
394 my %LegalOutput;
b342fcf0 395 @LegalOutput{('dump','list','pretty')} = ();
edd250f2
TH		 396 # bail out if format is unknown
397 &Bleat(2,"Unknown output type '$Format'!") if !exists($LegalOutput{$Format});
398
741336c2 399 while (my ($Month, $Key, $Value) = $DBQuery->fetchrow_array) {
edd250f2
TH		 400 # don't display invalid keys
401 if(%ValidKeys and !defined($ValidKeys{$Key})) {
402 # FIXME
403 # &Bleat(1,sprintf("DROPPED: %s",$Key));
404 next;
405 };
406 # care for correct sorting order and abstract from month and keys:
407 # $Caption will be $Month or $Key, according to sorting order,
408 # and $Key will be $Key or $Month, respectively
409 my $Caption;
410 if ($GroupBy eq 'key') {
411 $Caption = $Key;
412 $Key = $Month;
413 } else {
414 $Caption = $Month;
415 }
78389b28 416 # set output file handle
edd250f2 417 if (!$FileTempl) {
78389b28 418 $Handle = *STDOUT{IO}; # set $Handle to a reference to STDOUT
edd250f2 419 } elsif (!defined($LastIteration) or $LastIteration ne $Caption) {
78389b28 420 close $OUT if ($LastIteration);
edd250f2
TH		 421 # safeguards for filename creation:
422 # replace potential problem characters with '_'
423 $FileName = sprintf('%s-%s',$FileTempl,$Caption);
424 $FileName =~ s/[^a-zA-Z0-9_-]+/_/g;
425 open ($OUT,">$FileName")
426 or &Bleat(2,sprintf("Cannot open output file '%s': $!",
427 $FileName));
78389b28
TH		 428 $Handle = $OUT;
429 };
edd250f2 430 print $Handle &FormatOutput($Format, $Comments, $Caption, $Key, $Value,
b342fcf0 431 $Precision, $PadField, $PadValue);
edd250f2 432 $LastIteration = $Caption;
741336c2 433 };
edd250f2 434 close $OUT if ($FileTempl);
741336c2
TH		 435};
436
437################################################################################
438sub FormatOutput {
439################################################################################
3430c898 440### format information for output according to format specifier
edd250f2
TH		 441### IN : $Format : format specifier
442### $Comments : print or suppress all comments for machine-readable output
443### $Caption : month (as YYYY-MM) or $Key, according to sorting order
444### $Key : newsgroup, client, ... or $Month, as above
445### $Value : number of postings with that attribute
446### $Precision: number of digits right of decimal point (0 or 2)
b342fcf0
TH		 447### $PadField : padding length for key field (optional) for 'pretty'
448### $PadValue : padding length for value field (optional) for 'pretty'
741336c2 449### OUT: $Output: formatted output
b342fcf0
TH		 450 my ($Format, $Comments, $Caption, $Key, $Value, $Precision, $PadField,
451 $PadValue) = @_;
741336c2 452 my ($Output);
edd250f2 453 # keep last caption in mind
741336c2 454 our ($LastIteration);
edd250f2 455 # create one line of output
741336c2 456 if ($Format eq 'dump') {
edd250f2
TH		 457 # output as dump (key value)
458 $Output = sprintf ("# %s:\n",$Caption)
459 if ($Comments and (!defined($LastIteration) or $Caption ne $LastIteration));
460 $Output .= sprintf ("%s %u\n",$Key,$Value);
741336c2 461 } elsif ($Format eq 'list') {
edd250f2
TH		 462 # output as list (caption key value)
463 $Output = sprintf ("%s %s %u\n",$Caption,$Key,$Value);
741336c2 464 } elsif ($Format eq 'pretty') {
edd250f2
TH		 465 # output as a table
466 $Output = sprintf ("# ----- %s:\n",$Caption)
467 if ($Comments and (!defined($LastIteration) or $Caption ne $LastIteration));
b342fcf0
TH		 468 # increase $PadValue for numbers with decimal point
469 $PadValue += $Precision+1 if $Precision;
470 # add padding if $PadField is set; $PadValue HAS to be set then
471 $Output .= sprintf ($PadField ?
472 sprintf("%%-%us%%s %%%u.*f\n",$PadField,$PadValue) :
473 "%s%s %.*f\n",$Key,$Comments ? ':' : '',
474 $Precision,$Value);
741336c2
TH		 475 };
476 return $Output;
477};
478
479#####------------------------- QueryModifications -------------------------#####
480
481################################################################################
482sub SQLHierarchies {
483################################################################################
3430c898
TH		 484### add exclusion of hierarchy levels (de.alt.ALL) from SQL query by
485### amending the WHERE clause if $ShowHierarchies is false (or don't, if it is
486### true, accordingly)
741336c2
TH		 487### IN : $ShowHierarchies: boolean value
488### OUT: SQL code
489 my ($ShowHierarchies) = @_;
edd250f2 490 return $ShowHierarchies ? '' : "newsgroup NOT LIKE '%.ALL'";
741336c2
TH		 491};
492
493################################################################################
d3b6810d 494sub GetMaxLength {
741336c2 495################################################################################
b342fcf0
TH		 496### get length of longest fields in future query result
497### IN : $DBHandle : database handle
edd250f2 498### $Table : table to query
b342fcf0
TH		 499### $Field : field (key!, i.e. month, newsgroup, ...) to check
500### $Value : field (value!, i.e. postings) to check
edd250f2
TH		 501### $WhereClause : WHERE clause
502### $HavingClause: HAVING clause
503### @BindVars : bind variables for WHERE clause
b342fcf0
TH		 504### OUT: $FieldLength : length of longest instance of $Field
505### $ValueLength : length of longest instance of $Value
506 my ($DBHandle,$Table,$Field,$Value,$WhereClause,$HavingClause,@BindVars) = @_;
507 my $DBQuery = $DBHandle->prepare(sprintf("SELECT MAX(LENGTH(%s)),".
508 "MAX(%s) ".
509 "FROM %s %s %s",$Field,,$Value,
510 $Table,$WhereClause,$HavingClause ?
edd250f2
TH		 511 'GROUP BY newsgroup' . $HavingClause .
512 ' ORDER BY LENGTH(newsgroup) '.
513 'DESC LIMIT 1': ''));
514 $DBQuery->execute(@BindVars) or &Bleat(1,sprintf("Can't get field length ".
515 "for '%s' from table '%s': ".
516 "$DBI::errstr",$Field,$Table));
b342fcf0
TH		 517 my ($FieldLength,$ValueMax) = $DBQuery->fetchrow_array;
518 my $ValueLength = length($ValueMax) if ($ValueMax);
519 return ($FieldLength,$ValueLength);
741336c2
TH		 520};
521
edd250f2
TH		 522################################################################################
523sub SQLSortOrder {
524################################################################################
525### build a SQL 'ORDER BY' clause from $OptGroupBy (primary sorting) and
526### $OptOrderBy (secondary sorting), both ascending or descending;
527### descending sorting order is done by adding '-desc'
528### IN : $GroupBy: primary sort by 'month' (default) or 'newsgroups'
529### $OrderBy: secondary sort by month/newsgroups (default)
530### or number of 'postings'
531### OUT: a SQL ORDER BY clause
532 my ($GroupBy,$OrderBy) = @_;
533 my ($GroupSort,$OrderSort) = ('','');
534 # $GroupBy (primary sorting)
535 if (!$GroupBy) {
536 $GroupBy = 'month';
537 } else {
538 ($GroupBy, $GroupSort) = SQLParseOrder($GroupBy);
539 if ($GroupBy =~ /group/i) {
540 $GroupBy = 'newsgroup';
541 } else {
542 $GroupBy = 'month';
543 }
544 }
545 my $Secondary = ($GroupBy eq 'month') ? 'newsgroup' : 'month';
546 # $OrderBy (secondary sorting)
547 if (!$OrderBy) {
548 $OrderBy = $Secondary;
549 } else {
550 ($OrderBy, $OrderSort) = SQLParseOrder($OrderBy);
551 if ($OrderBy =~ /posting/i) {
552 $OrderBy = "postings $OrderSort, $Secondary";
553 } else {
554 $OrderBy = "$Secondary $OrderSort";
555 }
556 }
557 return ($GroupBy,&SQLBuildClause('order',"$GroupBy $GroupSort",$OrderBy));
558};
559
560################################################################################
561sub SQLParseOrder {
562################################################################################
563### parse $OptGroupBy or $OptOrderBy option of the form param[-desc], e.g.
564### 'month', 'month-desc', 'newsgroups-desc', but also just 'desc'
565### IN : $OrderOption: order option (see above)
566### OUT: parameter to sort by,
567### sort order ('DESC' or nothing, meaning 'ASC')
568 my ($OrderOption) = @_;
569 my $SortOrder = '';
570 if ($OrderOption =~ s/-?desc$//i) {
571 $SortOrder = 'DESC';
572 } else {
573 $OrderOption =~ s/-?asc$//i
574 }
575 return ($OrderOption,$SortOrder);
576};
577
741336c2
TH		 578################################################################################
579sub SQLGroupList {
580################################################################################
edd250f2
TH		 581### explode list of newsgroups separated by : (with wildcards)
582### to a SQL 'WHERE' expression
741336c2 583### IN : $Newsgroups: list of newsgroups (group.one.*:group.two:group.three.*)
edd250f2
TH		 584### OUT: SQL code to become part of a 'WHERE' clause,
585### list of newsgroups for SQL bindings
741336c2 586 my ($Newsgroups) = @_;
edd250f2 587 # substitute '*' wildcard with SQL wildcard character '%'
741336c2 588 $Newsgroups =~ s/\*/%/g;
edd250f2
TH		 589 # just one newsgroup?
590 return (SQLGroupWildcard($Newsgroups),$Newsgroups) if $Newsgroups !~ /:/;
591 # list of newsgroups separated by ':'
741336c2
TH		 592 my $SQL = '(';
593 my @GroupList = split /:/, $Newsgroups;
594 foreach (@GroupList) {
595 $SQL .= ' OR ' if $SQL gt '(';
edd250f2 596 $SQL .= SQLGroupWildcard($_);
741336c2
TH		 597 };
598 $SQL .= ')';
599 return ($SQL,@GroupList);
600};
601
edd250f2
TH		 602################################################################################
603sub SQLGroupWildcard {
604################################################################################
605### build a valid SQL 'WHERE' expression with or without wildcards
606### IN : $Newsgroup: newsgroup expression, probably with wildcard
607### (group.name or group.name.%)
608### OUT: SQL code to become part of a 'WHERE' clause
609 my ($Newsgroup) = @_;
610 # FIXME: check for validity
611 if ($Newsgroup !~ /%/) {
612 return 'newsgroup = ?';
613 } else {
614 return 'newsgroup LIKE ?';
615 }
616};
617
618################################################################################
619sub SQLSetBounds {
620################################################################################
621### set upper and/or lower boundary (number of postings)
622### IN : $Type: 'level', 'average', 'sum' or 'default'
623### $LowBound,$UppBound: lower/upper boundary, respectively
624### OUT: SQL code to become part of a WHERE or HAVING clause
625 my ($Type,$LowBound,$UppBound) = @_;
626 ($LowBound,$UppBound) = SQLCheckNumber($LowBound,$UppBound);
627 if($LowBound and $UppBound and $LowBound > $UppBound) {
628 &Bleat(1,"Lower boundary $LowBound is larger than Upper boundary ".
629 "$UppBound, exchanging boundaries.");
630 ($LowBound,$UppBound) = ($UppBound,$LowBound);
631 }
632 # default to 'default'
633 my $WhereHavingFunction = 'postings';
634 # set $LowBound to SQL statement:
635 # 'WHERE postings >=', 'HAVING MIN(postings) >=' or 'HAVING AVG(postings) >='
636 if ($Type eq 'level') {
637 $WhereHavingFunction = 'MIN(postings)'
638 } elsif ($Type eq 'average') {
639 $WhereHavingFunction = 'AVG(postings)'
640 } elsif ($Type eq 'sum') {
641 $WhereHavingFunction = 'SUM(postings)'
642 }
643 $LowBound = sprintf('%s >= '.$LowBound,$WhereHavingFunction) if ($LowBound);
644 # set $LowBound to SQL statement:
645 # 'WHERE postings <=', 'HAVING MAX(postings) <=' or 'HAVING AVG(postings) <='
646 if ($Type eq 'level') {
647 $WhereHavingFunction = 'MAX(postings)'
648 } elsif ($Type eq 'average') {
649 $WhereHavingFunction = 'AVG(postings)'
650 } elsif ($Type eq 'sum') {
651 $WhereHavingFunction = 'SUM(postings)'
652 }
653 $UppBound = sprintf('%s <= '.$UppBound,$WhereHavingFunction) if ($UppBound);
654 return ($LowBound,$UppBound);
655};
656
657################################################################################
658sub SQLCheckNumber {
659################################################################################
660### check if input is a valid positive integer; otherwise, make it one
661### IN : @Numbers: array of parameters
662### OUT: @Numbers: a valid positive integer
663 my (@Numbers) = @_;
664 foreach my $Number (@Numbers) {
665 if ($Number and $Number < 0) {
666 &Bleat(1,"Boundary $Number is < 0, set to ".-$Number);
667 $Number = -$Number;
668 }
669 $Number = '' if ($Number and $Number !~ /^\d+$/);
670 }
671 return @Numbers;
672};
673
674################################################################################
675sub SQLBuildClause {
676################################################################################
677### build a valid SQL WHERE, GROUP BY, ORDER BY or HAVING clause
678### from multiple expressions which *may* be empty
679### IN : $Type: 'where', 'having', 'group' or 'order'
680### @Expressions: array of expressions
681### OUT: $SQLClause: a SQL clause
682 my ($Type,@Expressions) = @_;
683 my ($SQLClause,$Separator,$Statement);
684 # set separator ('AND' or ',')
685 if ($Type eq 'where' or $Type eq 'having') {
686 $Separator = 'AND';
687 } else {
688 $Separator = ',';
689 }
690 # set statement
691 if ($Type eq 'where') {
692 $Statement = 'WHERE';
693 } elsif ($Type eq 'order') {
694 $Statement = 'ORDER BY';
695 } elsif ($Type eq 'having') {
696 $Statement = 'HAVING';
697 } else {
698 $Statement = 'GROUP BY';
699 }
700 # build query from expressions with separators
701 foreach my $Expression (@Expressions) {
702 if ($Expression) {
703 $SQLClause .= " $Separator " if ($SQLClause);
704 $SQLClause .= $Expression;
705 }
706 }
707 # add statement in front if not already present
708 $SQLClause = " $Statement " . $SQLClause
709 if ($SQLClause and $SQLClause !~ /$Statement/);
710 return $SQLClause;
711};
712
713
741336c2
TH		 714#####------------------------------- done ---------------------------------#####
7151;
716
717
Usenet-Statistik
This page took 0.049768 seconds and 4 git commands to generate.