File Coverage

blib/lib/Basset/Logger.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	28	30	93.3
condition	2	2	100.0
subroutine	9	9	100.0
pod	2	3	66.6
total	90	93	96.7

package Basset::Logger;

#Basset::Logger, copyright and (c) 2004, 2006 James A Thomason III
#Basset::Logger is distributed under the terms of the Perl Artistic License.

=pod

=head1 NAME

Basset::Logger - Logger object. Writes things to files.

=head1 AUTHOR

Jim Thomason, [e-mail]

=head1 DESCRIPTION

my $logger = Basset::Logger->new(
	'handle' => '/tmp/weasels.log'
);

$logger->log("Weasels in the hen house!");

$logger->close();

Create a logger object, then log data to it, then close it when you're done. Easy as pie.
Works beautifully in conjunction with Basset::NotificationCenter.

You will B to put a types entry into your conf file for

 logger=Basset::Logger

(or whatever center you're using)

=cut


$VERSION = '1.01';

use Basset::Object;
our @ISA = Basset::Object->pkg_for_type('object');

use strict;
use warnings;

=pod

=head1 ATTRIBUTES

=over

=item handle

The place you log to. Either a string (which will be opened in append mode) or a globref.

 $logger->handle('/path/to/log.log');
 open (LOG, ">>/path/to/log.log");
 $logger->handle(\*LOG);

=cut

__PACKAGE__->add_attr(['handle', '_isa_file_accessor']);

=pod

=begin btest handle

my $o = __PACKAGE__->new();
$test->ok($o, "Got object for handle");
$test->is(scalar($o->handle($o)), undef, "Cannot set handle to unknown reference");
$test->is($o->errcode, "BL-03", "proper error code");

local $@ = undef;
eval "use File::Temp";
my $file_temp_exists = $@ ? 0 : 1;

if ($file_temp_exists) {
	my $temp = File::Temp->new;
	my $name = $temp->filename;
	$test->is(ref($o->handle($name)), 'GLOB', "created glob");
	open (my $glob, $name);
	$test->is($o->handle($glob), $glob, "set glob");
	chmod 000, $name;
	$test->is(scalar($o->handle($name)), undef, "could not set handle to unwritable file");
	$test->is($o->errcode, "BL-01", "proper error code");
}

=end btest

=cut


=pod

=item closed

=cut

__PACKAGE__->add_attr('closed');

=pod

=begin btest closed

{
	my $o = __PACKAGE__->new();
	$test->ok($o, "Got object");
	$test->is(scalar(__PACKAGE__->closed), undef, "could not call object method as class method");
	$test->is(__PACKAGE__->errcode, "BO-08", "proper error code");
	$test->is(scalar($o->closed), 0, 'closed is 0 by default');
	$test->is($o->closed('abc'), 'abc', 'set closed to abc');
	$test->is($o->closed(), 'abc', 'read value of closed - abc');
	my $h = {};
	$test->ok($h, 'got hashref');
	$test->is($o->closed($h), $h, 'set closed to hashref');
	$test->is($o->closed(), $h, 'read value of closed  - hashref');
	my $a = [];
	$test->ok($a, 'got arrayref');
	$test->is($o->closed($a), $a, 'set closed to arrayref');
	$test->is($o->closed(), $a, 'read value of closed  - arrayref');
}

my $o = __PACKAGE__->new();
$test->ok($o, "got object");
$test->is($o->close, 1, "closing non-existent handle is fine");
$test->is($o->closed, 0, "handle remains open");

local $@ = undef;
eval "use File::Temp";
my $file_temp_exists = $@ ? 0 : 1;

if ($file_temp_exists) {
	my $temp = File::Temp->new;
	my $name = $temp->filename;
	$test->is(ref($o->handle($name)), 'GLOB', "created glob");
	$test->is($o->closed, 0, "file handle is open");
	$test->is($o->close, 1, "closed file handle");
	$test->is($o->closed, 1, "filehandle is closed");
}

=end btest

=cut


=pod

=item stamped

=cut

__PACKAGE__->add_attr('stamped');

=pod

=begin btest stamped

my $o = __PACKAGE__->new();
$test->ok($o, "Got object");
$test->is(scalar(__PACKAGE__->stamped), undef, "could not call object method as class method");
$test->is(__PACKAGE__->errcode, "BO-08", "proper error code");
$test->is(scalar($o->stamped), 1, 'stamped is 1 by default');
$test->is($o->stamped('abc'), 'abc', 'set stamped to abc');
$test->is($o->stamped(), 'abc', 'read value of stamped - abc');
my $h = {};
$test->ok($h, 'got hashref');
$test->is($o->stamped($h), $h, 'set stamped to hashref');
$test->is($o->stamped(), $h, 'read value of stamped  - hashref');
my $a = [];
$test->ok($a, 'got arrayref');
$test->is($o->stamped($a), $a, 'set stamped to arrayref');
$test->is($o->stamped(), $a, 'read value of stamped  - arrayref');

=end btest

=cut


sub init {
	return shift->SUPER::init(
		'closed' => 0,
		'stamped' => 1,
		@_
	);
};

=pod

=begin btest init

my $o = __PACKAGE__->new();
$test->ok($o, "Got logger object");
$test->is($o->closed, 0, 'closed is 0');
$test->is($o->stamped, 1, 'stamped is 1');

=end btest

=cut


# _file_accessor is a dumbed down version of the one in Mail::Bulkmail.
#
# _file_accessor is an internal accessor for accessing external information. Said external information can be a
# path to a file or a globref containing an already openned file handle. It will open up path/to/file strings and
# create an internal filehandle. it also makes sure that all filehandles are piping hot.

sub _isa_file_accessor {
	my $pkg = shift;
	my $attr = shift;
	my $prop = shift;

	return sub  {
		my $self	= shift;
		my $file	= shift;

		if (defined $file){
			if (! ref $file) {
				my $handle = $self->gen_handle();
				open ($handle, ">>" . $file)
					or return $self->error("Could not open file $file : $!", "BL-01");
				select((select($handle), $| = 1)[0]); 		#Make sure the file is piping hot!
				$self->closed(0);
				return $self->$prop($handle);
			}
			elsif (ref ($file) eq 'GLOB') {
				select((select($file), $| = 1)[0]); 		#Make sure the file is piping hot!
				$self->closed(0);
				return $self->$prop($file);
			}
			else {
				return $self->error("File error. I don't know what a $file is", "BL-03");
			};
		}
		else {
			return $self->$prop();
		};
	}

};

=pod

=item log

logs the item to the logger's handle.

 $logger->log("one val", "two vals", "three vals");

prints out one per line, tab indented on subsequent lines.

 one val
 	two vals
 	three vals

=cut

sub log {
	my $self	= shift;
	my $note	= shift or return $self->error("Cannot log w/o notification", "BL-07");

	return $self->error("Cannot log to closed handle", "BL-08") if $self->closed;

	my $args	= ref $note ? $note->{'args'} || [] : [$note];

	my $handle	= $self->handle or return;

	my $printed = 0;

	if (@$args) {

		if ($self->stamped) {
			my $stamp = localtime;
			print $handle "AT (", $stamp, "):\t";
		};

		foreach my $value (@$args) {
			my $tab = $printed++ ? "\t" : "";
			print $handle $tab, $value, "\n" if defined $value;
		};
	}

	return 1;

};

=pod

=begin btest log

my $o = __PACKAGE__->new();
$test->ok($o, "got object");
$test->is($o->close, 1, "closing non-existent handle is fine");
$test->is($o->closed, 0, "handle remains open");

$test->is(scalar($o->log('foo')), undef, "Cannot log w/o handle");

$test->is($o->closed(1), 1, "closed handle");
$test->is(scalar($o->log), undef, "Cannot log w/o note");
$test->is($o->errcode, "BL-07", "proper error code");
$test->is(scalar($o->log('foo')), undef, "Cannot log to closed handle");
$test->is($o->errcode, "BL-08", "proper error code");


local $@ = undef;
eval "use File::Temp";
my $file_temp_exists = $@ ? 0 : 1;

if ($file_temp_exists) {
	{
		my $temp = File::Temp->new;
		my $name = $temp->filename;
		$test->is(ref($o->handle($name)), 'GLOB', "created glob");
		$test->is($o->log('foo'), 1, "logged foo to file");
		open (my $reader, $name);
		{
			local $/ = undef;
			my $in_file = <$reader>;
			$test->like($in_file, qr{^AT \(\w+\s+\w+\s+\d+\s+\d+:\d+:\d+\s+\d+\):\tfoo\n$}, "data was logged to file with stamp");
		}
	}
	{
		$test->is($o->stamped(0), 0, "shut off time stamping");
		my $temp = File::Temp->new;
		my $name = $temp->filename;
		$test->is(ref($o->handle($name)), 'GLOB', "created glob");
		$test->is($o->log('foo'), 1, "logged foo to file");
		open (my $reader, $name);
		{
			local $/ = undef;
			my $in_file = <$reader>;
			$test->like($in_file, qr{^foo\n$}, "data was logged to file without stamp");
		}
		$test->is($o->stamped(1), 1, "turned on time stamping");
	}
	{
		my $temp = File::Temp->new;
		my $name = $temp->filename;
		$test->is(ref($o->handle($name)), 'GLOB', "created glob");
		$test->is($o->log({'args' => ['foo']}), 1, "logged foo to file in note");
		open (my $reader, $name);
		{
			local $/ = undef;
			my $in_file = <$reader>;
			$test->like($in_file, qr{^AT \(\w+\s+\w+\s+\d+\s+\d+:\d+:\d+\s+\d+\):\tfoo\n$}, "data was logged to file with stamp");
		}
	}
	{
		$test->is($o->stamped(0), 0, "shut off time stamping");
		my $temp = File::Temp->new;
		my $name = $temp->filename;
		$test->is(ref($o->handle($name)), 'GLOB', "created glob");
		$test->is($o->log({'args' => ['foo']}), 1, "logged foo to file in note");
		open (my $reader, $name);
		{
			local $/ = undef;
			my $in_file = <$reader>;
			$test->like($in_file, qr{^foo\n$}, "data was logged to file without stamp");
		}
		$test->is($o->stamped(1), 1, "turned on time stamping");
	}
	{
		my $temp = File::Temp->new;
		my $name = $temp->filename;
		$test->is(ref($o->handle($name)), 'GLOB', "created glob");
		$test->is($o->log({'args' => ['foo', 'bar']}), 1, "logged foo, bar to file in note");
		open (my $reader, $name);
		{
			local $/ = undef;
			my $in_file = <$reader>;
			$test->like($in_file, qr{^AT \(\w+\s+\w+\s+\d+\s+\d+:\d+:\d+\s+\d+\):\tfoo\n\tbar\n$}, "data was logged to file with stamp");
		}
	}
	{
		$test->is($o->stamped(0), 0, "shut off time stamping");
		my $temp = File::Temp->new;
		my $name = $temp->filename;
		$test->is(ref($o->handle($name)), 'GLOB', "created glob");
		$test->is($o->log({'args' => ['foo', 'bar']}), 1, "logged foo, bar to file in note");
		open (my $reader, $name);
		{
			local $/ = undef;
			my $in_file = <$reader>;
			$test->like($in_file, qr{^foo\n\tbar\n$}, "data was logged to file with stamp");
		}
		$test->is($o->stamped(1), 1, "turned on time stamping");
	}
	{
		my $temp = File::Temp->new;
		my $name = $temp->filename;
		$test->is(ref($o->handle($name)), 'GLOB', "created glob");
		$test->is($o->log({'args' => ['foo', undef]}), 1, "logged foo, undef to file in note");
		open (my $reader, $name);
		{
			local $/ = undef;
			my $in_file = <$reader>;
			$test->like($in_file, qr{^AT \(\w+\s+\w+\s+\d+\s+\d+:\d+:\d+\s+\d+\):\tfoo\n$}, "data was logged to file with stamp");
		}
	}
	{
		my $temp = File::Temp->new;
		my $name = $temp->filename;
		$test->is(ref($o->handle($name)), 'GLOB', "created glob");
		$test->is($o->log({}), 1, "logged empty note to file in note");
		open (my $reader, $name);
		{
			local $/ = undef;
			my $in_file = <$reader>;
			$test->is($in_file,'', "no data logged w/o args");
		}
	}
}


=end btest

=cut



sub close {
	my $self = shift;

	my $handle	= $self->handle or return 1;

	close($handle) or return $self->error("Canot close handle : $!", "BL-06");

	$self->closed(1);

	return 1;
}

=pod

=begin btest close

my $o = __PACKAGE__->new();
$test->ok($o, "got object");
$test->is($o->close, 1, "closing non-existent handle is fine");
$test->is($o->closed, 0, "handle remains open");

local $@ = undef;
eval "use File::Temp";
my $file_temp_exists = $@ ? 0 : 1;

if ($file_temp_exists) {
	my $temp = File::Temp->new;
	my $name = $temp->filename;
	$test->is(ref($o->handle($name)), 'GLOB', "created glob");
	$test->is($o->closed, 0, "file handle is open");
	$test->is($o->close, 1, "closed file handle");
	$test->is($o->closed, 1, "filehandle is closed");
}

=end btest

=cut


sub DESTROY {
	my $self = shift;

	$self->close unless $self->closed;

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

1;