root/lang/perl/Parse-Syslog-Period/trunk/lib/Parse/Syslog/Period/Parser.pm @ 14835

package Parse::Syslog::Period::Parser;

use strict;
use warnings;
use Carp qw/croak/;
use base qw/ Class::Data::Inheritable Class::Accessor /;
use DateTime;
use Tie::IxHash;
use Path::Class qw(); 
use UNIVERSAL::require;
use Data::Dumper;

our $VERSION = '0.01';

__PACKAGE__->mk_classdata( parse_delay => 10 );

__PACKAGE__->mk_ro_accessors(qw/
    file
    from
    to
    rotate
    rotate_at
    rotate_statefile
    patterned_file
    logfiles
/);


tie( my %macro_map, 'Tie::IxHash' );
%macro_map = (
    '$YEAR'  => { pattern => '%Y', rotate => 'daily'  },
    '$MONTH' => { pattern => '%m', rotate => 'monthly' },  
    '$WEEK'  => { pattern => '%W', rotate => 'weekly' },
    '$DAY'   => { pattern => '%d', rotate => 'daily'  },
    '$HOUR'  => { pattern => '%H', rotate => 'hourly' },
);

my %increment_map = (
    yearly  => { years => 1 },
    monthly => { months=> 1 },
    weekly  => { weeks => 1 },
    daily   => { days  => 1 },
    hourly  => { hours => 1 },
);

sub new {
    my $class = shift;
    my $self = bless $_[0], $class;
    $self->_init;
    return $self;
}

sub _init {
    my $self = shift;
    my $class = ref $self;
    $self->reset;

    $self->{parse_module}->require or croak $@;

    $self->from or croak "required 'from'";
    $self->from->set_time_zone('local');
    DateTime->compare( $self->from, DateTime->now ) == 1
        and croak "'from' must be past from now";
    $self->{from_time} = $self->from->epoch;

    if ( $self->to ) { 
        $self->to->set_time_zone( 'local' );
        DateTime->compare( $self->from, $self->to ) == 1
            and croak "must be future 'to' from 'from'";
        $self->{to_time}    = $self->to->epoch;
        $self->{delayed_to} = $self->to->clone->add( seconds => $class->parse_delay );
        $self->{delayed_to_time} = $self->{delayed_to}->epoch;
    }

    $self->rotate eq 'macro'? $self->set_logfiles_by_macro
                            : $self->set_logfiles_by_legacy;
    return $self;
}

sub reset { 
    my $self = shift;
    $self->{sp}         = undef;
    $self->{exit_flag}  = 0;
    $self->{target_idx} = 0;
    return $self;
}
   
sub set_logfiles_by_macro {
    my $self = shift;

    my $from = $self->from;
    my $to   = $self->{delayed_to} ||= DateTime->now->set_time_zone( 'local' );
    $self->{logfiles} = [];
    $self->{rotate} = undef;
    $self->{patterned_file} = $self->file;

    for my $macro ( keys %macro_map ) {
        my ($pattern, $rotate) = @{ $macro_map{$macro} }{qw/ pattern rotate /};
        $self->{patterned_file} =~ s/\Q$macro\E/$pattern/g
            and $self->{rotate} = $rotate;
    }

    if ( my $rotate = $self->rotate ) {
        my $increment = $increment_map{$rotate};
        ( my $truncate_to = (keys %$increment)[0] ) =~ s/s$//;
        my $rotated_on = $from->clone->truncate( to => $truncate_to );

        while ( DateTime->compare( $rotated_on, $to ) != 1 ) {
            my $logfile = {
                name => $rotated_on->strftime( $self->patterned_file ),
                year => $rotated_on->year, 
            };
            push @{ $self->logfiles }, $logfile;
            $rotated_on->add( $increment );
        }

    } else {
        $self->{logfiles} = [
            {   name => $self->patterned_file,
                year => $from->year,
            },
        ];
   }

    return $self;
}

