Fix some whitespace.
[usenet/newsstats.git] / bin / feedlog.pl
1 #! /usr/bin/perl
2 #
3 # feedlog.pl
4 #
5 # This script will log headers and other data to a database
6 # for further analysis by parsing a feed from INN.
7 #
8 # It is part of the NewsStats package.
9 #
10 # Copyright (c) 2010-2013 Thomas Hochstein <thh@inter.net>
11 #
12 # It can be redistributed and/or modified under the same terms under
13 # which Perl itself is published.
14
15 BEGIN {
16   our $VERSION = "0.01";
17   use File::Basename;
18   # we're in .../bin, so our module is in ../lib
19   push(@INC, dirname($0).'/../lib');
20 }
21 use strict;
22 use warnings;
23
24 use NewsStats;
25
26 use Sys::Syslog qw(:standard :macros);
27
28 use Date::Format;
29 use DBI;
30 use Getopt::Long qw(GetOptions);
31 Getopt::Long::config ('bundling');
32
33 ################################# Subroutines ##################################
34
35 sub PrepareDB {
36 ### initialise database connection, prepare statement
37 ### and catch errors
38 ### IN : \%Conf   : reference to configuration hash
39 ### OUT: $DBHandle: database handle
40 ###      $DBQuery : prepared statement
41   our ($DBHandle, $DBQuery, $OptQuiet);
42   my ($ConfigR) = @_;
43   my %Conf = %$ConfigR;
44   # drop current database connection - hard, if necessary
45   if ($DBHandle) {
46     $DBHandle->disconnect;
47     undef $DBHandle;
48   };
49   # connect to database; try again every 5 seconds
50   while (!$DBHandle) {
51     $DBHandle = InitDB($ConfigR,0);
52     if (!$DBHandle) {
53       syslog(LOG_CRIT, 'Database connection failed: %s', $DBI::errstr);
54       sleep(5);
55     } else {;
56       syslog(LOG_NOTICE, "Database connection (re-)established successfully.") if !$OptQuiet;
57     }
58   };
59   $DBQuery = $DBHandle->prepare(sprintf("INSERT INTO %s.%s (day,date,mid,
60                                          timestamp,token,size,peer,path,
61                                          newsgroups,headers)
62                                          VALUES (?,?,?,?,?,?,?,?,?,?)",
63                                          $Conf{'DBDatabase'},
64                                          $Conf{'DBTableRaw'}));
65   return ($DBHandle,$DBQuery);
66 }
67
68
69 ################################# Main program #################################
70
71 ### read commandline options
72 my ($OptDebug,$OptQuiet);
73 GetOptions ('d|debug!'        => \$OptDebug,
74             'q|test!'         => \$OptQuiet,
75             'h|help'          => \&ShowPOD,
76             'V|version'       => \&ShowVersion) or exit 1;
77
78 ### read configuration
79 my %Conf = %{ReadConfig('')};
80
81 ### init syslog
82 openlog($0, 'nofatal,pid', LOG_NEWS);
83 syslog(LOG_NOTICE, "$MyVersion starting up.") if !$OptQuiet;
84
85 ### init database
86 my ($DBHandle,$DBQuery) = PrepareDB(\%Conf);
87
88 ### main loop
89 while (<>) {
90   chomp;
91   # catch empty lines trailing or leading
92   if ($_ eq '') {
93     next;
94   }
95   # first line contains: mid, timestamp, token, size, peer, Path, Newsgroups
96   my ($Mid, $Timestamp, $Token, $Size, $Peer, $Path, $Newsgroups) = split;
97   # remaining lines contain headers
98   my $Headers = "";
99   while (<>) {
100     chomp;
101     # empty line terminates this article
102     if ($_ eq '') {
103       last;
104     }
105     # collect headers
106     $Headers .= $_."\n" ;
107   }
108
109   # parse timestamp to day (YYYY-MM-DD) and to MySQL timestamp
110   my $Day  = time2str("%Y-%m-%d", $Timestamp);
111   my $Date = time2str("%Y-%m-%d %H:%M:%S", $Timestamp);
112
113   # write to database
114   if (!$DBQuery->execute($Day, $Date, $Mid, $Timestamp, $Token, $Size, $Peer,
115                          $Path, $Newsgroups, $Headers)) {
116     syslog(LOG_ERR, 'Database error %s while processing %s: %s',
117            $DBI::err, $Mid, $DBI::errstr);
118     # if "MySQL server has gone away", try to recover
119     if ($DBI::err == 2006) {
120       # try to reconnect to database
121       ($DBHandle,$DBQuery) = PrepareDB(\%Conf);
122       # try to repeat the write attempt as before
123       if (!$DBQuery->execute($Day, $Date, $Mid, $Timestamp, $Token, $Size, $Peer,
124                              $Path, $Newsgroups, $Headers)) {
125         syslog(LOG_ERR, '%s was dropped and lost.',$Mid);
126       };
127     # otherwise log missing posting
128     } else {
129       syslog(LOG_ERR, '%s was dropped and lost.',$Mid);
130     };
131   };
132   $DBQuery->finish;
133   
134   warn sprintf("-----\nDay: %s\nDate: %s\nMID: %s\nTS: %s\nToken: %s\n".
135                "Size: %s\nPeer: %s\nPath: %s\nNewsgroups: %s\nHeaders: %s\n",
136                $Day, $Date, $Mid, $Timestamp, $Token, $Size, $Peer, $Path,
137                $Newsgroups, $Headers) if $OptDebug;
138 }
139
140 ### close handles
141 $DBHandle->disconnect;
142 syslog(LOG_NOTICE, "$0 closing down.") if !$OptQuiet;
143 closelog();
144
145 __END__
146
147 ################################ Documentation #################################
148
149 =head1 NAME
150
151 feedlog - log data from an INN feed to a database
152
153 =head1 SYNOPSIS
154
155 B<feedlog> [B<-Vhdq>]
156
157 =head1 REQUIREMENTS
158
159 See L<doc/README>.
160
161 =head1 DESCRIPTION
162
163 This script will log overview data and complete headers to a database
164 table for further examination by parsing a feed from INN. It will
165 parse that information and write it to a mysql database table in real
166 time.
167
168 All reporting is done to I<syslog> via I<news> facility. If B<feedlog>
169 fails to initiate a database connection at startup, it will log to
170 I<syslog> with I<CRIT> priority and go in an endless loop, as
171 terminating would only result in a rapid respawn.
172
173 =head2 Configuration
174
175 B<feedlog> will read its configuration from F<newsstats.conf> which
176 should be present in the same directory via Config::Auto.
177
178 See L<doc/INSTALL> for an overview of possible configuration options.
179
180 =head1 OPTIONS
181
182 =over 3
183
184 =item B<-V>, B<--version>
185
186 Print out version and copyright information and exit.
187
188 =item B<-h>, B<--help>
189
190 Print this man page and exit.
191
192 =item B<-d>, B<--debug>
193
194 Output debugging information to STDERR while parsing STDIN. You'll
195 find that information most probably in your B<INN> F<errlog> file.
196
197 =item B<-q>, B<--quiet>
198
199 Suppress logging to syslog.
200
201 =back
202
203 =head1 INSTALLATION
204
205 See L<doc/INSTALL>.
206
207 =head1 EXAMPLES
208
209 Set up a feed like that in your B<INN> F<newsfeeds> file:
210
211     ## gather statistics for NewsStats
212     newsstats!
213             :!*,de.*
214             :Tc,WmtfbsPNH,Ac:/path/to/feedlog.pl
215
216 See L<doc/INSTALL> for further information.
217
218 =head1 FILES
219
220 =over 4
221
222 =item F<bin/feedlog.pl>
223
224 The script itself.
225
226 =item F<lib/NewsStats.pm>
227
228 Library functions for the NewsStats package.
229
230 =item F<etc/newsstats.conf>
231
232 Runtime configuration file.
233
234 =back
235
236 =head1 BUGS
237
238 Please report any bugs or feature requests to the author or use the
239 bug tracker at L<http://bugs.th-h.de/>!
240
241 =head1 SEE ALSO
242
243 =over 2
244
245 =item -
246
247 L<doc/README>
248
249 =item -
250
251 L<doc/INSTALL>
252
253 =back
254
255 This script is part of the B<NewsStats> package.
256
257 =head1 AUTHOR
258
259 Thomas Hochstein <thh@inter.net>
260
261 =head1 COPYRIGHT AND LICENSE
262
263 Copyright (c) 2010-2012 Thomas Hochstein <thh@inter.net>
264
265 This program is free software; you may redistribute it and/or modify it
266 under the same terms as Perl itself.
267
268 =cut
This page took 0.016311 seconds and 3 git commands to generate.