File Coverage

blib/lib/PerlIO/via/Logger.pm

Criterion	Covered	Total	%
statement	26	30	86.6
branch	4	6	66.6
condition	0	2	0.0
subroutine	8	9	88.8
pod	4	4	100.0
total	42	51	82.3

# Perl I/O Layer for Logging
#
# Author: Adam J Kaplan
# Email: [e-mail]
#
# This script is distributed under the same license as Perl itself.
#
package PerlIO::via::Logger;

$VERSION = '1.01';
use strict;
use warnings;
use POSIX qw(strftime);

# Set default format

# Format for strftime(3)
my $timestr = '[%b %d, %Y %H:%M:%S] ';
# I prefer the string below, but it is not as portable as the one above
#my $timestr = '%b %d, %Y %r: ';

# Satisfy require
1;

#-----------------------------------------------------------------------
# Class methods
#-----------------------------------------------------------------------

#-----------------------------------------------------------------------
#  IN: 1 class (ignored)
#      2 new value for time format string
# OUT: 1 current default time format string

sub format {

		# Set new default format if one specified
		# Return current default format

		$timestr = $_[1] if defined $_[1];
		return $timestr;
} #format

#-----------------------------------------------------------------------
# Subroutines for standard Perl features
#-----------------------------------------------------------------------
#  IN: 1 class to bless with
#      2 mode string (ignored)
#      3 file handle of PerlIO layer below (ignored)
# OUT: 1 blessed object

sub PUSHED {

	# Die now if strange mode
	# Create the object with the right fields

	bless {timestr => $timestr },$_[0];
} #PUSHED

#-----------------------------------------------------------------------
#  IN: 1 instantiated object
#      2 handle to read from
# OUT: 1 processed string

sub FILL {

		# Obtain local copy of the formatting variables
		# If there is a line to be read from the handle
		#  Append the generated string
		#  Return the result
		# Return indicating end reached

    my ($timeformat) = @{$_[0]}{qw(timestr)};

		my $now_string = strftime $timeformat, localtime;
    if (defined( my $line = readline( $_[1] ) )) {
				return $now_string . $line;
    }
    undef;
} #FILL

#-----------------------------------------------------------------------
#  IN: 1 Valid file handle GLOB
#			 2 Optional output. Default is to insert the io layer in place
# OUT: 1 undef

sub logify {
		my $fh = shift||return;
		binmode($fh, ":via(Logger)");
		undef;
}


#-----------------------------------------------------------------------
#  IN: 1 instantiated object
#      2 buffer to be written
#      3 handle to write to
# OUT: 1 number of bytes written
sub WRITE {

		# Obtain local copies of format vars
		# For all of the lines in this bunch (includes delimiter at end)
		#  Return with error if print failed
		# Return total number of octets handled

    my ($timeformat) = @{$_[0]}{qw(timestr)};

		my $now_string = strftime $timeformat, localtime;
    foreach (split( m#(?<=$/)#,$_[1] )) {
				return -1 unless print {$_[2]} $now_string . $_;
    }
    length( $_[1] );
} #WRITE

#-----------------------------------------------------------------------
#  IN: 1 class for which to import
#      2..N parameters passed with -use-

sub import {

# Obtain the parameters
# Loop for all the value pairs specified

    my ($class,%param) = @_;
    $class->$_( $param{$_} ) foreach keys %param;
} #import

#-----------------------------------------------------------------------

__END__