Merge branch 'language' into next
authorThomas Hochstein <thh@inter.net>
Mon, 2 Sep 2013 11:00:33 +0000 (13:00 +0200)
committerThomas Hochstein <thh@inter.net>
Mon, 2 Sep 2013 11:00:33 +0000 (13:00 +0200)
* language:
  Some documentation fixes and enhancments.
  Improve INSTALL documentation.
  README: Update copyright notice.
  README: improve phrasing.

NewsStats.pm
feedlog.pl
gatherstats.pl
groupstats.pl
install/install.pl

index bfcb37b..b462cd4 100644 (file)
@@ -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;
index 0814f2c..8ff868d 100755 (executable)
@@ -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;
 
index 64ea87b..6db137d 100755 (executable)
@@ -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);
 
index efd34ef..84105cf 100755 (executable)
@@ -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;
index 4069bf5..59920fa 100755 (executable)
@@ -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);
 
This page took 0.016966 seconds and 4 git commands to generate.