File Coverage

blib/lib/UniLog.pm

Criterion	Covered	Total	%
statement	109	165	66.0
branch	26	70	37.1
condition	4	15	26.6
subroutine	44	57	77.1
pod	27	49	55.1
total	210	356	58.9

package UniLog;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS @EXPORT_FAIL);

#$^W++;

require Exporter;

@ISA = qw(Exporter);
# 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(
);

%EXPORT_TAGS = ('levels'     => [qw(LOG_EMERG LOG_ALERT LOG_CRIT LOG_ERR
			            LOG_WARNING LOG_NOTICE LOG_INFO LOG_DEBUG  )],
		'options'    => [qw(LOG_CONS LOG_NDELAY LOG_PERROR LOG_PID)],
		'facilities' => [qw(LOG_AUTH LOG_CRON LOG_DAEMON
				    LOG_KERN LOG_LPR LOG_MAIL LOG_NEWS
				    LOG_SECURITY LOG_SYSLOG LOG_USER LOG_UUCP
				    LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2 LOG_LOCAL3
				    LOG_LOCAL4 LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7)],
		'functions'  => [qw(SafeStr)],
		'syslog'     => [qw(syslog)],
		'nosyslog'   => [qw(nosyslog)],
		);

foreach (keys(%EXPORT_TAGS))
        { push(@{$EXPORT_TAGS{'all'}}, @{$EXPORT_TAGS{$_}}); };

$EXPORT_TAGS{'all'}
	and @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

@EXPORT_FAIL = qw(syslog nosyslog);	# hook to enable/disable syslog

$VERSION = '0.14';

use Carp qw(carp croak cluck confess);
use POSIX;
use IO::File;
use File::Path;
use File::Basename;

sub LOG_CONS()   { return 2; };
sub LOG_NDELAY() { return 8; };
sub LOG_PID()    { return 1; };
my %LogOptions = (LOG_CONS()   => LOG_CONS(),
                  LOG_NDELAY() => LOG_NDELAY(),
                  LOG_PID()    => LOG_PID(),
                 );
my $CalcOpt = sub
	{
	my $Result = 0;
	foreach (keys(%LogOptions))
		{
		if ($_[0] & $_)
			{ $Result = $Result | $LogOptions{$_}; };
		};
	return $Result;
	};

#
# Define log levels
my @LogLevels     = (0, 1, 2, 3, 4, 5, 6, 7);
#
sub LOG_EMERG()   { return 0; };
sub LOG_ALERT()   { return 1; };
sub LOG_CRIT()    { return 2; };
sub LOG_ERR()     { return 3; };
sub LOG_WARNING() { return 4; };
sub LOG_NOTICE()  { return 5; };
sub LOG_INFO()    { return 6; };
sub LOG_DEBUG()   { return 7; };

#
# Define log facilities
my %LogFacilities = ('LOG_AUTH'     =>  1,
                     'LOG_AUTHPRIV' =>  2,
                     'LOG_CRON'     =>  3,
                     'LOG_DAEMON'   =>  4,
                     'LOG_FTP'      =>  5,
                     'LOG_KERN'     =>  6,
                     'LOG_LPR'      =>  7,
                     'LOG_MAIL'     =>  8,
                     'LOG_NEWS'     =>  9,
                     'LOG_SYSLOG'   => 10,
                     'LOG_USER'     => 11,
                     'LOG_UUCP'     => 12,
                     'LOG_LOCAL0'   => 13,
                     'LOG_LOCAL1'   => 14,
                     'LOG_LOCAL2'   => 15,
                     'LOG_LOCAL3'   => 16,
                     'LOG_LOCAL4'   => 17,
                     'LOG_LOCAL5'   => 18,
                     'LOG_LOCAL6'   => 19,
                     'LOG_LOCAL7'   => 20,
                    );
