From: Thomas Hochstein Date: Mon, 2 Sep 2013 10:55:59 +0000 (+0200) Subject: Merge branch 'language' into next X-Git-Url: https://code.th-h.de/?p=usenet%2Fnewsstats.git;a=commitdiff_plain;h=02bad3098834ed5b0fe13ad7ca5ab351f8bcb2aa;hp=95d9fe2cfd944f93036d3c584328a91d952c5c7c Merge branch 'language' into next * language: Some documentation fixes and enhancments. Improve INSTALL documentation. README: Update copyright notice. README: improve phrasing. --- diff --git a/NewsStats.pm b/NewsStats.pm index bfcb37b..b462cd4 100644 --- a/NewsStats.pm +++ b/NewsStats.pm @@ -99,7 +99,19 @@ sub ReadConfig { ### IN : $ConfFile: config filename ### OUT: reference to a hash containing the configuration my ($ConfFile) = @_; - return Config::Auto::parse($ConfFile, format => 'equal'); + # mandatory configuration options + my @Mandatory = ('DBDriver','DBHost','DBUser','DBPw','DBDatabase', + 'DBTableRaw','DBTableGrps'); + # read config via Config::Auto + my $ConfR = Config::Auto::parse($ConfFile, format => 'equal'); + my %Conf = %{$ConfR}; + # check for mandatory options + foreach (@Mandatory) { + &Bleat(2,sprintf("Mandatory configuration option %s is not set!",$_)) + if (!defined($Conf{$_})); + } + # $Conf{'TLH'} is checked in gatherstats.pl + return $ConfR; }; ################################################################################ @@ -382,16 +394,17 @@ sub OutputData { ### $FileTempl: file name template (--filetemplate): filetempl-YYYY-MM ### $DBQuery : database query handle with executed query, ### containing $Month, $Key, $Value -### $PadGroup : padding length for key field (optional) for 'pretty' +### $PadField : padding length for key field (optional) for 'pretty' +### $PadValue : padding length for value field (optional) for 'pretty' my ($Format, $Comments, $GroupBy, $Precision, $ValidKeys, $FileTempl, - $DBQuery, $PadGroup) = @_; + $DBQuery, $PadField, $PadValue) = @_; my %ValidKeys = %{$ValidKeys} if $ValidKeys; my ($FileName, $Handle, $OUT); our $LastIteration; # define output types my %LegalOutput; - @LegalOutput{('dump',,'list','pretty')} = (); + @LegalOutput{('dump','list','pretty')} = (); # bail out if format is unknown &Bleat(2,"Unknown output type '$Format'!") if !exists($LegalOutput{$Format}); @@ -427,7 +440,7 @@ sub OutputData { $Handle = $OUT; }; print $Handle &FormatOutput($Format, $Comments, $Caption, $Key, $Value, - $Precision, $PadGroup); + $Precision, $PadField, $PadValue); $LastIteration = $Caption; }; close $OUT if ($FileTempl); @@ -443,9 +456,11 @@ sub FormatOutput { ### $Key : newsgroup, client, ... or $Month, as above ### $Value : number of postings with that attribute ### $Precision: number of digits right of decimal point (0 or 2) -### $PadGroup : padding length for key field (optional) for 'pretty' +### $PadField : padding length for key field (optional) for 'pretty' +### $PadValue : padding length for value field (optional) for 'pretty' ### OUT: $Output: formatted output - my ($Format, $Comments, $Caption, $Key, $Value, $Precision, $PadGroup) = @_; + my ($Format, $Comments, $Caption, $Key, $Value, $Precision, $PadField, + $PadValue) = @_; my ($Output); # keep last caption in mind our ($LastIteration); @@ -462,8 +477,13 @@ sub FormatOutput { # output as a table $Output = sprintf ("# ----- %s:\n",$Caption) if ($Comments and (!defined($LastIteration) or $Caption ne $LastIteration)); - $Output .= sprintf ($PadGroup ? sprintf("%%-%us %%10.*f\n",$PadGroup) : - "%s %.*f\n",$Key,$Precision,$Value); + # increase $PadValue for numbers with decimal point + $PadValue += $Precision+1 if $Precision; + # add padding if $PadField is set; $PadValue HAS to be set then + $Output .= sprintf ($PadField ? + sprintf("%%-%us%%s %%%u.*f\n",$PadField,$PadValue) : + "%s%s %.*f\n",$Key,$Comments ? ':' : '', + $Precision,$Value); }; return $Output; }; @@ -485,26 +505,30 @@ sub SQLHierarchies { ################################################################################ sub GetMaxLength { ################################################################################ -### get length of longest field in future query result -### IN : $DBHandle : database handel +### get length of longest fields in future query result +### IN : $DBHandle : database handle ### $Table : table to query -### $Field : field to check +### $Field : field (key!, i.e. month, newsgroup, ...) to check +### $Value : field (value!, i.e. postings) to check ### $WhereClause : WHERE clause ### $HavingClause: HAVING clause ### @BindVars : bind variables for WHERE clause -### OUT: $Length: length of longest instnace of $Field - my ($DBHandle,$Table,$Field,$WhereClause,$HavingClause,@BindVars) = @_; - my $DBQuery = $DBHandle->prepare(sprintf("SELECT MAX(LENGTH(%s)) ". - "FROM %s %s %s",$Field,$Table, - $WhereClause,$HavingClause ? +### OUT: $FieldLength : length of longest instance of $Field +### $ValueLength : length of longest instance of $Value + my ($DBHandle,$Table,$Field,$Value,$WhereClause,$HavingClause,@BindVars) = @_; + my $DBQuery = $DBHandle->prepare(sprintf("SELECT MAX(LENGTH(%s)),". + "MAX(%s) ". + "FROM %s %s %s",$Field,,$Value, + $Table,$WhereClause,$HavingClause ? 'GROUP BY newsgroup' . $HavingClause . ' ORDER BY LENGTH(newsgroup) '. 'DESC LIMIT 1': '')); $DBQuery->execute(@BindVars) or &Bleat(1,sprintf("Can't get field length ". "for '%s' from table '%s': ". "$DBI::errstr",$Field,$Table)); - my ($Length) = $DBQuery->fetchrow_array; - return $Length; + my ($FieldLength,$ValueMax) = $DBQuery->fetchrow_array; + my $ValueLength = length($ValueMax) if ($ValueMax); + return ($FieldLength,$ValueLength); }; ################################################################################ @@ -574,16 +598,49 @@ sub SQLGroupList { my ($Newsgroups) = @_; # substitute '*' wildcard with SQL wildcard character '%' $Newsgroups =~ s/\*/%/g; + return (undef,undef) if !CheckValidNewsgroups($Newsgroups); # just one newsgroup? return (SQLGroupWildcard($Newsgroups),$Newsgroups) if $Newsgroups !~ /:/; + my ($SQL,@WildcardGroups,@NoWildcardGroups); # list of newsgroups separated by ':' - my $SQL = '('; my @GroupList = split /:/, $Newsgroups; foreach (@GroupList) { - $SQL .= ' OR ' if $SQL gt '('; - $SQL .= SQLGroupWildcard($_); + if ($_ !~ /%/) { + # add to list of newsgroup names WITHOUT wildcard + push (@NoWildcardGroups,$_); + } else { + # add to list of newsgroup names WITH wildcard + push (@WildcardGroups,$_); + # add wildcard to SQL clause + # 'OR' if SQL clause is not empty + $SQL .= ' OR ' if $SQL; + $SQL .= 'newsgroup LIKE ?' + } }; - $SQL .= ')'; + if (scalar(@NoWildcardGroups)) { + # add 'OR' if SQL clause is not empty + $SQL .= ' OR ' if $SQL; + if (scalar(@NoWildcardGroups) < 2) { + # special case: just one newsgroup without wildcard + $SQL .= 'newsgroup = ?'; + } else { + # create list of newsgroups to include: 'newsgroup IN (...)' + $SQL .= 'newsgroup IN ('; + my $SQLin; + foreach (@NoWildcardGroups) { + $SQLin .= ',' if $SQLin; + $SQLin .= '?'; + } + # add list to SQL clause + $SQL .= $SQLin .= ')'; + } + } + # add brackets '()' to SQL clause as needed (more than one wildcard group) + if (scalar(@WildcardGroups)) { + $SQL = '(' . $SQL .')'; + } + # rebuild @GroupList in (now) correct order + @GroupList = (@WildcardGroups,@NoWildcardGroups); return ($SQL,@GroupList); }; @@ -595,7 +652,6 @@ sub SQLGroupWildcard { ### (group.name or group.name.%) ### OUT: SQL code to become part of a 'WHERE' clause my ($Newsgroup) = @_; - # FIXME: check for validity if ($Newsgroup !~ /%/) { return 'newsgroup = ?'; } else { @@ -698,6 +754,19 @@ sub SQLBuildClause { return $SQLClause; }; +#####--------------------------- Verifications ----------------------------##### + +################################################################################ +sub CheckValidNewsgroups { +################################################################################ +### syntax check of newgroup list +### IN : $Newsgroups: list of newsgroups (group.one.*:group.two:group.three.*) +### OUT: boolean + my ($Newsgroups) = @_; + my $InvalidCharRegExp = ',; '; + return ($Newsgroups =~ /[$InvalidCharRegExp]/) ? 0 : 1; +}; + #####------------------------------- done ---------------------------------##### 1; diff --git a/feedlog.pl b/feedlog.pl index 0814f2c..8ff868d 100755 --- a/feedlog.pl +++ b/feedlog.pl @@ -1,4 +1,4 @@ -#! /usr/bin/perl -W +#! /usr/bin/perl # # feedlog.pl # @@ -18,6 +18,7 @@ BEGIN { push(@INC, dirname($0)); } use strict; +use warnings; use NewsStats; diff --git a/gatherstats.pl b/gatherstats.pl index 64ea87b..6db137d 100755 --- a/gatherstats.pl +++ b/gatherstats.pl @@ -1,4 +1,4 @@ -#! /usr/bin/perl -W +#! /usr/bin/perl # # gatherstats.pl # @@ -18,6 +18,7 @@ BEGIN { push(@INC, dirname($0)); } use strict; +use warnings; use NewsStats qw(:DEFAULT :TimePeriods ListNewsgroups ParseHierarchies ReadGroupList); diff --git a/groupstats.pl b/groupstats.pl index efd34ef..84105cf 100755 --- a/groupstats.pl +++ b/groupstats.pl @@ -1,4 +1,4 @@ -#! /usr/bin/perl -W +#! /usr/bin/perl # # groupstats.pl # @@ -18,6 +18,7 @@ BEGIN { push(@INC, dirname($0)); } use strict; +use warnings; use NewsStats qw(:DEFAULT :TimePeriods :Output :SQLHelper ReadGroupList); @@ -99,8 +100,13 @@ my ($CaptionPeriod,$SQLWherePeriod) = &GetTimePeriod($OptMonth); "please use 'YYYY-MM', 'YYYY-MM:YYYY-MM' or 'ALL'!") if !$CaptionPeriod; # get list of newsgroups and set expression for SQL 'WHERE' clause # with placeholders as well as a list of newsgroup to bind to them -my ($SQLWhereNewsgroups,@SQLBindNewsgroups) = &SQLGroupList($OptNewsgroups) - if $OptNewsgroups;; +my ($SQLWhereNewsgroups,@SQLBindNewsgroups); +if ($OptNewsgroups) { + ($SQLWhereNewsgroups,@SQLBindNewsgroups) = &SQLGroupList($OptNewsgroups); + # bail out if --newsgroups is invalid + &Bleat(2,"--newsgroups option has an invalid format!") + if !$SQLWhereNewsgroups; +} ### build SQL WHERE clause (and HAVING clause, if needed) my ($SQLWhereClause,$SQLHavingClause); @@ -154,9 +160,10 @@ if ($OptReportType and $OptReportType ne 'default') { ### get length of longest newsgroup name delivered by query ### for formatting purposes my $Field = ($GroupBy eq 'month') ? 'newsgroup' : 'month'; -my $MaxLength = &GetMaxLength($DBHandle,$Conf{'DBTableGrps'}, - $Field,$SQLWhereClause,$SQLHavingClause, - @SQLBindNewsgroups); +my ($MaxLength,$MaxValLength) = &GetMaxLength($DBHandle,$Conf{'DBTableGrps'}, + $Field,'postings',$SQLWhereClause, + $SQLHavingClause, + @SQLBindNewsgroups); ### build and execute SQL query my ($DBQuery); @@ -193,8 +200,8 @@ if ($OptBoundType and $OptBoundType ne 'default') { $DBQuery = $DBHandle->prepare(sprintf('SELECT %s FROM %s.%s %s %s %s', $SQLSelect, $Conf{'DBDatabase'},$Conf{'DBTableGrps'}, - $SQLWhereClause,$SQLGroupClause,$ - SQLOrderClause)); + $SQLWhereClause,$SQLGroupClause, + $SQLOrderClause)); # execute query $DBQuery->execute(@SQLBindNewsgroups) @@ -241,7 +248,7 @@ if ($OptCaptions && $OptComments) { # output data &OutputData($OptFormat,$OptComments,$GroupBy,$Precision, $OptCheckgroupsFile ? $ValidGroups : '', - $OptFileTemplate,$DBQuery,$MaxLength); + $OptFileTemplate,$DBQuery,$MaxLength,$MaxValLength); ### close handles $DBHandle->disconnect; diff --git a/install/install.pl b/install/install.pl index 4069bf5..59920fa 100755 --- a/install/install.pl +++ b/install/install.pl @@ -1,4 +1,4 @@ -#! /usr/bin/perl -W +#! /usr/bin/perl # # install.pl # @@ -18,6 +18,7 @@ BEGIN { push(@INC, dirname($0).'/..'); } use strict; +use warnings; use NewsStats qw(:DEFAULT);