File Coverage

blib/lib/Log/Dispatch/File/Stamped.pm

Criterion	Covered	Total	%
statement	60	60	100.0
branch	9	12	75.0
condition	3	3	100.0
subroutine	15	15	100.0
pod	1	1	100.0
total	88	91	96.7

use strict;
use warnings;
# vim: set ts=8 sts=4 sw=4 tw=115 et :
# ABSTRACT: Logging to date/time stamped files
# KEYWORDS: log logging output file timestamp date rolling rotate

our $VERSION = '0.20';

use File::Basename        qw(fileparse);
use File::Spec::Functions qw(catfile);
use POSIX                 qw(strftime);

use Log::Dispatch::File 2.38;
use parent 'Log::Dispatch::File';

use Params::ValidationCompiler qw(validation_for);

use Specio::Library::Builtins;
use Specio::Library::String;
use Specio::Declare;

use namespace::clean 0.19;

enum(
    'TimeFunctions',
    values => [qw(localtime gmtime)],
);

{
    my $self = shift;

    $self->SUPER::_basic_init(@_);

    my $validator = validation_for(
        params => {
            stamp_fmt => {
                type => t('SimpleStr'),
                default => '%Y%m%d',
            },
            stamp_sep => {
                type => t('SimpleStr'),
                default => '-',
            },
            time_function => {
                type => t('TimeFunctions'),
                default => 'localtime',
            },
        },
        slurpy => 1,
    );
    my %p = $validator->(@_);

    $self->{stamp_fmt} = $p{stamp_fmt};
    $self->{stamp_sep} = $p{stamp_sep};
    $self->{time_function} = $p{time_function};

    # cache of last timestamp used
    $self->{_stamp} = '';
    $self->{_time} = 0;

    # split pathname into basename, path, extension
    @$self{qw(_name _path _ext)} = fileparse($self->{filename}, '\.[^.]+');

    # stored in $self->{filename} (overwrites original); used by _open_file()
    $self->_make_filename;
}

{
    my $self = shift;

    # re-use last filename if the time has not changed
    my $time = time();
    return $self->{filename} if $time eq $self->{_time};

    $self->{_time} = $time;
    my $stamp = strftime($self->{stamp_fmt}, $self->{time_function} eq 'localtime' ? localtime : gmtime);

    # re-use last filename if the stamp has not changed
    return $self->{filename} if $stamp eq $self->{_stamp};

    $self->{filename} = catfile(
        $self->{_path},
        join($self->{stamp_sep}, $self->{_name}, $stamp) . ($self->{_ext} ? $self->{_ext} : '')
    );
}

{
    my $self = shift;

    # check if the filename is the same as last time...
    my $old_filename = $self->{filename};
    $self->_make_filename;

    # don't re-open if we use close-after-write - the superclass will do it
    if (not $self->{ Log::Dispatch->VERSION >= '2.59' ? 'close_after_write' : 'close' }
            and $old_filename ne $self->{filename})
    {
        $self->_open_file;
    }

    $self->SUPER::log_message(@_);
}

1;


=pod

=encoding UTF-8

=head1 NAME

Log::Dispatch::File::Stamped - Logging to date/time stamped files

=head1 VERSION

version 0.20

=head1 SYNOPSIS

  use Log::Dispatch::File::Stamped;

  my $file = Log::Dispatch::File::Stamped->new(
    name      => 'file1',
    min_level => 'info',
    filename  => 'Somefile.log',
    stamp_fmt => '%Y%m%d',
    stamp_sep => ':',
    time_function => 'localtime',
    mode      => 'append',
  );

  $file->log( level => 'emerg', message => "I've fallen and I can't get up\n" );

=head1 DESCRIPTION

This module subclasses L<Log::Dispatch::File> for logging to date/time-stamped
files, respecting all its configuration options. As with other L<Log::Dispatch>
handlers, the destination file is kept open for as long as the filename remains
constant (unless C<close_after_write> is set).

=head1 METHODS

=head2 new(%p)

This method takes the same set of parameters as L<Log::Dispatch::File::new()|Log::Dispatch::File/new>,
with the following differences:

=over 4

=item * filename ($)

The filename template. The actual timestamp will be appended to this filename
when creating the actual logfile. If the filename has an extension, the
timestamp is inserted before the extension. See examples below.

=item * stamp_fmt ($)

The format of the timestamp string. This module uses L<POSIX::strftime|POSIX/strftime> to
create the timestamp string from the current local date and time.
Refer to your platform's C<strftime> documentation for the list of allowed
tokens.

Defaults to C<%Y%m%d>.

=item * stamp_sep ($)

The separator character(s) used between components in the log filename.

Defaults to C<->.

=item * time_function ($)

The function used to determine the current time; present choices are L<perlfunc/localtime> or
L<perlfunc/gmtime>. Defaults to C<localtime>.

=back

=head2 log_message( message => $ )

Sends a message to the appropriate output.  Generally this
shouldn't be called directly but should be called through the
C<log()> method (in L<Log::Dispatch::Output>).

=head1 EXAMPLES

=for stopwords txt

Assuming the current date and time is:

  % perl -e 'print scalar localtime'
  Sat Feb  8 13:56:13 2003

  Log::Dispatch::File::Stamped->new(
    name      => 'file',
    min_level => 'debug',
    filename  => 'logfile.txt',
  );

This will log to file F<logfile-20030208.txt>.

  Log::Dispatch::File::Stamped->new(
    name      => 'file',
    min_level => 'debug',
    filename  => 'logfile.txt',
    stamp_fmt => '%d%H',
  );

This will log to file F<logfile-0813.txt>.

=head1 SEE ALSO

=over 4

=item *

L<Log::Dispatch::File>

=item *

L<POSIX>

=item *

L<Log::Dispatch::File::Rolling>

=item *

L<Log::Dispatch::FileRotate>

=item *

L<Log::Dispatch::FileWriteRotate>

=back

=head1 ACKNOWLEDGEMENTS

=for stopwords Rolsky

Dave Rolsky, author of the L<Log::Dispatch> suite and many other
fine modules on CPAN.

This module was rewritten to respect all present (and future) options to
L<Log::Dispatch::File> by Karen Etheridge, <[e-mail]>.

=head1 SUPPORT

Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Log-Dispatch-File-Stamped>
(or L<[e-mail]|mailto:[e-mail]>).

=head1 AUTHORS

=over 4

=item *

Eric Cholet <[e-mail]>

=item *

Karen Etheridge <[e-mail]>

=back

=head1 CONTRIBUTOR

=for stopwords Sven Willenbuecher

Sven Willenbuecher <[e-mail]>

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2003 by Eric Cholet and Karen Etheridge.

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

=cut