use
vars
qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS)
;
@ISA
=
qw(Exporter)
;
@EXPORT
=
qw()
;
@EXPORT_OK
=
qw(LOG_EMERG LOG_ALERT LOG_CRIT LOG_ERR
LOG_WARNING LOG_NOTICE LOG_INFO LOG_DEBUG
LOG_CONS LOG_NDELAY LOG_PERROR LOG_PID
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)
;
%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)
]);
$VERSION
=
'0.04'
;
my
@LogLevels
= ();
my
%LogOptions
= ();
my
%LogFacilities
= ();
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; };
sub
LOG_CONS() {
return
$LogOptions
{
'LOG_CONS'
}; };
sub
LOG_NDELAY() {
return
$LogOptions
{
'LOG_NDELAY'
}; };
sub
LOG_PID() {
return
$LogOptions
{
'LOG_PID'
}; };
sub
LOG_AUTH() {
return
$LogFacilities
{
'LOG_AUTH'
}; };
sub
LOG_AUTHPRIV() {
return
$LogFacilities
{
'LOG_AUTHPRIV'
}; };
sub
LOG_CRON() {
return
$LogFacilities
{
'LOG_CRON'
}; };
sub
LOG_DAEMON() {
return
$LogFacilities
{
'LOG_DAEMON'
}; };
sub
LOG_FTP() {
return
$LogFacilities
{
'LOG_FTP'
}; };
sub
LOG_KERN() {
return
$LogFacilities
{
'LOG_KERN'
}; };
sub
LOG_LPR() {
return
$LogFacilities
{
'LOG_LPR'
}; };
sub
LOG_MAIL() {
return
$LogFacilities
{
'LOG_MAIL'
}; };
sub
LOG_NEWS() {
return
$LogFacilities
{
'LOG_NEWS'
}; };
sub
LOG_SYSLOG() {
return
$LogFacilities
{
'LOG_SYSLOG'
}; };
sub
LOG_USER() {
return
$LogFacilities
{
'LOG_USER'
}; };
sub
LOG_UUCP() {
return
$LogFacilities
{
'LOG_UUCP'
}; };
sub
LOG_LOCAL0() {
return
$LogFacilities
{
'LOG_LOCAL0'
}; };
sub
LOG_LOCAL1() {
return
$LogFacilities
{
'LOG_LOCAL1'
}; };
sub
LOG_LOCAL2() {
return
$LogFacilities
{
'LOG_LOCAL2'
}; };
sub
LOG_LOCAL3() {
return
$LogFacilities
{
'LOG_LOCAL3'
}; };
sub
LOG_LOCAL4() {
return
$LogFacilities
{
'LOG_LOCAL4'
}; };
sub
LOG_LOCAL5() {
return
$LogFacilities
{
'LOG_LOCAL5'
}; };
sub
LOG_LOCAL6() {
return
$LogFacilities
{
'LOG_LOCAL6'
}; };
sub
LOG_LOCAL7() {
return
$LogFacilities
{
'LOG_LOCAL7'
}; };
my
$OpenLog
=
undef
;
my
$CloseLog
=
undef
;
my
$PutMsg
=
undef
;
if
(
"\L$^O"
=~ m/win32/ )
{
$OpenLog
=
sub
{
return
Win32::EventLog->new(
$_
[0],
$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;
$LogOptions
{
"LOG_CONS"
} = 0;
$LogOptions
{
"LOG_NDELAY"
} = 0;
$LogOptions
{
"LOG_PID"
} = 0;
$LogFacilities
{
"LOG_AUTH"
} = 1;
$LogFacilities
{
"LOG_CRON"
} = 2;
$LogFacilities
{
"LOG_DAEMON"
} = 3;
$LogFacilities
{
"LOG_KERN"
} = 4;
$LogFacilities
{
"LOG_LPR"
} = 5;
$LogFacilities
{
"LOG_MAIL"
} = 6;
$LogFacilities
{
"LOG_NEWS"
} = 7;
$LogFacilities
{
"LOG_SYSLOG"
} = 8;
$LogFacilities
{
"LOG_USER"
} = 9;
$LogFacilities
{
"LOG_UUCP"
} = 10;
$LogFacilities
{
"LOG_LOCAL0"
} = 11;
$LogFacilities
{
"LOG_LOCAL1"
} = 12;
$LogFacilities
{
"LOG_LOCAL2"
} = 13;
$LogFacilities
{
"LOG_LOCAL3"
} = 14;
$LogFacilities
{
"LOG_LOCAL4"
} = 15;
$LogFacilities
{
"LOG_LOCAL5"
} = 16;
$LogFacilities
{
"LOG_LOCAL6"
} = 17;
$LogFacilities
{
"LOG_LOCAL7"
} = 18;
';
}
else
{
$OpenLog
=
sub
{
my
$Ident
=
$_
[0];
Unix::Syslog::openlog(
$Ident
,
$_
[1],
$_
[2]);
return
1;
};
$CloseLog
=
sub
{ Unix::Syslog::closelog; };
$PutMsg
=
sub
{ Unix::Syslog::syslog(
$_
[1],
"%s"
,
$_
[2]); };
$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;
$LogOptions
{
"LOG_CONS"
} = Unix::Syslog::LOG_CONS;
$LogOptions
{
"LOG_NDELAY"
} = Unix::Syslog::LOG_NDELAY;
$LogOptions
{
"LOG_PID"
} = Unix::Syslog::LOG_PID;
$LogFacilities
{
"LOG_AUTH"
} = Unix::Syslog::LOG_AUTH;
$LogFacilities
{
"LOG_CRON"
} = Unix::Syslog::LOG_CRON;
$LogFacilities
{
"LOG_DAEMON"
} = Unix::Syslog::LOG_DAEMON;
$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;
';
};
if
($@) { croak $@; };
my
%LogParam
= (
Ident
=> $0,
Level
=> 6,
StdErr
=> 0,
Options
=> LOG_PID | LOG_CONS,
Facility
=> LOG_USER);
my
$CleanStr
=
sub
($)
{
if
(!
defined
(
$_
[0])) {
return
; };
my
%BadChars
= (
"\x00"
=>
"\\x00"
,
"\x01"
=>
"\\x01"
,
"\x02"
=>
"\\x02"
,
"\x03"
=>
"\\x03"
,
"\x04"
=>
"\\x04"
,
"\x05"
=>
"\\x05"
,
"\x06"
=>
"\\x06"
,
"\a"
=>
"\\a"
,
"\b"
=>
"\\b"
,
"\t"
=>
"\\t"
,
"\n"
=>
"\\n"
,
"\x0b"
=>
"\\x0b"
,
"\f"
=>
"\\f"
,
"\r"
=>
"\\r"
,
"\x0e"
=>
"\\x0e"
,
"\x0f"
=>
"\\x0f"
,
"\x10"
=>
"\\x10"
,
"\x11"
=>
"\\x11"
,
"\x12"
=>
"\\x12"
,
"\x13"
=>
"\\x13"
,
"\x14"
=>
"\\x14"
,
"\x15"
=>
"\\x15"
,
"\x16"
=>
"\\x16"
,
"\x17"
=>
"\\x17"
,
"\x18"
=>
"\\x18"
,
"\x19"
=>
"\\x19"
,
"\x1a"
=>
"\\x1a"
,
"\e"
=>
"\\e"
,
"\x1c"
=>
"\\x1c"
,
"\x1d"
=>
"\\x1d"
,
"\x1e"
=>
"\\x1e"
,
"\x1f"
=>
"\\x1f"
,
"\xff"
=>
"\\xff"
,
);
my
$Str
=
$_
[0];
$Str
=~ s/\A[\s\n]+//gm;
$Str
=~ s/[\s\n]+\Z//gm;
$Str
=~ s{ ( [\x00-\x1f\xff] ) } {
$BadChars
{
"$1"
} }gmex;
return
$Str
;
};
sub
new($%)
{
my
(
$class
,
%LogParam
) =
@_
;
my
$Logger
=
undef
;
$LogParam
{Ident} = &{
$CleanStr
}(
$LogParam
{Ident});
my
$Handler
=
&$OpenLog
(
$LogParam
{Ident},
$LogParam
{Options},
$LogParam
{Facility})
or croak
"Can nor create log handler!\n"
;
return
bless
{
Ident
=>
$LogParam
{Ident},
Level
=>
$LogParam
{Level},
Facility
=>
$LogParam
{Facility},
StdErr
=>
$LogParam
{StdErr},
Handler
=>
$Handler
} =>
$class
;
};
sub
Message($$$@)
{
my
(
$Self
,
$Level
,
$Format
,
@Args
) =
@_
;
if
(!
$_
[0]->{Handler})
{
carp
"Logger is closed!\n"
;
return
;
};
if
(
$Level
< 0)
{
if
($^W) { carp
"Log level \"$Level\" adjusted from \"$Level\" to \"0\"\n"
; };
$Level
= 0;
}
elsif
(
$Level
> 7)
{
if
($^W) { carp
"Log level \"$Level\" adjusted from \"$Level\" to \"7\"\n"
; };
$Level
= 7;
};
if
(
$Level
<=
$Self
->{Level})
{
my
$Str
= &{
$CleanStr
}(
sprintf
(
$Format
,
@Args
));
if
(
$Self
->{StdErr})
{
print
STDERR
localtime
().
" $Level\t$Str\n"
; };
&$PutMsg
(
$Self
,
$LogLevels
[
$Level
],
$Str
);
};
};
sub
Level($$)
{
if
(!
$_
[0]->{Handler})
{
carp
"Logger is closed!\n"
;
return
;
};
my
$Return
=
$_
[0]->{Level};
if
(
defined
(
$_
[1]))
{
$_
[0]->{Level} =
$_
[1]; };
return
$Return
;
};
sub
StdErr($$)
{
if
(!
$_
[0]->{Handler})
{
carp
"Logger is closed!\n"
;
return
;
};
my
$Return
=
$_
[0]->{StdErr};
if
(
defined
(
$_
[1]))
{
$_
[0]->{StdErr} =
$_
[1]; };
return
$Return
;
};
sub
Close($)
{
if
(!
$_
[0]->{Handler})
{
carp
"Logger is closed!\n"
;
return
;
};
&{
$CloseLog
}(
$_
[0]);
$_
[0]->{Handler} = 0;
};
1;