File Coverage

blib/lib/Log/Agent/Rotate.pm

Criterion	Covered	Total	%
statement	26	41	63.4
branch	3	18	16.6
condition			n/a
subroutine	13	14	92.8
pod	8	11	72.7
total	50	84	59.5

###########################################################################
#
# Rotate.pm
#
# Copyright (c) 2000 Raphael Manfredi.
# Copyright (c) 2002-2015 Mark Rogaski, [e-mail];
# all rights reserved.
#
# See the README file included with the
# distribution for license information.
#
###########################################################################

use strict;

###########################################################################
package Log::Agent::Rotate;

use Getargs::Long qw(ignorecase);

#
# File rotating policy
#

our $VERSION = "1.200";
$VERSION = eval $VERSION;

use constant {
    BACKLOG     => 0,
    UNZIPPED    => 1,
    MAX_SIZE    => 2,
    MAX_WRITE   => 3,
    MAX_TIME    => 4,
    IS_ALONE    => 5,
    SINGLE_HOST => 6,
    FILE_PERM   => 7,
};

#
# ->make
#
# Creation routine.
#
# Attributes:
#   backlog       amount of old files to keep (0 for none)
#   unzipped      amount of old files to NOT compress (defaults to 1)
#   max_size      maximum amount of bytes in file
#   max_write     maximum amount of bytes to write in file
#   max_time      maximum amount of time to keep open
#   is_alone      hint: only one instance is busy manipulating the logfiles
#   single_host   hint: access to logfiles always made via one host
#
sub make {
    my $self = bless [], shift;

    (
        $self->[BACKLOG],
        $self->[UNZIPPED],
        $self->[MAX_SIZE],
        $self->[MAX_WRITE],
        $self->[MAX_TIME],
        $self->[IS_ALONE],
        $self->[SINGLE_HOST],
        $self->[FILE_PERM]
    ) = xgetargs(@_,
        -backlog        => ['i', 7],
        -unzipped       => ['i', 1],
        -max_size       => ['i', 1_048_576],
        -max_write      => ['i', 0],
        -max_time       => ['s', "0"],
        -is_alone       => ['i', 0],
        -single_host    => ['i', 0],
        -file_perm      => ['i', 0666]
    );

    $self->[MAX_TIME] = seconds_in_period($self->[MAX_TIME])
            if $self->[MAX_TIME];

    return $self;
}

#
# seconds_in_period
#
# Converts a period into a number of seconds.
#
sub seconds_in_period {
    my ($p) = @_;

    $p =~ s|^(\d+)||;
    my $base = int($1); # Number of elementary periods
    my $u = "s";        # Default Unit
    $u = substr($1, 0, 1) if $p =~ /^\s*(\w+)$/;
    my $sec;

    if ($u eq 'm') {
        $sec = 60;              # One minute = 60 seconds
    } elsif ($u eq 'h') {
        $sec = 3600;            # One hour = 3600 seconds
    } elsif ($u eq 'd') {
        $sec = 86400;           # One day = 24 hours
    } elsif ($u eq 'w') {
        $sec = 604800;          # One week = 7 days
    } elsif ($u eq 'M') {
        $sec = 2592000;         # One month = 30 days
    } elsif ($u eq 'y') {
        $sec = 31536000;        # One year = 365 days
    } else {
        $sec = 1;               # Unrecognized: defaults to seconds
    }

    return $base * $sec;
}

#
# Attribute access
#

sub backlog     { $_[0]->[BACKLOG] }
sub unzipped    { $_[0]->[UNZIPPED] }
sub max_size    { $_[0]->[MAX_SIZE] }
sub max_write   { $_[0]->[MAX_WRITE] }
sub max_time    { $_[0]->[MAX_TIME] }
sub is_alone    { $_[0]->[IS_ALONE] }
sub single_host { $_[0]->[SINGLE_HOST] }
sub file_perm   { $_[0]->[FILE_PERM] }

#
# There's no set_xxx() routines: those objects are passed by reference and
# never "expanded", i.e. passed by copy.  Modifying any of the attributes
# would then lead to strange effects.
#

#
# ->is_same
#
# Compare settings of $self with that of $other
#
sub is_same {
    my $self = shift;
    my ($other) = @_;
    for (my $i = 0; $i < @$self; $i++) {
        return 0 if $self->[$i] != $other->[$i];
    }
    return 1;
}

1;        # for require
__END__