sub set_logfiles_by_legacy {
    my $self = shift;

    my $from = $self->from;
    my $to   = $self->{delayed_to} ||= DateTime->now->set_time_zone( 'local' );
    $self->{logfiles} = [];

    my $rotate = $self->rotate
        or croak "required rotate";
    ( $rotate =~  /^(monthly|weekly|daily)$/ )
        or croak "illegal rotate type '$rotate'";

    my $at = $self->rotate_at
        or croak "required rotate_at(hour and minute)";
    my ($rotate_hour, $rotate_minute) = @$at{qw/ hour minute /};
    ( $rotate_hour and $rotate_minute )
        or croak "rotate_at must contain hour and minute";

    my ($unit_type) = %{ $increment_map{$rotate} };

    my $last_rotated_date = $self->_parse_rotatestatus(
        $self->file,
        $self->rotate_statefile,
    ); 

    if ( !$last_rotated_date ) {
        $self->{logfiles} = [
            {   name => $self->file,
                year => DateTime->now->set_time_zone( 'local' )->year,
            },
        ];
        return;
    }

    my $last_rotated_on = DateTime->new(
        %{ $last_rotated_date },
        hour      => $rotate_hour,
        minute    => $rotate_minute,
        time_zone => 'local',
    );

    if ( DateTime->compare( $from, $last_rotated_on ) == 1 ) {
        $self->{logfiles} = [
            { name => $self->file,
              year => $last_rotated_on->year,
            },
        ];
        return;
    }

    my $from_dur = $self->_dur_by_unittype( $last_rotated_on, $from, $unit_type );
    my $from_suffix = $from_dur + 1;

    my $to_suffix;
    if ( DateTime->compare( $to, $last_rotated_on ) == 1) {
        $to_suffix = 0;
    } else {
        my $to_dur = $self->_dur_by_unittype( $last_rotated_on, $to, $unit_type );
        $to_suffix = $to_dur + 1;
    }

    my $rotated_on = $last_rotated_on->clone->subtract( $unit_type => $from_dur + 1 );

    for my $num ( reverse $to_suffix .. $from_suffix ) {
        my $name = ( $num == 0 )? $self->file : sprintf( "%s.%d", $self->file, $num );
        my $logfile = {
            name => $name,
            year => $rotated_on->year,
        };
        push @{ $self->logfiles }, $logfile;
        $rotated_on->add( $unit_type => 1 );
    }       
}

sub _dur_by_unittype {
    my ( $self, $dt1, $dt2, $type ) = @_;
    return $type eq 'days'  ? $dt1->delta_days( $dt2 )->in_units( $type )
         : $type eq 'weeks' ? $dt1->delta_days( $dt2 )->in_units( $type )
         : $type eq 'months'? $dt1->delta_md( $dt2 )->in_units( $type )
         :                    croak;
}

sub _parse_rotatestatus {
    my ( $self, $file, $statefile ) = @_;
    $statefile ||= '/var/lib/logrotate.status';
    -f $statefile
        or croak "can't find logrotate statefile. please set rotate_statefile";
    my $state_h = Path::Class::file( $statefile )->open( 'r' ) or croak $!;
    my ( $year, $month, $day );

    while ( my $line = <$state_h> ) {
        chomp $line;
        my ( $name, $status ) = $line =~ /^"(.*?)"[ ](.*)$/mxs;
        ( $name and $status ) or next;
        $name eq $file or next;
        ( $year, $month, $day ) = split "-", $status;
        ( $year and $month and $day )
            or croak "parsing $statefile failed";
        last;
    }

    close $state_h or croak $!;
        
    return {
        year   => $year,
        month  => $month,
        day    => $day,
    };
}

sub next {
    my $self = shift;
    return if $self->{exit_flag};

    while ( my $sp = $self->{sp} ||= $self->get_next_sp ) {
        my $sl = $sp->next or do { undef $self->{sp}; next; };

        ## parse : from_time <= timestamp < delayed_to_time
        ## return: from_time <= timestamp < to_time
        next if $sl->{timestamp} < $self->{from_time};
        return $sl unless $self->{to_time};

        if ( $self->{delayed_to_time} <= $sl->{timestamp} ) {
            $self->{exit_flag} = 1;
            return;
        }
     
        return $sl if $sl->{timestamp} < $self->{to_time};
    }

    return;
}

sub get_next_sp {
    my $self = shift;

    while ( my $logfile = $self->logfiles->[ $self->{target_idx}++ ] ) {
        my ($name, $year) = @$logfile{qw/ name year /};
        next unless -r $name;

        return $self->{parse_module}->new(
            $name,
            year => $year,
            %{ $self->{for_parse_module} },
        );
    }

    return;
}


1;


=head1 NAME

Parse::Syslog::Period::Parser - The great new Parse::Syslog::Period::Parser!

=head1 VERSION

Version 0.01


=head1 SYNOPSIS

Quick summary of what the module does.

Perhaps a little code snippet.

    use Parse::Syslog::Period::Parser;

    my $foo = Parse::Syslog::Period::Parser->new();
    ...

=head1 EXPORT

A list of functions that can be exported.  You can delete this section
if you don't export anything, such as for a purely object-oriented module.

=head1 FUNCTIONS

=head2 function1


=head2 function2


=head1 AUTHOR

ryo kuroda, C<< <lamanotrama at gmail.com> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-parse-syslog-period-parser at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Parse-Syslog-Period>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Parse::Syslog::Period


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Parse-Syslog-Period>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Parse-Syslog-Period>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Parse-Syslog-Period>

=item * Search CPAN

L<http://search.cpan.org/dist/Parse-Syslog-Period>

=back


=head1 ACKNOWLEDGEMENTS


=head1 COPYRIGHT & LICENSE

Copyright 2008 ryo kuroda, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

1; # End of Parse::Syslog::Period::Parser