#
sub LOG_AUTH()     { return 'LOG_AUTH'; };
#sub LOG_AUTHPRIV() { return 'LOG_AUTHPRIV'; };
sub LOG_CRON()     { return 'LOG_CRON'; };
sub LOG_DAEMON()   { return 'LOG_DAEMON'; };
#sub LOG_FTP()      { return 'LOG_FTP'; };
sub LOG_KERN()     { return 'LOG_KERN'; };
sub LOG_LPR()      { return 'LOG_LPR'; };
sub LOG_MAIL()     { return 'LOG_MAIL'; };
sub LOG_NEWS()     { return 'LOG_NEWS'; };
sub LOG_SYSLOG()   { return 'LOG_SYSLOG'; };
sub LOG_USER()     { return 'LOG_USER'; };
sub LOG_UUCP()     { return 'LOG_UUCP'; };
sub LOG_LOCAL0()   { return 'LOG_LOCAL0'; };
sub LOG_LOCAL1()   { return 'LOG_LOCAL1'; };
sub LOG_LOCAL2()   { return 'LOG_LOCAL2'; };
sub LOG_LOCAL3()   { return 'LOG_LOCAL3'; };
sub LOG_LOCAL4()   { return 'LOG_LOCAL4'; };
sub LOG_LOCAL5()   { return 'LOG_LOCAL5'; };
sub LOG_LOCAL6()   { return 'LOG_LOCAL6'; };
sub LOG_LOCAL7()   { return 'LOG_LOCAL7'; };

# Define syslog functions
my $OpenLog  = undef;
my $CloseLog = undef;
my $PutMsg   = undef;

my $SyslogEnabled = 1;

