File Coverage

blib/lib/Log/Procmail.pm

Criterion	Covered	Total	%
statement	109	110	99.0
branch	45	52	86.5
condition	7	9	77.7
subroutine	19	19	100.0
pod	6	6	100.0
total	186	196	94.9

package Log::Procmail;
$Log::Procmail::VERSION = '0.13';
require 5.005;
use strict;
use IO::File;
use IO::Select;
use Carp;
use UNIVERSAL ();

use vars qw/ $VERSION /;
local $^W = 1;

$VERSION = '0.12';

my %month;
@month{qw/ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec /} = ( 0 .. 11 );

my $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)/;

sub new {
    my $class = shift;
    return bless {
        fh     => new IO::File,
        files  => [@_],
        errors => 0,
        buffer => [],
    }, $class;
}

sub next {
    my $log = shift;    # who needs $self?

    # try to read a record (3 lines)
    my $fh  = $log->fh();
  READ:
    {
        my $read;

        # ensure we can read past the previous end of file
        $fh->clearerr if $fh->eof;
      LINE:
        while (<$fh>) {
            $read++;

            # should carp if doesn't get what's expected
            # (From, then Subject, then Folder)

            # From create a new Abstract
            /^From (.+?) +($DATE)$/o && do {
                push @{$log->{buffer}}, Log::Procmail::Abstract->new();

                # assert: $read == 1;
                $log->{buffer}[-1]->from($1);
                $log->{buffer}[-1]->date($2);

                # return ASAP
                last READ if @{$log->{buffer}} > 1;
                next LINE;
            };

            # assert: $read == 2;
            /^ Subject: (.*)/i && do {
                push @{$log->{buffer}}, Log::Procmail::Abstract->new()
                    unless @{$log->{buffer}};
                $log->{buffer}[0]->subject($1);
                next LINE;
            };

            # procmail tabulates with tabs and spaces... :-(
            # assert: $read == 3;
            # Folder means the end of this record
            /^  Folder: (.*?)\s+(\d+)$/ && do {
                push @{$log->{buffer}}, Log::Procmail::Abstract->new()
                  unless @{$log->{buffer}};

                # assert: $read == 3;
                $log->{buffer}[0]->folder($1);
                $log->{buffer}[0]->size($2);
                last READ;
            };

            # fall through: some error message
            # shall we ignore it?
            next LINE unless $log->{errors};

            # or return it?
            chomp;
            push @{$log->{buffer}}, $_;
            last LINE;
        }

        # in case we couldn't read the first line
        if ( !$read or @{$log->{buffer}} == 0 ) {

            # return ASAP
            last READ if @{$log->{buffer}};

            # go to next file
            redo READ if $log->_open_next;

            # unless it's the last one
            return;
        }
    }

    # we have an abstract
    my $rec = shift @{$log->{buffer}};
    if(UNIVERSAL::isa( $rec, 'Log::Procmail::Abstract')) {
        # the folder field is required
        goto READ unless defined $rec->folder;
        $rec->{source} = $log->{source};
    }

    return $rec;
}

sub push {
    my $log = shift;
    push @{ $log->{files} }, @_;
}

sub errors {
    my $self = shift;
    return @_ ? $self->{errors} = shift() : $self->{errors};
}

sub fh {
    my $log = shift;
    $log->_open_next unless $log->{fh}->opened();
    return $log->{fh};
}

sub select {
    my $log = shift;
    $log->fh(); # make sure the file is correctly opened and select is updated
    return $log->{select};
}

# *internal method*
# opens a file or replace the old filehandle by the new one
# push() can therefore accept refs to typeglobs, IO::Handle, or filenames
sub _open_next {
    my ( $log ) = @_;
    my $file;

    if ( @{ $log->{files} } ) {
        $file = shift @{ $log->{files} };
    } else { return 0 };

    if ( ref $file eq 'GLOB' ) {
        $log->{fh} = *$file{IO};
        carp "Closed filehandle $log->{fh}" unless $log->{fh}->opened;
    }
    elsif ( ref $file && $file->isa('IO::Handle') ) {
        $log->{fh} = $file;
    }
    else {
        $log->{fh}->open($file) or carp "Can't open $file: $!";
    }
    $log->{source} = $file;
    $log->{select} = ( grep $^O eq $_, qw(MSWin32 NetWare dos VMS riscos beos) )
                   ? undef
                   : IO::Select->new( $log->{fh} );
    1;
}

sub DESTROY {
    my $self = shift;
    if ( $self->{fh} && $self->{fh}->opened ) { $self->{fh}->close }
}

#
# a small class for the abstracts themselves
#
package Log::Procmail::Abstract;
$Log::Procmail::Abstract::VERSION = '0.13';
use Carp;

sub new {
    my $class = shift;
    return bless {@_}, $class;
}

for my $attr (qw( from date subject size folder source ) ) {
    no strict 'refs';
    *$attr = sub {
        my $self = shift;
        @_ ? $self->{$attr} = shift: $self->{$attr};
    }
}

sub ymd {
    my $self = shift;
    croak("Log::Procmail::Abstract::ymd cannot be used to set the date")
      if @_;
    return undef unless defined $self->{date};
    $self->{date} =~ /^$DATE$/o;
    return undef unless $1;
    return sprintf( "%04d%02d%02d$3$4$5", $6, $month{$1} + 1, $2 );
}

1;

__END__