File Coverage

blib/lib/Log/Agent/Channel/Handle.pm

Criterion	Covered	Total	%
statement	32	35	91.4
branch	6	12	50.0
condition			n/a
subroutine	6	7	85.7
pod	4	4	100.0
total	48	58	82.7

###########################################################################
#
#   Handle.pm
#
#   Copyright (C) 1999 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;
require Log::Agent::Channel;
require Log::Agent::Prefixer;
require Log::Agent::File::Native;

########################################################################
package Log::Agent::Channel::Handle;

use vars qw(@ISA);

@ISA = qw(Log::Agent::Channel Log::Agent::Prefixer);

use Log::Agent::Stamping;

#
# ->make			-- defined
#
# Creation routine.
#
# Attributes (and switches that set them):
#
# prefix		the application name
# stampfmt		stamping format ("syslog", "date", "own", "none") or closure
# showpid		whether to show pid after prefix in []
# handle		I/O glob or IO::Handle object
# no_ucfirst    don't capitalize first letter of message when no prefix
# no_prefixing  don't prefix logs
# no_newline	never append any newline character at the end of messages
#
# Other attributes:
#
# crlf          the new-line marker for this OS ("\n" on UNIX)
#
sub make {
	my $self = bless {}, shift;
	my (%args) = @_;

	my %set = (
		-prefix			=> \$self->{'prefix'},
		-stampfmt		=> \$self->{'stampfmt'},
		-showpid		=> \$self->{'showpid'},
		-handle			=> \$self->{'handle'},
		-no_ucfirst		=> \$self->{'no_ucfirst'},
		-no_prefixing	=> \$self->{'no_prefixing'},
		-no_newline		=> \$self->{'no_newline'},
	);

	while (my ($arg, $val) = each %args) {
		my $vset = $set{lc($arg)};
		unless (ref $vset) {
			require Carp;
			Carp::croak("Unknown switch $arg");
		}
		$$vset = $val;
	}

	#
	# Initialize proper time-stamping routine.
	#

	$self->{'stampfmt'} = stamping_fn($self->stampfmt)
		unless ref $self->stampfmt eq 'CODE';

	$self->{'crlf'} = $^O =~ /^dos|win/i ? "\r\n" : "\n";

	return $self;
}

#
# Local attribute access
#

sub handle			{ $_[0]->{'handle'} }

#
# ->write			-- defined
#
# Write logstring to the file.
# Priority is ignored by this channel.
#
sub write {
	my $self = shift;
	my ($priority, $logstring) = @_;

	#
	# This routine is called often...
	# Bypass the attribute access routines.
	#

	my $handle = $self->{handle};
	return unless defined $handle;

	my $prefix = '';
	$prefix = $self->prefixing_string(\$logstring)
		unless $self->{no_prefixing};

	my $crlf = '';
	$crlf = $self->{crlf} unless $self->{no_newline};

	print $handle join '', $prefix, $logstring, $crlf;

	return;
}

#
# ->close			-- defined
#
#
sub close {
	my $self = shift;
	$self->{handle} = undef;

	#
	# Do nothing on the handle itself.
	# We did not open the thing, we don't get to close it.
	#

	return;
}

1;	# for require
__END__