File Coverage

blib/lib/Seshat.pm

Criterion	Covered	Total	%
statement	12	50	24.0
branch	0	14	0.0
condition	0	4	0.0
subroutine	4	6	66.6
pod	2	2	100.0
total	18	76	23.6

package Seshat;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use POSIX qw(strftime);
use Data::Dumper;

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(

);
$VERSION = '1.1';

sub new {
	my $classname = shift;
	my $filename = shift;
	my %params = @_;
	my $self = {};
	$self->{NAME} = "Seshat";
	$self->{FILE} = $filename;
	$self->{FLAG} = 0;
	$self->{POS} = 0;

	# -> defaults -< #
	$self->{PARAM}->{LOG_LEVEL} = "0";
	$self->{PARAM}->{DATE_FORMAT} ="%a %b %e %H:%M:%S %Y";


	foreach (keys %params) {
		if (exists $self->{PARAM}->{$_}) {
			$self->{PARAM}->{$_} = $params{$_};
		}
	}
	bless ($self,$classname);
	return $self;
}

sub write {
	my ($self, $string, $flag) = @_;
	open(FH, ">>".$self->{FILE})
		or ( $@="cant open ".$self->{FILE}.": $!"
		     && return undef);
	my $flocked = 0;
	while (! $flocked ) {
		if (! flock(FH, 2)) {
			sleep 1;
		}
		else {
			$flocked = 1;
		}
	}

	my $print_string;

	if ($self->{FLAG} eq 1) { seek(FH,$self->{POS},0) }		# the line is not blank
	else {
		#$print_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
		$print_string = strftime $self->{PARAM}->{DATE_FORMAT}, localtime;
		$print_string .= " : $0 : ";
	}
	$print_string .= "$string";

	if ($flag eq 1) {		# new line...
		$print_string .= "\n";
		print FH $print_string;
		$self->{FLAG} = 0;
	}
	elsif ($flag eq 0) {		#no new line...
		print FH $print_string;
		$self->{FLAG} = 1;
		my $index = tell(FH);
		$self->{POS} = $index;
	}

	close(FH)
		or ($@= "can't close $!"
		    && return undef);
	return 1;
}

1;
__END__