File Coverage

blib/lib/Log/WithCallbacks.pm

Criterion	Covered	Total	%
statement	34	94	36.1
branch	3	38	7.8
condition	3	13	23.0
subroutine	9	15	60.0
pod	8	8	100.0
total	57	168	33.9

package Log::WithCallbacks;

use strict;
use Carp;
use Symbol;
use Fcntl;
use IO::File;

use vars qw( $VERSION );

$VERSION = '1.00';

my $standard_format = sub {
    my $message = shift;

    chomp $message;	# Clean up any accidental double lines.
    return scalar localtime(time) . ": $message\n";
};

sub new {
    my $class  = shift;
    my $file   = shift || croak 'Must supply a filename';
    my $format = shift;

    my $self = {
	LOGFILE	    => IO::File->new(),
	file	    => $file,
	'format'    => '',
	'status'    => 'closed',
	mode	    => 'append',
    };

    $self->{LOGFILE}->autoflush(1);
    bless $self, $class;

    # Set format to default if no format is provided.
    $format = defined $format ? $format : 'standard';
    $self->format($format) or $self->format('standard');

    return $self;
}

sub open {
    my $self=shift;
    my $mode= shift || $self->mode() || 'append';
    my $format = shift;

    $self->mode($mode);
    $self->format($format);
    $self->_setStatus('opening');

    # Assemble mode
    my $fcntl_mode =  O_WRONLY | O_CREAT;

    if ($self->mode eq 'append') {
        $fcntl_mode |= O_APPEND;
    } elsif ($self->mode eq 'overwrite') {
        $fcntl_mode |= O_TRUNC;
    } else {
	my $badmode = $self->mode;
	croak "Illegal mode: cannot open logfile in mode $badmode"
    }
    # Open IO::File object.
    $self->{LOGFILE}->open($self->{file}, $fcntl_mode)
        or croak "Unable to open logfile $self->{file}: $!";

    $self->_setStatus('open');
}

sub close {
    my $self = shift;

    carp('Cannot close a logfile that is not open'), return 0
	unless $self->status eq 'open';

    $self->_setStatus('closing');

    close $self->{LOGFILE} or croak "Unable to close logfile: $!";

    $self->_setStatus('closed');
    return 'closed';
}

sub exit {
    my $self = shift;

    my $error_code = shift;
    my ($message) = @_;

    $self->entry("Script terminating - $error_code", @_);

    $self->entry( @_ );

    $!=$error_code;
    croak "$message";
}

sub entry {
    my $self = shift;

    my $message = shift;
    my $format  = shift;

    carp "Format '$format' is not a code reference or string literal 'standard'."
        if (
            ( $format                ) &&
            ( ref($format) ne 'CODE' ) &&
            ( $format ne 'standard'  )
        );

    $format = $standard_format if $format eq 'standard';

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

    carp "Cannot log entry unless log status is 'open'"
	if $self->status ne 'open';

    my $string = $format->($message);
    print {$self->{LOGFILE}} $string;

    return $string;
}

sub status {
    my $self = shift;

    return $self->{status};
}

sub mode {
    my $self = shift;
    my $mode = shift;

    my %mode;
    @mode{qw(overwrite append)} = (1) x 2;

    if ($mode) {
	if (exists $mode{$mode}) {
	    if ($self->status eq 'closed') {
		$self->{mode} = $mode;
	    }
	    elsif ($self->{mode} ne $mode) {
		carp "Can only set mode when logfile is closed";
	    }
	} else {
	    carp "Illegal mode $mode, mode remains set to $self->{mode}";
	    return 0;
	}
    }

    return $self->{mode};
}

sub format {
    my $self = shift;
    my $format = shift || '';

    if ($format eq 'standard') {
	$self->{'format'} = $standard_format;
    }
    elsif ($format) {
	unless ( ref $format eq 'CODE' ) {
	    croak "Format must be a code reference or 'standard'";
	    return 0;
	}
	$self->{'format'} = $format;
    }

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

sub _setStatus {
    my $self = shift;
    my $status = shift;

    my %status;
    @status{qw(open closed opening closing)} = (1) x 4;

    croak "Illegal logfile status $status" unless exists $status{$status};
    $self->{'status'} = $status;
}

1;
__END__