File Coverage

blib/lib/Net/Peep/Log.pm

Criterion	Covered	Total	%
statement	34	66	51.5
branch	5	22	22.7
condition	1	9	11.1
subroutine	8	12	66.6
pod	0	5	0.0
total	48	114	42.1

package Net::Peep::Log;

require 5.00503;
use strict;
use Carp;
# use warnings; # commented out for 5.005 compatibility
use Time::HiRes qw{ gettimeofday tv_interval };

require Exporter;

use vars qw{ @ISA %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION $debug $logfile $__LOGFILE $__LOGHANDLE };

@ISA = qw(Exporter);
%EXPORT_TAGS = ( 'all' => [ qw( ) ] );
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@EXPORT = qw( );
$VERSION = do { my @r = (q$Revision: 1.6 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };

$debug = $__LOGFILE = 0;

$|++;

sub new {

    my $self = shift;
    my $class = ref($self) || $self;
    my $this = {};
    bless $this, $class

} # end sub new

sub log {

    my $self = shift;
    if ($logfile) {
	open(LOGFILE,">>$logfile") || confess "Cannot open $logfile:  $!";
	print LOGFILE $self->__beautify(@_);
	close(LOGFILE);
    } else {
	print STDERR $self->__beautify(@_);
    }

} # end sub log

sub debug {

    my $self = shift;
    my $level = shift;

    if ($debug >= $level) {

	if ($logfile) {
	    open(LOGFILE,">>$logfile") || confess "Cannot open $logfile:  $!";
	    print LOGFILE $self->__beautify(@_);
	    close(LOGFILE);
	} else {
	    print STDERR $self->__beautify(@_);
	}

    }

    return 1;

} # end sub debug

sub __logHandle {

    # this method has been deprecated

    my $self = shift;

    if (defined($__LOGHANDLE) ) {
	return $__LOGHANDLE;
    } elsif (defined $logfile) {
	print STDERR ref($self),":  Opening logfile $logfile ...\n";
	open(LOGFILE,">>$logfile") || die "Cannot open $logfile:  $!";
	$__LOGHANDLE = \*LOGFILE;
	$__LOGFILE++;
	return $__LOGHANDLE;
    } else {
	$__LOGHANDLE = \*STDOUT;
	return $__LOGHANDLE;
    }

} # end sub __logHandle

sub __beautify {

    my $self = shift;

    my $message = join '', @_;

    my @return;

    for my $line (split /\n/, $message) {
	my $time = "[" . scalar(localtime) . "]";
	chomp($line);
	$line = "$time $line";
	$line =~ s/\n/\n$time /sg;
	$line .= "\n" unless $line =~ /\n$/s;
	push @return, $line;
    }

    return @return;

} # end sub __beautify

sub mark {

    # set a time against which future benchmarks can be measured
    my $self = shift;
    my $identifier = shift || confess "Cannot set mark:  No identifier specified.";

    my $timeofday = gettimeofday;
    $self->{"__MARK"}->{$identifier} = [$timeofday];
    $self->debug(9,"Mark [$identifier:$timeofday] set.");

    return 1;

} # end sub mark

sub benchmark {

    # set a time against which future benchmarks can be measured
    my $self = shift;
    my $identifier = shift || confess "Cannot acquire benchmark:  No identifier specified.";

    confess "Cannot acquire benchmark:  No mark has been set with identifier '$identifier'."
	unless exists $self->{"__MARK"}->{$identifier};

    my $interval = tv_interval($self->{"__MARK"}->{$identifier},[gettimeofday]);

    $self->debug(9,"$interval seconds have passed since mark [$identifier:".@{$self->{"__MARK"}->{$identifier}}."]");

    return $interval;

} # end sub benchmark

# one should endeavor to always exit gracefully

END { close LOGFILE if $__LOGFILE; }

1;

__END__