1package Log::Procmail; 2 3require 5.005; 4use strict; 5use IO::File; 6use IO::Select; 7use Carp; 8use UNIVERSAL (); 9 10use vars qw/ $VERSION /; 11local $^W = 1; 12 13$VERSION = '0.12'; 14 15my %month; 16@month{qw/ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec /} = ( 0 .. 11 ); 17 18my $DATE = qr/(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun) (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) ([ \d]\d) (\d\d):(\d\d):(\d\d) .*(\d\d\d\d)/; 19 20sub new { 21 my $class = shift; 22 return bless { 23 fh => new IO::File, 24 files => [@_], 25 errors => 0, 26 buffer => [], 27 }, $class; 28} 29 30sub next { 31 my $log = shift; # who needs $self? 32 33 # try to read a record (3 lines) 34 my $fh = $log->fh(); 35 READ: 36 { 37 my $read; 38 39 LINE: 40 while (<$fh>) { 41 $read++; 42 43 # should carp if doesn't get what's expected 44 # (From, then Subject, then Folder) 45 46 # From create a new Abstract 47 /^From (.+?) +($DATE)$/o && do { 48 push @{$log->{buffer}}, Log::Procmail::Abstract->new(); 49 50 # assert: $read == 1; 51 $log->{buffer}[-1]->from($1); 52 $log->{buffer}[-1]->date($2); 53 54 # return ASAP 55 last READ if @{$log->{buffer}} > 1; 56 next LINE; 57 }; 58 59 # assert: $read == 2; 60 /^ Subject: (.*)/i && do { 61 push @{$log->{buffer}}, Log::Procmail::Abstract->new() 62 unless @{$log->{buffer}}; 63 $log->{buffer}[0]->subject($1); 64 next LINE; 65 }; 66 67 # procmail tabulates with tabs and spaces... :-( 68 # assert: $read == 3; 69 # Folder means the end of this record 70 /^ Folder: (.*?)\s+(\d+)$/ && do { 71 push @{$log->{buffer}}, Log::Procmail::Abstract->new() 72 unless @{$log->{buffer}}; 73 74 # assert: $read == 3; 75 $log->{buffer}[0]->folder($1); 76 $log->{buffer}[0]->size($2); 77 last READ; 78 }; 79 80 # fall through: some error message 81 # shall we ignore it? 82 next LINE unless $log->{errors}; 83 84 # or return it? 85 chomp; 86 push @{$log->{buffer}}, $_; 87 last LINE; 88 } 89 90 # in case we couldn't read the first line 91 if ( !$read or @{$log->{buffer}} == 0 ) { 92 93 # return ASAP 94 last READ if @{$log->{buffer}}; 95 96 # go to next file 97 redo READ if $log->_open_next; 98 99 # unless it's the last one 100 return; 101 } 102 } 103 104 # we have an abstract 105 my $rec = shift @{$log->{buffer}}; 106 if(UNIVERSAL::isa( $rec, 'Log::Procmail::Abstract')) { 107 # the folder field is required 108 goto READ unless defined $rec->folder; 109 $rec->{source} = $log->{source}; 110 } 111 112 return $rec; 113} 114 115sub push { 116 my $log = shift; 117 push @{ $log->{files} }, @_; 118} 119 120sub errors { 121 my $self = shift; 122 return @_ ? $self->{errors} = shift() : $self->{errors}; 123} 124 125sub fh { 126 my $log = shift; 127 $log->_open_next unless $log->{fh}->opened(); 128 return $log->{fh}; 129} 130 131sub select { 132 my $log = shift; 133 $log->fh(); # make sure the file is correctly opened and select is updated 134 return $log->{select}; 135} 136 137# *internal method* 138# opens a file or replace the old filehandle by the new one 139# push() can therefore accept refs to typeglobs, IO::Handle, or filenames 140sub _open_next { 141 my ( $log ) = @_; 142 my $file; 143 144 if ( @{ $log->{files} } ) { 145 $file = shift @{ $log->{files} }; 146 } else { return 0 }; 147 148 if ( ref $file eq 'GLOB' ) { 149 $log->{fh} = *$file{IO}; 150 carp "Closed filehandle $log->{fh}" unless $log->{fh}->opened; 151 } 152 elsif ( ref $file && $file->isa('IO::Handle') ) { 153 $log->{fh} = $file; 154 } 155 else { 156 $log->{fh}->open($file) or carp "Can't open $file: $!"; 157 } 158 $log->{source} = $file; 159 $log->{select} = ( grep $^O eq $_, qw(MSWin32 NetWare dos VMS riscos beos) ) 160 ? undef 161 : IO::Select->new( $log->{fh} ); 162 1; 163} 164 165sub DESTROY { 166 my $self = shift; 167 if ( $self->{fh} && $self->{fh}->opened ) { $self->{fh}->close } 168} 169 170# 171# a small class for the abstracts themselves 172# 173package Log::Procmail::Abstract; 174 175use Carp; 176 177sub new { 178 my $class = shift; 179 return bless {@_}, $class; 180} 181 182for my $attr (qw( from date subject size folder source ) ) { 183 no strict 'refs'; 184 *$attr = sub { 185 my $self = shift; 186 @_ ? $self->{$attr} = shift: $self->{$attr}; 187 } 188} 189 190sub ymd { 191 my $self = shift; 192 croak("Log::Procmail::Abstract::ymd cannot be used to set the date") 193 if @_; 194 return undef unless defined $self->{date}; 195 $self->{date} =~ /^$DATE$/o; 196 return undef unless $1; 197 return sprintf( "%04d%02d%02d$3$4$5", $6, $month{$1} + 1, $2 ); 198} 199 2001; 201 202__END__ 203 204=encoding iso-8859-1 205 206=head1 NAME 207 208Log::Procmail - Perl extension for reading procmail logfiles. 209 210=head1 SYNOPSIS 211 212 use Log::Procmail; 213 214 my $log = new Log::Procmail 'procmail.log'; 215 216 # loop on every abstract 217 while(my $rec = $log->next) { 218 # do something with $rec->folder, $rec->size, etc. 219 } 220 221=head1 DESCRIPTION 222 223=head2 Log::Procmail 224 225Log::Procmail reads procmail(1) logfiles and returns the abstracts one by one. 226 227=over 4 228 229=item $log = Log::Procmail->new( @files ); 230 231Constructor for the procmail log reader. Returns a reference to a 232Log::Procmail object. 233 234The constructor accepts a list of file as parameter. This allows you to 235read records from several files in a row: 236 237 $log = Log::Procmail->new( "$ENV{HOME}/.procmail/log.2", 238 "$ENV{HOME}/.procmail/log.1", 239 "$ENV{HOME}/.procmail/log", ); 240 241When $log reaches the end of the file "log", it doesn't close the file. 242So, after B<procmail> processes some incoming mail, the next call to next() 243will return the new records. 244 245=item $rec = $log->next 246 247Return a Log::Procmail::Abstract object that represent an entry in the log 248file. Return undef if there is no record left in the file. 249 250When the Log::Procmail object reaches the end of a file, and this file is 251not the last of the stack, it closes the current file and opens the next 252one. 253 254When it reaches the end of the last file, the file is not closed. Next 255time the record method is called, it will check again in case new abstracts 256were appended. 257 258Procmail(1) log look like the following: 259 260 From karen644552@btinternet.com Fri Feb 8 20:37:24 2002 261 Subject: Stock Market Volatility Beating You Up? (18@2) 262 Folder: /var/spool/mail/book 2840 263 264Some informational messages can be put by procmail(1) in the log file. 265If the C<errors> attribute is true, these lines are returned one at a time. 266 267With errors enabled, you have to check that next() actually returns a 268Log::Procmail::Abstract object. Here is an example: 269 270 $log->errors(1); 271 272 # fetch data 273 while ( $rec = $log->next ) { 274 275 # if it's an error line 276 if ( !ref $rec ) { 277 # this is not a log, but an informational message 278 # do something with it 279 next; 280 } 281 282 # normal log processing 283 } 284 285=item $log->push( $file [, $file2 ...] ); 286 287Push one or more files on top of the list of log files to examine. 288When Log::Procmail runs out of abstracts to return (i.e. it reaches the 289end of the file), it transparently opens the next file (if there is one) 290and keeps returning new abstracts. 291 292=item $log->errors( [bool] ); 293 294Set or get the error flag. If set, when the next() method will return 295the string found in the log file, instead of ignoring it. Be careful: 296it is a simple string, not a Log::Procmail::Abstract object. 297 298Default is to return no error. 299 300=item $fh = $log->fh() 301 302Returns the currently opened filehandle, from which the next call to 303C<next()> will try to read a record. 304 305=item $select = $log->select() 306 307Return a IO::Select object that watches the currently opened filehandle. 308 309B<You are not supposed to use C<add()> or C<remove()> on the returned 310IO::Select object.> 311 312B<Additional warning for C<MSWin32>, C<NetWare>, C<dos>, C<VMS>, C<riscos> 313and C<beos>:> on those systems, C<select()> returns C<undef>. 314(Check F<ext/IO/t/io_sel.t> in the Perl sources for details. 315Hint: look for the message I<4-arg select is only valid on sockets>.) 316 317=back 318 319=head2 Log::Procmail::Abstract 320 321Log::Procmail::Abstract is a class that hold the abstract information. 322Since the abstract hold From, Date, Subject, Folder and Size information, 323all this can be accessed and modified through the from(), date(), subject(), 324folder() and size() methods. 325 326Log::Procmail::next() returns a Log::Procmail::Abstract object. 327 328=over 4 329 330=item Log::Procmail::Abstract accessors 331 332The Log::Procmail::Abstract object accessors are named from(), date(), 333subject(), folder() and size(). They return the relevant information 334when called without argument, and set it to their first argument 335otherwise. 336 337 # count mail received per folder 338 while( $rec = $log->next ) { $folder{ $rec->folder }++ } 339 340The source() accessor returns the name of the log file or the string 341representation of the handle, if a filehandle was given. 342 343=item $rec->ymd() 344 345Return the date in the form C<yyyymmmddhhmmss> where each field is what 346you think it is. C<;-)> This method is read-only. 347 348=back 349 350=head1 EXAMPLES 351 352Here is an example procmail biff-like script, courtesy of Ian Langworth: 353 354 #/usr/bin/perl -w 355 use strict; 356 use Log::Procmail; 357 358 use constant LOGFILE => "$ENV{HOME}/procmail.log"; 359 use constant VALID_FOLDERS => [qw( agent inbox perl systems )]; 360 my $format = "\%8s: \%-30.30s / %s\n"; 361 362 my $log = Log::Procmail->new( LOGFILE ); 363 $log->errors(1); 364 365 while ( $log->select->can_read ) { 366 my $rec = $log->next; 367 368 # error? 369 warn "$rec\n", next unless ref $rec; 370 371 # ignore mailboxes we don't care about 372 next unless grep { $_ eq $rec->folder } @{ VALID_FOLDERS() }; 373 374 # print data 375 printf $format, From => $rec->from; 376 printf $format, Subject => $rec->subject, $rec->folder; 377 } 378 379=head1 TODO 380 381The Log::Procmail object should be able to read from STDIN. 382 383=head1 BUGS 384 385=over 4 386 387=item * 388 389Sometimes procmail(1) logs are mixed up. When this happens, I've chosen 390to accept them the way mailstat(1) does: they are discarded unless they 391have a C<Folder> line. 392 393=item * 394 395If you use Log::Procmail and the select() method to follow a live logfile 396as in the above example, please not that Log::Procmail will not detect 397when the file is rotated. 398 399=back 400 401Please report all bugs through the rt.cpan.org interface: 402 403L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Log-Procmail> 404 405=head1 AUTHOR 406 407Philippe "BooK" Bruhat <book@cpan.org>. 408 409=head1 ACKNOWLEDGMENTS 410 411Thanks to Briac "Oeufmayo" Pilpr� and David "Sniper" Rigaudiere for early 412comments on irc. Thanks to Olivier "rs" Poitrey for giving me his huge 413procmail log file (51 Mb spanning over a two-year period) and for probably 414being the first user of this module. Many thanks to Michael Schwern for 415insisting so much on the importance of tests and documentation. 416 417Many thanks to "Les Mongueurs de Perl" for making cvs.mongueurs.net 418available for Log::Procmail and many other projects. 419 420=head1 COPYRIGHT 421 422Copyright (c) 2002-2013, Philippe Bruhat. All Rights Reserved. 423 424=head1 LICENSE 425 426This module is free software. It may be used, redistributed 427and/or modified under the terms of the Perl Artistic License 428(see http://www.perl.com/perl/misc/Artistic.html) 429 430=head1 SEE ALSO 431 432perl(1), procmail(1). 433 434=cut 435 436