| 1 | #! /usr/bin/perl -W\r |
| 2 | #\r |
| 3 | # gatherstats.pl\r |
| 4 | #\r |
| 5 | # This script will gather statistical information from a database\r |
| 6 | # containing headers and other information from a INN feed.\r |
| 7 | # \r |
| 8 | # It is part of the NewsStats package.\r |
| 9 | #\r |
| 10 | # Copyright (c) 2010 Thomas Hochstein <thh@inter.net>\r |
| 11 | #\r |
| 12 | # It can be redistributed and/or modified under the same terms under \r |
| 13 | # which Perl itself is published.\r |
| 14 | \r |
| 15 | BEGIN {\r |
| 16 | our $VERSION = "0.01";\r |
| 17 | use File::Basename;\r |
| 18 | push(@INC, dirname($0));\r |
| 19 | }\r |
| 20 | use strict;\r |
| 21 | \r |
| 22 | use NewsStats qw(:DEFAULT :TimePeriods ListNewsgroups);\r |
| 23 | \r |
| 24 | use DBI;\r |
| 25 | \r |
| 26 | ################################# Definitions ##################################\r |
| 27 | \r |
| 28 | # define types of information that can be gathered\r |
| 29 | # all / groups (/ clients / hosts)\r |
| 30 | my %LegalTypes;\r |
| 31 | @LegalTypes{('all','groups')} = ();\r |
| 32 | \r |
| 33 | ################################# Main program #################################\r |
| 34 | \r |
| 35 | ### read commandline options\r |
| 36 | my %Options = &ReadOptions('dom:p:t:n:r:g:c:s:');\r |
| 37 | \r |
| 38 | ### read configuration\r |
| 39 | my %Conf = %{ReadConfig('newsstats.conf')};\r |
| 40 | \r |
| 41 | ### override configuration via commandline options\r |
| 42 | my %ConfOverride;\r |
| 43 | $ConfOverride{'DBTableRaw'} = $Options{'r'} if $Options{'r'};\r |
| 44 | $ConfOverride{'DBTableGrps'} = $Options{'g'} if $Options{'g'};\r |
| 45 | $ConfOverride{'DBTableClnts'} = $Options{'c'} if $Options{'c'};\r |
| 46 | $ConfOverride{'DBTableHosts'} = $Options{'s'} if $Options{'s'};\r |
| 47 | $ConfOverride{'TLH'} = $Options{'n'} if $Options{'n'};\r |
| 48 | &OverrideConfig(\%Conf,\%ConfOverride);\r |
| 49 | \r |
| 50 | ### get type of information to gather, default to 'all'\r |
| 51 | $Options{'t'} = 'all' if !$Options{'t'};\r |
| 52 | die "$MySelf: E: Unknown type '-t $Options{'t'}'!\n" if !exists($LegalTypes{$Options{'t'}});\r |
| 53 | \r |
| 54 | ### get time period\r |
| 55 | my ($StartMonth,$EndMonth) = &GetTimePeriod($Options{'m'},$Options{'p'});\r |
| 56 | \r |
| 57 | ### init database\r |
| 58 | my $DBHandle = InitDB(\%Conf,1);\r |
| 59 | \r |
| 60 | ### get data for each month\r |
| 61 | warn "$MySelf: W: Output only mode. Database is not updated.\n" if $Options{'o'};\r |
| 62 | foreach my $Month (&ListMonth($StartMonth,$EndMonth)) {\r |
| 63 | \r |
| 64 | print "---------- $Month ----------\n" if $Options{'d'};\r |
| 65 | \r |
| 66 | if ($Options{'t'} eq 'all' or $Options{'t'} eq 'groups') {\r |
| 67 | ### ----------------------------------------------\r |
| 68 | ### get groups data (number of postings per group)\r |
| 69 | # get groups data from raw table for given month\r |
| 70 | my $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s.%s WHERE day LIKE ? AND NOT disregard",$Conf{'DBDatabase'},$Conf{'DBTableRaw'}));\r |
| 71 | $DBQuery->execute($Month.'-%') or die sprintf("$MySelf: E: Can't get groups data for %s from %s.%s: $DBI::errstr\n",$Month,$Conf{'DBDatabase'},$Conf{'DBTableRaw'});\r |
| 72 | \r |
| 73 | # count postings per group\r |
| 74 | my %Postings;\r |
| 75 | \r |
| 76 | while (($_) = $DBQuery->fetchrow_array) {\r |
| 77 | # get list oft newsgroups and hierarchies from Newsgroups:\r |
| 78 | my %Newsgroups = ListNewsgroups($_);\r |
| 79 | # count each newsgroup and hierarchy once\r |
| 80 | foreach (sort keys %Newsgroups) {\r |
| 81 | # don't count newsgroup/hierarchy in wrong TLH\r |
| 82 | next if(defined($Conf{'TLH'}) and !/^$Conf{'TLH'}/);\r |
| 83 | $Postings{$_}++;\r |
| 84 | };\r |
| 85 | };\r |
| 86 | \r |
| 87 | print "----- GroupStats -----\n" if $Options{'d'};\r |
| 88 | foreach my $Newsgroup (sort keys %Postings) {\r |
| 89 | print "$Newsgroup => $Postings{$Newsgroup}\n" if $Options{'d'};\r |
| 90 | if (!$Options{'o'}) {\r |
| 91 | # write to database\r |
| 92 | $DBQuery = $DBHandle->prepare(sprintf("REPLACE INTO %s.%s (month,newsgroup,postings) VALUES (?, ?, ?)",$Conf{'DBDatabase'},$Conf{'DBTableGrps'}));\r |
| 93 | $DBQuery->execute($Month, $Newsgroup, $Postings{$Newsgroup}) or die sprintf("$MySelf: E: Can't write groups data for %s/%s to %s.%s: $DBI::errstr\n",$Month,$Newsgroup,$Conf{'DBDatabase'},$Conf{'DBTableGrps'});\r |
| 94 | $DBQuery->finish;\r |
| 95 | };\r |
| 96 | };\r |
| 97 | };\r |
| 98 | };\r |
| 99 | \r |
| 100 | ### close handles\r |
| 101 | $DBHandle->disconnect;\r |
| 102 | \r |