my $InitSyslog = sub
	{
	if ( $^O =~ m/win32/i )
		{
		if (!Win32::IsWinNT())
			{
			#$OpenLog  = sub { return 1; };
			#$CloseLog = sub { return 1; };
			#$PutMsg   = sub { return 1; };
			$SyslogEnabled = 0;
			carp "Win32::EventLog is not supporting Win32 systems other WinNT. Syslog functionality disabled\n";
			return;
			};

		eval   'use Win32::EventLog;
		        $OpenLog  = sub
		        	{
		        	my ($Ident, $Options, $Facility) = @_;
				if ($Options & LOG_PID())
					{ $Ident .= "[$$]" };
				return Win32::EventLog->new($Ident, $ENV{ComputerName});
				};
		        $CloseLog = sub
		        	{
		        	$_[0]->{Handler}->Close();
		        	};
		        $PutMsg = sub
		        	{ $_[0]->{Handler}->Report({EventType => $_[1],
		        				    Strings   => $_[2],
		        				    Category  => $_[0]->{"Facility"},
		        				    EventID   => 0,
		        				    Data      => "",
		        				   });
				};
			$LogLevels[LOG_EMERG()]   = EVENTLOG_ERROR_TYPE;
			$LogLevels[LOG_ALERT()]   = EVENTLOG_ERROR_TYPE;
			$LogLevels[LOG_CRIT()]    = EVENTLOG_ERROR_TYPE;
			$LogLevels[LOG_ERR()]     = EVENTLOG_ERROR_TYPE;
			$LogLevels[LOG_WARNING()] = EVENTLOG_WARNING_TYPE;
			$LogLevels[LOG_NOTICE()]  = EVENTLOG_INFORMATION_TYPE;
			$LogLevels[LOG_INFO()]    = EVENTLOG_INFORMATION_TYPE;
			$LogLevels[LOG_DEBUG()]   = EVENTLOG_INFORMATION_TYPE;
		        ';
		}
	else
		{
		eval   'use Unix::Syslog;
		        $OpenLog  = sub {
		        		my ($Ident, $Options, $Facility) = @_;
					Unix::Syslog::openlog($Ident, $Options, $Facility);
	                		return 1;
	                		};
	                $CloseLog = sub { Unix::Syslog::closelog; };
	                $PutMsg   = sub { Unix::Syslog::syslog($_[1], "%s", $_[2]); };
			# Set real log levels
			$LogLevels[LOG_EMERG()]   = Unix::Syslog::LOG_EMERG;
			$LogLevels[LOG_ALERT()]   = Unix::Syslog::LOG_ALERT;
			$LogLevels[LOG_CRIT()]    = Unix::Syslog::LOG_CRIT;
			$LogLevels[LOG_ERR()]     = Unix::Syslog::LOG_ERR;
			$LogLevels[LOG_WARNING()] = Unix::Syslog::LOG_WARNING;
			$LogLevels[LOG_NOTICE()]  = Unix::Syslog::LOG_NOTICE;
			$LogLevels[LOG_INFO()]    = Unix::Syslog::LOG_INFO;
			$LogLevels[LOG_DEBUG()]   = Unix::Syslog::LOG_DEBUG;
			#
			# Set log options
			$LogOptions{LOG_CONS()}   = Unix::Syslog::LOG_CONS;
			$LogOptions{LOG_NDELAY()} = Unix::Syslog::LOG_NDELAY;
			$LogOptions{LOG_PID()}    = Unix::Syslog::LOG_PID;
			#
			# Set log facilities
			$LogFacilities{LOG_AUTH()}     = Unix::Syslog::LOG_AUTH;
			#$LogFacilities{LOG_AUTHPRIV()} = Unix::Syslog::LOG_AUTHPRIV;
			$LogFacilities{LOG_CRON()}     = Unix::Syslog::LOG_CRON;
			$LogFacilities{LOG_DAEMON()}   = Unix::Syslog::LOG_DAEMON;
			#$LogFacilities{LOG_FTP()}      = Unix::Syslog::LOG_FTP;
			$LogFacilities{LOG_KERN()}     = Unix::Syslog::LOG_KERN;
			$LogFacilities{LOG_LPR()}      = Unix::Syslog::LOG_LPR;
			$LogFacilities{LOG_MAIL()}     = Unix::Syslog::LOG_MAIL;
			$LogFacilities{LOG_NEWS()}     = Unix::Syslog::LOG_NEWS;
			$LogFacilities{LOG_SYSLOG()}   = Unix::Syslog::LOG_SYSLOG;
			$LogFacilities{LOG_USER()}     = Unix::Syslog::LOG_USER;
			$LogFacilities{LOG_UUCP()}     = Unix::Syslog::LOG_UUCP;
			$LogFacilities{LOG_LOCAL0()}   = Unix::Syslog::LOG_LOCAL0;
			$LogFacilities{LOG_LOCAL1()}   = Unix::Syslog::LOG_LOCAL1;
			$LogFacilities{LOG_LOCAL2()}   = Unix::Syslog::LOG_LOCAL2;
			$LogFacilities{LOG_LOCAL3()}   = Unix::Syslog::LOG_LOCAL2;
			$LogFacilities{LOG_LOCAL4()}   = Unix::Syslog::LOG_LOCAL4;
			$LogFacilities{LOG_LOCAL5()}   = Unix::Syslog::LOG_LOCAL5;
			$LogFacilities{LOG_LOCAL6()}   = Unix::Syslog::LOG_LOCAL6;
			$LogFacilities{LOG_LOCAL7()}   = Unix::Syslog::LOG_LOCAL7;
	                ';
		};

	# These linea are necessary!
	foreach (@LogLevels)           { my $tmpVar = $_; };
	foreach (keys(%LogOptions))    { my $tmpVar = $_; };
	foreach (keys(%LogFacilities)) { my $tmpVar = $_; };

	if ($@) { croak $@; };
	if ($^W) { carp "Syslog functionality enabled\n"; };
	my $tmpVar = $OpenLog.$CloseLog.$PutMsg; # This string is necessary.
	return 1;
	};

sub export_fail
	{
	shift;
	if ($_[0] eq 'nosyslog')
		{
		shift;
		#$InitSyslog    = undef;
		$SyslogEnabled = 0;
		if ($^W) { carp "Syslog functionality disabled\n"; };
		}
	elsif ($_[0] eq 'syslog')
		{
		shift;
		if ($InitSyslog && !$OpenLog)
			{ &{$InitSyslog}(); };
		}
	return @_;
	};

# Preloaded methods go here.

