File Coverage

blib/lib/Device/Modem/Log/File.pm

Criterion	Covered	Total	%
statement	12	53	22.6
branch	0	14	0.0
condition	0	12	0.0
subroutine	4	11	36.3
pod	0	7	0.0
total	16	97	16.4

# Device::Modem::Log::File - Text files logging plugin for Device::Modem class
#
# Copyright (C) 2002-2004 Cosimo Streppone, [e-mail]
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Additionally, this is ALPHA software, still needs extensive
# testing and support for generic AT commads, so use it at your own risk,
# and without ANY warranty! Have fun.
#
# $Id$
#
package Device::Modem::Log::File;
our $VERSION = '2.11';
$VERSION = eval $VERSION;

use strict;
use File::Path     ();
use File::Basename ();
use IO::Handle;

# Define log levels like syslog service
our %levels = ( debug => 7, info => 6, notice => 5, warning => 4, err => 3, error => 3, crit => 2, alert => 1, emerg => 0 );

sub new {
	my( $class, $package, $filename ) = @_;

	# Get a decent default if no file available
	$filename ||= default_filename();

	my %obj = (
		file => $filename,
		loglevel => 'info'
	);

	my $self = bless \%obj, 'Device::Modem::Log::File';

	# Open file at the start and save reference
	my $LOGFILE = new IO::Handle;
	if( open( $LOGFILE, '>>'.$self->{'file'} ) ) {

		$self->{'fh'} = $LOGFILE;

		# Unbuffer writes to logfile
		my $oldfh = select $self->{'fh'};
		$| = 1;
		select $oldfh;

	} else {
		warn('Could not open '.$self->{'file'}.' to start logging');
	}

	return $self;
}

# Provide a suitable filename default
sub default_filename () {
	my $dir = '/tmp';

	# If this is windows, use the temp/tmp dirs
	if (exists $ENV{'TEMP'} || exists $ENV{'TMP'}) {
		$dir = $ENV{'TEMP'} || $ENV{'TMP'};
	}

	return "$dir/modem.log";
}

sub filename {
	my $self = shift();
	$self->{'file'} ||= $self->default_filename();

	if( ! -d File::Basename::dirname($self->{'file'}) ) {
		File::Path::mkpath( File::Basename::dirname($self->{'file'}), 0, 0755 );
	}

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


sub loglevel {
	my($self, $newlevel) = @_;

	if( defined $newlevel ) {
		$newlevel = lc $newlevel;
		if( ! exists $levels{$newlevel} ) {
			$newlevel = 'warning';
		}
		$self->{'loglevel'} = $newlevel;
	} else {
		return $self->{'loglevel'};
	}
}

sub write($$) {

	my($self, $level, @msg) = @_;

	# If log level mask allows it, log given message
	#warn('message level='.$level.' ('.$levels{$level}.')    loglevel='.$self->{loglevel}.' ('.$levels{$self->{loglevel}}.')');
	if( $levels{$level} <= $levels{$self->{'loglevel'}} ) {

		if( my $fh = $self->fh() ) {
			map { tr/\r\n/^M/s } @msg;
			print $fh join("\t", scalar localtime, $0, $level, @msg), "\n";
		} else {
			warn('cannot log '.$level.' '.join("\t",@msg).' to file: '.$! );
		}

	}

}

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

# Closes log file opened in new()
sub close {
	my $self = shift;
	my $fh = $self->{'fh'};
	close $fh;
	undef $self->{'fh'};
}

1;



__END__