Log::Dispatch::File::Rolling - Object for logging to date/time/pid

  use Log::Dispatch::File::Rolling;

  my $file = Log::Dispatch::File::Rolling->new(
                             name      => 'file1',
                             min_level => 'info',
                             filename  => 'Somefile%d{yyyyMMdd}.log',
                             mode      => 'append' );

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

  Log::Dispatch::File::Stamped by Eric Cholet <cholet@logilune.com>
  Log::Dispatch::FileRotate by Mark Pfeiffer, <markpf@mlp-consulting.com.au>

## no critic
package Log::Dispatch::File::Rolling;

use 5.006001;
use strict;
use warnings;

use Log::Dispatch::File;
use Log::Log4perl::DateFormat;
use Fcntl ':flock'; # import LOCK_* constants

our @ISA = qw(Log::Dispatch::File);

our $VERSION = '1.06';

our $TIME_HIRES_AVAILABLE = undef;

BEGIN { # borrowed from Log::Log4perl::Layout::PatternLayout, Thanks!
	# Check if we've got Time::HiRes. If not, don't make a big fuss,
	# just set a flag so we know later on that we can't have fine-grained
	# time stamps

	eval { require Time::HiRes; };
	if ($@) {
		$TIME_HIRES_AVAILABLE = 0;
	} else {
		$TIME_HIRES_AVAILABLE = 1;
	}
}

# Preloaded methods go here.

sub new {
	my $proto = shift;
	my $class = ref $proto || $proto;

	my %p = @_;

	my $self = bless {}, $class;

	# only append mode is supported
	$p{mode} = 'append';

	# base class initialization
	$self->_basic_init(%p);

	# split pathname into path, basename, extension
	if ($p{filename} =~ /^(.*)\%d\{([^\}]*)\}(.*)$/) {
		$self->{rolling_filename_prefix}  = $1;
		$self->{rolling_filename_postfix} = $3;
		$self->{rolling_filename_format}  = Log::Log4perl::DateFormat->new($2);
		$p{filename} = $self->_createFilename();
	} elsif ($p{filename} =~ /^(.*)(\.[^\.]+)$/) {
		$self->{rolling_filename_prefix}  = $1;
		$self->{rolling_filename_postfix} = $2;
		$self->{rolling_filename_format}  = Log::Log4perl::DateFormat->new('-yyyy-MM-dd');
		$p{filename} = $self->_createFilename();
	} else {
		$self->{rolling_filename_prefix}  = $p{filename};
		$self->{rolling_filename_postfix} = '';
		$self->{rolling_filename_format}  = Log::Log4perl::DateFormat->new('.yyyy-MM-dd');
		$p{filename} = $self->_createFilename();
	}

	$self->{rolling_fh_pid} = $$;
	$self->_make_handle(%p);

	return $self;
}

sub log_message { # parts borrowed from Log::Dispatch::FileRotate, Thanks!
	my $self = shift;
	my %p = @_;

	my $filename = $self->_createFilename();
	if ($filename ne $self->{filename}) {
		$self->{filename} = $filename;
		$self->{rolling_fh_pid} = 'x'; # force reopen
	}

	if ( $self->{close} ) {
		$self->_open_file;
		$self->_lock();
		my $fh = $self->{fh};
		print $fh $p{message};
		$self->_unlock();
		close($fh);
		$self->{fh} = undef;
	} elsif (defined $self->{fh} and ($self->{rolling_fh_pid}||'') eq $$ and defined fileno $self->{fh}) { # flock won't work after a fork()
		my $inode  = (stat($self->{fh}))[1];         # get real inode
		my $finode = (stat($self->{filename}))[1];   # Stat the name for comparision
		if(!defined($finode) || $inode != $finode) { # Oops someone moved things on us. So just reopen our log
			$self->_open_file;
		}
		$self->_lock();
		my $fh = $self->{fh};
		print $fh $p{message};
		$self->_unlock();
	} else {
		$self->{rolling_fh_pid} = $$;
		$self->_open_file;
		$self->_lock();
		my $fh = $self->{fh};
		print $fh $p{message};
		$self->_unlock();
	}
}

sub _lock { # borrowed from Log::Dispatch::FileRotate, Thanks!
	my $self = shift;
	flock($self->{fh},LOCK_EX);
	# Make sure we are at the EOF
	seek($self->{fh}, 0, 2);
	return 1;
}

sub _unlock { # borrowed from Log::Dispatch::FileRotate, Thanks!
	my $self = shift;
	flock($self->{fh},LOCK_UN);
	return 1;
}

sub _current_time { # borrowed from Log::Log4perl::Layout::PatternLayout, Thanks!
	# Return secs and optionally msecs if we have Time::HiRes
	if($TIME_HIRES_AVAILABLE) {
		return (Time::HiRes::gettimeofday());
	} else {
		return (time(), 0);
	}
}

sub _createFilename {
	my $self = shift;
	return $self->{rolling_filename_prefix}
	     . $self->_format()
	     . $self->{rolling_filename_postfix};
}

sub _format {
	my $self = shift;
	my $result = $self->{rolling_filename_format}->format($self->_current_time());
	$result =~ s/(\$+)/sprintf('%0'.length($1).'.'.length($1).'u', $$)/eg;
	return $result;
}

1;
__END__