X-Git-Url: https://code.th-h.de/?p=usenet%2Fnewsstats.git;a=blobdiff_plain;f=NewsStats.pm;h=a23777482bc23e0f7d4ae8a0460c0a38d7e7a3e7;hp=cd059cf2e14eee1922a510dc0628e1029218bb29;hb=07c0b2589af779c33d5d35b6a7fa0e7883201674;hpb=b342fcf030155e68748c09c3469f43d4559a6dfb;ds=inline diff --git a/NewsStats.pm b/NewsStats.pm index cd059cf..a237774 100644 --- a/NewsStats.pm +++ b/NewsStats.pm @@ -2,7 +2,7 @@ # # Library functions for the NewsStats package. # -# Copyright (c) 2010-2012 Thomas Hochstein +# Copyright (c) 2010-2013 Thomas Hochstein # # This module can be redistributed and/or modified under the same terms under # which Perl itself is published. @@ -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; }; ################################################################################ @@ -586,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); }; @@ -607,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 { @@ -710,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;