my $FileReOpen = sub
	{
	my ($self) = @_;

	my @tm = POSIX::localtime(POSIX::time());
	my $NewName = POSIX::strftime($self->{'LogFileNameTemplate'}, @tm)
		or confess "Can not create log file name from template \"".SafeStr($self->{'LogFileNameTemplate'})."\"\n";

	if ($self->{'LogFileHandler'} &&
	    defined($self->{'LogFileNameCurrent'}) &&
	    ($NewName eq $self->{'LogFileNameCurrent'}))
		{ return $self->{'LogFileNameCurrent'}; };

	$self->{'LogFileNameCurrent'} = $NewName;

	if ($self->{'LogFileHandler'})
		{ $self->{'LogFileHandler'}->close(); };

	if (!length($NewName))
		{ return $NewName; };

	File::Path::mkpath(File::Basename::dirname($NewName), 0, $self->{'DirPerms'});

	$self->{'LogFileHandler'} = IO::File->new($NewName, ($self->{'Truncate'} ? '>' : '>>'))
		or return;
	if (chmod($self->{'FilePerms'}, $NewName) < 1)
		{ carp sprintf("Can not change file \"%s\" permissions to '%04o'\n", SafeStr($NewName), $self->{'FilePerms'}); };

	autoflush {$self->{'LogFileHandler'}} 1;

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

sub new($%)
	{
	my ($class, %LogParam) = @_;

	if ($SyslogEnabled && !$OpenLog)
		{ &{$InitSyslog}(); };

	my %DefParam = ('Ident'     => $0,
	                'Level'     => 6,
	                'StdErr'    => 0,
	                'SysLog'    => 1,
	                'DirPerms'  => 0750,
	                'FilePerms' => 0640,
	                'Truncate'  => 0,
	                'Options'   => LOG_PID() | LOG_CONS(),
	                'Facility'  => LOG_USER(),
	                'SafeStr'   => 1,
	                );

	foreach (keys(%DefParam))
		{
		if (!defined($LogParam{$_}))
			{ $LogParam{$_} = $DefParam{$_}; };
		};

	if (!defined($LogFacilities{$LogParam{'Facility'}}))
		{
                cluck sprintf("Unknown facility \"%s\", use the default facility \"%s\"\n", SafeStr($LogParam{'Facility'}), SafeStr($DefParam{'Facility'}));
		$LogParam{'Facility'} = $DefParam{'Facility'};
		};

	my $self = {'Ident'               => SafeStr($LogParam{Ident}),
	            'Level'               => $LogParam{'Level'},
	            'Facility'            => $LogFacilities{$LogParam{'Facility'}},
	            'StdErr'              => $LogParam{'StdErr'},
	            'SysLog'              => ($LogParam{'SysLog'} && $SyslogEnabled),
	            'SafeStr'             => $LogParam{'SafeStr'},
	            'LogFileNameTemplate' => $LogParam{'LogFile'},
	            'Truncate'            => $LogParam{'Truncate'},
	            'DirPerms'            => $LogParam{'DirPerms'},
	            'FilePerms'           => $LogParam{'FilePerms'},
	            'LogFileNameCurrent'  => '',
	            'LogFileHandler'      => undef,
         };

	if ($OpenLog)
		{
		$self->{'Handler'} = &{$OpenLog}($self->{'Ident'}, &{$CalcOpt}($LogParam{'Options'}), $self->{'Facility'});
		if (!$self->{'Handler'})
			{
			$! .= ' '.$@;
			return;
			};
		};

	if (defined($self->{'LogFileNameTemplate'}))
		{
		&{$FileReOpen}($self);
		if (!defined($self->{'LogFileNameTemplate'}))
			{
			$! = sprintf("Can not open file \"%s\": %s", SafeStr($self->{'LogFileNameCurrent'}), $!);
			Close($self);
			return;
			};
		};

	return bless $self => $class;
	};

sub emergency($$@)
	{ return Message(shift, LOG_EMERG(),   @_); };
sub alert($$@)
	{ return Message(shift, LOG_ALERT(),   @_); };
sub critical($$@)
	{ return Message(shift, LOG_CRIT(),    @_); };
sub error($$@)
	{ return Message(shift, LOG_ERR(),     @_); };
sub warning($$@)
	{ return Message(shift, LOG_WARNING(), @_); };
sub notice($$@)
	{ return Message(shift, LOG_NOTICE(),  @_); };
sub info($$@)
	{ return Message(shift, LOG_INFO(),    @_); };
sub debug($$@)
	{ return Message(shift, LOG_DEBUG(),   @_); };

sub Message($$$@)
	{
	my ($self, $Level, $Format, @Args) = @_;

	if    ($Level < 0)
		{
                if ($^W) { cluck "Log level \"$Level\" adjusted from \"$Level\" to \"0\"\n"; };
		$Level = 0;
		}
	elsif ($Level > $#LogLevels)
		{
                if ($^W) { cluck "Log level \"$Level\" adjusted from \"$Level\" to \"$#LogLevels\"\n"; };
		$Level = $#LogLevels;
		};

	if ($Level <= $self->{Level})
		{
		my $Str = $self->{'SafeStr'} ? SafeStr(sprintf($Format, @Args)) : sprintf($Format, @Args);

		if ($self->{'StdErr'})
			{ print STDERR localtime()." $Level $Str\n"; };

		if ($PutMsg)
			{ &{$PutMsg}($self, $LogLevels[$Level], $Str); };

		if (defined($self->{'LogFileNameTemplate'}))
			{
			if (!(&{$FileReOpen}($self)))
				{
				$! = sprintf("Can not open file \"%s\": %s", SafeStr($self->{'LogFileNameCurrent'}), $!);
				return;
				};
			if (!(print {$self->{'LogFileHandler'}} localtime()." $Level $Str\n"))
				{
				$! = sprintf("Can not write to the file \"%s\": %s", SafeStr($self->{'LogFileNameCurrent'}), $!);
				return;
				};
			};
		};
	return 1;
	};

sub Level($$)
	{
	my $Return = $_[0]->{Level};
	if (defined($_[1]))
		{ $_[0]->{Level} = $_[1]; };
	return $Return;
	};

sub SysLog($$)
	{
	my $Return = ($_[0]->{'SysLog'}  && $SyslogEnabled);
	if (defined($_[1]))
		{ $_[0]->{'SysLog'} = ($_[1]  && $SyslogEnabled); };
	return $Return;
	};

sub StdErr($$)
	{
	my $Return = $_[0]->{'StdErr'};
	if (defined($_[1]))
		{ $_[0]->{'StdErr'} = $_[1]; };
	return $Return;
	};

sub LogFile($$)
	{
	if (defined($_[1]))
		{ $_[0]->{'LogFileNameTemplate'} = $_[1]; };
	if (defined($_[2]))
		{ $_[0]->{'FilePerms'} = $_[2]; };
	return $_[0]->{'LogFileNameCurrent'};
	};

sub Permissions($$$)
	{
	my @Return = ($_[0]->{'FilePerms'}, $_[0]->{'DirPerms'});
	if (defined($_[1]))
		{ $_[0]->{'FilePerms'} = $_[1]; };
	if (defined($_[2]))
		{ $_[0]->{'DirPerms'}  = $_[2]; };
	return (wantarray ? @Return : $Return[0]);
	};

sub Truncate($$)
	{
	my $Return = $_[0]->{'Truncate'};
	if (defined($_[1]))
		{ $_[0]->{'Truncate'} = $_[1]; };
	return $Return;
	};

sub CloseLogFile
	{
	if ($_[0]->{'LogFileHandler'})
		{ $_[0]->{'LogFileHandler'}->close(); };
	$_[0]->{'LogFileHandler'} = undef;
	};

sub Close($)
	{
	if ($CloseLog)
		{ &{$CloseLog}($_[0]); };
	$_[0]->{Handler} = undef;
	#
	if (defined($_[0]->{'LogFileHandler'}))
		{ $_[0]->{'LogFileHandler'}->close(); };
	$_[0]->{'LogFileHandler'} = undef;
	};

sub SafeStr($)
	{
	my $Str = shift
		or return '!UNDEF!';
	$Str =~ s{ ([\x00-\x1f\xff\\]) } { sprintf("\\x%2.2X", ord($1)) }gsex;
	return $Str;
	};

1;
__END__