File Coverage

blib/lib/Tie/LogFile.pm

Criterion	Covered	Total	%
statement	75	92	81.5
branch	18	30	60.0
condition	5	8	62.5
subroutine	19	21	90.4
pod	2	4	50.0
total	119	155	76.7

package Tie::LogFile;
#
# $Id: LogFile.pm,v 1.1.1.1 2002/10/16 10:08:08 ctriv Exp $
#
use 5.006;
use strict;
use warnings;
use Carp;
use Symbol ();

our $VERSION = 0.1;

our %defaults  = (
	'format'        => '[%d] %m',
	'tformat'       => '',
	'mode'          => '>>',
	'force_newline' => 1,
	'autoflush'     => 0,
);

our %formats = (
	'd' => sub { $_[0]->fmtime },
	'm' => sub { $_[1]         },
	'p' => sub { $$            },
	'c' => sub { $_[0]->count  },
	'%' => sub { '%'           },
);


sub TIEHANDLE {
	my $class    = shift;
	my $filename = shift || return;

	if (@_ % 2 != 0) {
		carp "$class must be passed an even number of arguments.";
		return;
	}

	my %options = @_;

	if ($options{'format'} && $options{'format'} !~ m/%m/) {
		carp "Syntax error in 'format' option, must contain a message tag (%m)\n";
		return;
	}

	if ($options{'mode'} && $options{'mode'} !~ m/^>>?$/) {
		# We don't support no stinking reading, at least for now
		carp __PACKAGE__ . " only supports writing file modes.\n";
		return;
	}

	my $self = Symbol::gensym();   #The lazy way... :)

	bless($self, $class);

	$$self = {
		%defaults,
		%options,
		count => 0,
	};

	open($self, $$self->{'mode'} , $filename) || return;

	if ($$self->{'autoflush'}) {
		$self->autoflush($$self->{'autoflush'});
	}

	return $self;
}

sub PRINT {
	my $self = shift;
	$self->_print(@_);
}

sub PRINTF {
	my $self = shift;
	my $fmt  = shift;
	my $line = sprintf($fmt, @_);
	$self->_print($line);
}

sub CLOSE {
	my $self = shift;
	close($self);
}

sub UNTIE {
	my $self = shift;
	close($self);
}

sub _print {
	my $self = shift;
	my $msg  = "@_";
	my $line = $$self->{'format'};

	$$self->{'count'}++;
    # This isn't the fastest way to do things, but it's flexible and easy.
    # If people start ccontacting me and asking for more speed, I have a few
    # ideas, but I don't see that happening.
    $line =~ s/%(_?[%a-zA-Z])/$formats{$1} ? $formats{$1}->($self, $msg) : ''/eg;

 	if ($$self->{'force_newline'}) {
 		$line .= "\n" if $line !~ m/\n$/;
 	}

	print $self $line;
}

sub autoflush {
	my ($self, $af) = @_;

	if (defined $af) {
		# set self to autoflush.
		select((select($self), $| = $af)[0]);
		$$self->{'autoflush'} = $af;
	}

	return $$self->{'autoflush'};
}


sub fmtime {
	my $self = shift;

	if ($$self->{'tformat'}) {
		return Tie::LogFile::misc::time2str($$self->{'tformat'});
	}

	return scalar localtime;
}

sub count {
	my $self = shift;
	return $$self->{'count'};
}

sub format {
	my $self = shift;
	if (@_) {
		my $new_fmt = shift;
		$$self->{'format'} = $new_fmt;
	}
	return $$self->{'format'};
}

package Tie::LogFile::misc;

use strict;
use warnings;
use Carp;

our $loaded = 0;

sub time2str {
	my $fmt = shift;
	if (!$loaded) {
		load_date_mod() || croak "Couldn't load a date module (Tried Data::Format and POSIX)\n";
	}

	return _time_formater($fmt, time);
}

sub load_date_mod {

	if (eval "require Date::Format") {
		$loaded = 1;
		*_time_formater = \&Date::Format::time2str;
		return 1;
	}

	if (eval "require POSIX") {
		$loaded = 1;
		*_time_formater = sub { POSIX::strftime($_[0], localtime($_[1])); };
		return 1;
	}

	return;
}



1;
__END__