5 # This script will parse a database with raw header information
6 # from a INN feed to a structured database.
8 # It is part of the NewsStats package.
10 # Copyright (c) 2013 Thomas Hochstein <thh@inter.net>
12 # It can be redistributed and/or modified under the same terms under
13 # which Perl itself is published.
16 our $VERSION = "0.01";
18 # we're in .../bin, so our module is in ../lib
19 push(@INC, dirname($0).'/../lib');
24 use NewsStats qw(:DEFAULT :TimePeriods :SQLHelper);
27 use Getopt::Long qw(GetOptions);
28 Getopt::Long::config ('bundling');
30 ################################# Definitions ##################################
32 # define header names with separate database fields
33 my %DBFields = ('date' => 'date',
34 'references' => 'refs',
35 'followup-to' => 'fupto',
38 'reply-to' => 'replyto',
39 'subject' => 'subject',
40 'organization' => 'organization',
41 'lines' => 'linecount',
42 'approved' => 'approved',
43 'supersedes' => 'supersedes',
44 'expires' => 'expires',
45 'user-agent' => 'useragent',
46 'x-newsreader' => 'xnewsreader',
47 'x-mailer' => 'xmailer',
48 'x-no-archive' => 'xnoarchive',
49 'content-type' => 'contenttype',
50 'content-transfer-encoding' => 'contentencoding',
51 'cancel-lock' => 'cancellock',
52 'injection-info' => 'injectioninfo',
53 'x-trace' => 'xtrace',
54 'nntp-posting-host' => 'postinghost');
56 # define field list for database
57 my @DBFields = qw/day mid refs date path newsgroups fupto from_ from_parsed
58 from_name from_address sender sender_parsed sender_name
59 sender_address replyto replyto_parsed replyto_name
60 replyto_address subject subject_parsed organization linecount
61 approved supersedes expires useragent xnewsreader xmailer
62 xnoarchive contenttype contentencoding cancellock injectioninfo
63 xtrace postinghost headers disregard/;
65 ################################# Main program #################################
67 ### read commandline options
68 my ($OptDay,$OptDebug,$OptParseDB,$OptRawDB,$OptTest,$OptConfFile);
69 GetOptions ('d|day=s' => \$OptDay,
70 'debug!' => \$OptDebug,
71 'parsedb=s' => \$OptParseDB,
72 'rawdb=s' => \$OptRawDB,
73 't|test!' => \$OptTest,
74 'conffile=s' => \$OptConfFile,
75 'h|help' => \&ShowPOD,
76 'V|version' => \&ShowVersion) or exit 1;
78 ### read configuration
79 my %Conf = %{ReadConfig($OptConfFile)};
81 ### override configuration via commandline options
83 $ConfOverride{'DBTableRaw'} = $OptRawDB if $OptRawDB;
84 $ConfOverride{'DBTableParse'} = $OptParseDB if $OptParseDB;
85 &OverrideConfig(\%Conf,\%ConfOverride);
88 ### and set $Period for output and expression for SQL 'WHERE' clause
89 my ($Period,$SQLWherePeriod) = &GetTimePeriod($OptDay,'day');
90 # bail out if --month is invalid or "all"
91 &Bleat(2,"--day option has an invalid format - please use 'YYYY-MM-DD' or ".
92 "'YYYY-MM-DD:YYYY-MM-DD'!") if (!$Period or $Period eq 'all time');
95 my $DBHandle = InitDB(\%Conf,1);
98 &Bleat(1,'Test mode. Database is not updated.') if $OptTest;
100 # create $SQLWhereClause
101 my $SQLWhereClause = SQLBuildClause('where',$SQLWherePeriod,'NOT disregard');
103 # delete old data for current period
105 print "----------- Deleting old data ... -----------\n" if $OptDebug;
106 my $DBQuery = $DBHandle->do(sprintf("DELETE FROM %s.%s %s",
107 $Conf{'DBDatabase'},$Conf{'DBTableParse'},
109 or &Bleat(2,sprintf("Can't delete old parsed data for %s from %s.%s: ".
110 "$DBI::errstr\n",$Period,
111 $Conf{'DBDatabase'},$Conf{'DBTableParse'}));
114 # read from DBTableRaw
115 print "-------------- Reading data ... -------------\n" if $OptDebug;
116 my $DBQuery = $DBHandle->prepare(sprintf("SELECT id, day, mid, peer, path, ".
117 "newsgroups, headers, disregard ".
118 "FROM %s.%s %s", $Conf{'DBDatabase'},
119 $Conf{'DBTableRaw'}, $SQLWhereClause));
121 or &Bleat(2,sprintf("Can't get data for %s from %s.%s: ".
122 "$DBI::errstr\n",$Period,
123 $Conf{'DBDatabase'},$Conf{'DBTableRaw'}));
125 # set output and database connection to UTF-8
126 # as we're going to write decoded header contents containing UTF-8 chars
127 binmode(STDOUT, ":utf8");
128 $DBHandle->do("SET NAMES 'utf8'");
130 # parse data in a loop and write it out
131 print "-------------- Parsing data ... -------------\n" if $OptDebug;
132 while (my $HeadersR = $DBQuery->fetchrow_hashref) {
133 my %Headers = %{$HeadersR};
135 # parse $Headers{'headers'} ('headers' from DBTableRaw)
136 # merge continuation lines
137 # from Perl Cookbook, 1st German ed. 1999, pg. 91
138 $Headers{'headers'} =~ s/\n\s+/ /g;
139 # split headers in single lines
141 for (split(/\n/,$Headers{'headers'})) {
142 # split header lines in header name and header content
143 my ($key,$value) = split(/:/,$_,2);
145 $value =~ s/^\s*(.+)\s*$/$1/;
146 # save each header, separate database fields in %Headers,
147 # the rest in $OtherHeaders (but not Message-ID, Path, Peer
148 # and Newsgroups as those do already exist)
149 if (defined($DBFields{lc($key)})) {
150 $Headers{$DBFields{lc($key)}} = $value;
152 $OtherHeaders .= sprintf("%s: %s\n",$key,$value)
153 if lc($key) !~ /^(message-id|path|peer|newsgroups)$/;
156 # replace old (now parsed) $Headers{'headers'} with remanining $OtherHeaders
157 chomp($OtherHeaders);
158 $Headers{'headers'} = $OtherHeaders;
160 # order output for database entry: fill @SQLBindVars
161 print "-------------- Next entry:\n" if $OptDebug;
163 foreach (@DBFields) {
164 if (defined($Headers{$_}) and $Headers{$_} ne '') {
165 push (@SQLBindVars,$Headers{$_});
166 printf ("FOUND: %s -> %s\n",$_,$Headers{$_}) if $OptDebug;
168 push (@SQLBindVars,undef);
172 # write data to DBTableParse
174 print "-------------- Writing data ... -------------\n" if $OptDebug;
176 $DBHandle->prepare(sprintf("INSERT INTO %s.%s (%s) VALUES (%s)",
178 $Conf{'DBTableParse'},
179 # get field names from @DBFields
180 join(', ',@DBFields),
181 # create a list of '?' for each DBField
183 split(/ /,'? ' x scalar(@DBFields)))
185 $DBWrite->execute(@SQLBindVars)
186 or &Bleat(2,sprintf("Can't write parsed data for %s to %s.%s: ".
187 "$DBI::errstr\n",$Period,
188 $Conf{'DBDatabase'},$Conf{'DBTableParse'}));
195 $DBHandle->disconnect;
197 print "------------------- DONE! -------------------\n" if $OptDebug;
200 ################################ Documentation #################################
204 parsedb - parse raw data and save it to a database
208 B<parsedb> [B<-Vht>] [B<--day> I<YYYY-MM-DD> | I<YYYY-MM-DD:YYYY-MM-DD>] [B<--rawdb> I<database table>] [B<--parsedb> I<database table>] [B<--conffile> I<filename>] [B<--debug>]
226 =item B<-V>, B<--version>
228 Print out version and copyright information and exit.
230 =item B<-h>, B<--help>
232 Print this man page and exit.
236 Output (rather much) debugging information to STDOUT while processing.
238 =item B<-t>, B<--test>
240 Do not write results to database. You should use B<--debug> in
241 conjunction with B<--test> ... everything else seems a bit pointless.
243 =item B<-d>, B<--day> I<YYYY-MM-DD[:YYYY-MM-DD]>
245 Set processing period to a single day in YYYY-MM-DD format or to a time
246 period between two days in YYYY-MM-DD:YYYY-MM-DD format (two days, separated
249 Defaults to yesterday.
251 =item B<--rawdb> I<table> (raw data table)
253 Override I<DBTableRaw> from F<newsstats.conf>.
255 =item B<--parsedb> I<table> (parsed data table)
257 Override I<DBTableParse> from F<newsstats.conf>.
259 =item B<--conffile> I<filename>
261 Load configuration from I<filename> instead of F<newsstats.conf>.
277 =item F<bin/parsedb.pl>
281 =item F<lib/NewsStats.pm>
283 Library functions for the NewsStats package.
285 =item F<etc/newsstats.conf>
287 Runtime configuration file.
293 Please report any bugs or feature requests to the author or use the
294 bug tracker at L<http://bugs.th-h.de/>!
310 This script is part of the B<NewsStats> package.
314 Thomas Hochstein <thh@inter.net>
316 =head1 COPYRIGHT AND LICENSE
318 Copyright (c) 2013 Thomas Hochstein <thh@inter.net>
320 This program is free software; you may redistribute it and/or modify it
321 under the same terms as Perl itself.