File Coverage

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

Criterion	Covered	Total	%
statement	81	84	96.4
branch	9	12	75.0
condition	4	9	44.4
subroutine	14	14	100.0
pod	2	2	100.0
total	110	121	90.9

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

use 5.006001;
use strict;
use warnings;

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

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

our $VERSION = '1.04';

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';
	# 'close' mode is always used
	$p{close_after_write} = 1;

	# 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);
		$self->{filename} = $self->_createFilename(0);
	} elsif ($p{filename} =~ /^(.*)(\.[^\.]+)$/) {
		$self->{rolling_filename_prefix}  = $1;
		$self->{rolling_filename_postfix} = $2;
		$self->{rolling_filename_format}  = Log::Log4perl::DateFormat->new('-yyyy-MM-dd-$!');
		$self->{filename} = $self->_createFilename(0);
	} else {
		$self->{rolling_filename_prefix}  = $p{filename};
		$self->{rolling_filename_postfix} = '';
		$self->{rolling_filename_format}  = Log::Log4perl::DateFormat->new('.yyyy-MM-dd-$!');
		$self->{filename} = $self->_createFilename(0);
	}

	$self->_make_handle();

	return $self;
}

sub log_message { # parts borrowed from Log::Dispatch::FileRotate, Thanks!
	my $self = shift;
	my %p = @_;
	my $try = 1;
	my $firstfilename = $self->_createFilename(0); # if this is generated, we are done

	while (defined $try) {
		$self->{filename} = $self->_createFilename($try);

		if (($try > 1 and $firstfilename eq $self->{filename}) or $try < 1) { # later checks for integer overflow
			die 'could not find an unused file for filename "'
			. $self->{filename}
			. '". Did you use "!"?';
		}

		$self->_open_file;
		$self->_lock();
		my $fh = $self->{fh};
		if (not -s $fh) {
			# if the file is zero-sized, it is fresh.
			# else someone else already used it.
			print $fh $p{message};
			$try = undef;
		} else {
			$try++;
		}
		$self->_unlock();
		close($fh);
		$self->{fh} = undef;
	}
}

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;
	my $try = shift;
	return $self->{rolling_filename_prefix}
	     . $self->_format($try)
	     . $self->{rolling_filename_postfix};
}

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

1;
__END__