#!perl -T
use
POSIX
qw( strftime )
;
my
$counter
= 0;
{
my
$hostname
= hostname();
my
$msg
=
"Stop by this disaster town"
;
my
$logfile
=
"log-fine-formatter-template.log"
;
my
$log_level
=
Log::Fine::Formatter::Template->new(
template
=>
"%%LEVEL%%"
,
timestamp_format
=>
"%Y%m%d"
);
isa_ok(
$log_level
,
"Log::Fine::Formatter::Template"
);
can_ok(
$log_level
,
"name"
);
can_ok(
$log_level
,
"format"
);
ok(
$log_level
->name() =~ /\w\d+$/);
my
$log_msg
=
Log::Fine::Formatter::Template->new(
template
=>
"%%MSG%%"
,
timestamp_format
=>
"%Y%m%d"
);
isa_ok(
$log_msg
,
"Log::Fine::Formatter::Template"
);
can_ok(
$log_msg
,
"name"
);
can_ok(
$log_msg
,
"format"
);
ok(
$log_msg
->name() =~ /\w\d+$/);
my
$log_package
=
Log::Fine::Formatter::Template->new(
template
=>
"[%%TIME%%] %%LEVEL%% %%PACKAGE%% %%SUBROUT%% %%MSG%%"
,
timestamp_format
=>
"%H:%M:%S"
);
isa_ok(
$log_package
,
"Log::Fine::Formatter::Template"
);
can_ok(
$log_package
,
"name"
);
can_ok(
$log_package
,
"format"
);
ok(
$log_package
->name() =~ /\w\d+$/);
my
$log_filename
=
Log::Fine::Formatter::Template->new(
template
=>
"[%%TIME%%] %%LEVEL%% %%FILENAME%%:%%LINENO%% %%MSG%%"
,
timestamp_format
=>
"%H:%M:%S"
);
isa_ok(
$log_filename
,
"Log::Fine::Formatter::Template"
);
can_ok(
$log_filename
,
"name"
);
can_ok(
$log_filename
,
"format"
);
ok(
$log_filename
->name() =~ /\w\d+$/);
my
$log_shorthost
=
Log::Fine::Formatter::Template->new(
template
=>
"%%HOSTSHORT%%"
,
timestamp_format
=>
"%Y%m%d"
);
isa_ok(
$log_shorthost
,
"Log::Fine::Formatter::Template"
);
can_ok(
$log_shorthost
,
"name"
);
can_ok(
$log_shorthost
,
"format"
);
ok(
$log_shorthost
->name() =~ /\w\d+$/);
my
$log_longhost
=
Log::Fine::Formatter::Template->new(
template
=>
"%%HOSTLONG%%"
,
timestamp_format
=>
"%Y%m%d"
);
isa_ok(
$log_longhost
,
"Log::Fine::Formatter::Template"
);
can_ok(
$log_longhost
,
"name"
);
can_ok(
$log_longhost
,
"format"
);
ok(
$log_longhost
->name() =~ /\w\d+$/);
my
$log_user
=
Log::Fine::Formatter::Template->new(
template
=>
"%%USER%%"
,
timestamp_format
=>
"%Y%m%d"
);
isa_ok(
$log_user
,
"Log::Fine::Formatter::Template"
);
can_ok(
$log_user
,
"name"
);
can_ok(
$log_user
,
"format"
);
ok(
$log_user
->name() =~ /\w\d+$/);
my
$log_group
=
Log::Fine::Formatter::Template->new(
template
=>
"%%GROUP%%"
,
timestamp_format
=>
"%Y%m%d"
);
isa_ok(
$log_group
,
"Log::Fine::Formatter::Template"
);
can_ok(
$log_group
,
"name"
);
can_ok(
$log_group
,
"format"
);
ok(
$log_group
->name() =~ /\w\d+$/);
my
$log_custom
=
Log::Fine::Formatter::Template->new(
template
=>
"%%FOOBAR%%"
,
timestamp_format
=>
"%Y%m%d"
,
custom_placeholders
=> {
foobar
=> \
&countplus
,
});
ok(
$log_custom
->name() =~ /\w\d+$/);
eval
{
my
$log_badcustom
=
Log::Fine::Formatter::Template->new(
template
=>
"%%FOOBAR%% %%FooBar%%"
,
timestamp_format
=>
"%Y%m%d"
,
custom_placeholders
=> {
foobar
=> \
&countplus
,
FooBar
=> \
&countplus
,
});
};
ok($@ =~ /^Duplicate placeholder/);
my
$log_time
=
Log::Fine::Formatter::Template->new(
template
=>
"%%TIME%%"
,
timestamp_format
=>
"%Y%m"
);
isa_ok(
$log_time
,
"Log::Fine::Formatter::Template"
);
can_ok(
$log_time
,
"name"
);
can_ok(
$log_time
,
"format"
);
ok(
$log_time
->name() =~ /\w\d+$/);
ok(
$log_time
->
format
(INFO,
$msg
, 0) eq strftime(
"%Y%m"
,
localtime
(
time
)));
ok(
$log_level
->
format
(INFO,
$msg
, 0) eq
"INFO"
);
ok(
$log_msg
->
format
(INFO,
$msg
, 0) eq
$msg
);
ok(
$log_package
->
format
(INFO,
$msg
, 0) =~ /^\[.*?\] INFO main main
$msg
/);
ok(
$log_filename
->
format
(INFO,
$msg
, 0) =~ /^\[.*?\] INFO .*?\.t\:\d+
$msg
/);
ok(myfunc(
$log_package
,
$msg
) =~ /^\[.*?\] INFO main main\:\:myfunc
$msg
/);
ok(myfunc(
$log_filename
,
$msg
) =~ /^\[.*?\] INFO .*?\.t\:\d+
$msg
/);
ok(This::Test::doIt(
$log_package
,
$msg
) =~ /^\[.*?\] WARN This\:\:Test This\:\:Test\:\:doIt
$msg
/);
ok(This::Test::doIt(
$log_filename
,
$msg
) =~ /^\[.*?\] WARN .*?\.t\:\d+
$msg
/);
ok(
$log_longhost
->
format
(INFO,
$msg
, 0) =~ /
$hostname
/);
ok(
$log_shorthost
->
format
(INFO,
$msg
, 0) =~ /\w/);
ok(
$log_custom
->
format
(INFO,
$msg
, 0) =~ /^
$counter
/);
ok(
$log_custom
->
format
(INFO,
$msg
, 0) =~ /^
$counter
/);
SKIP: {
skip
"Cannot accurately test user and group placeholders under MSWin32"
, 2
if
($^O =~ /MSWin32/);
ok(
$log_user
->
format
(INFO,
$msg
, 0) eq
getpwuid
($<));
ok(
$log_group
->
format
(INFO,
$msg
, 0) eq
getgrgid
((
split
(
" "
, $())[0]));
}
my
$log_basic
=
Log::Fine::Formatter::Template->new(
template
=>
"[%%time%%] %%level%% %%msg%%"
,
timestamp_format
=> Log::Fine::Formatter->LOG_TIMESTAMP_FORMAT);
isa_ok(
$log_basic
,
"Log::Fine::Formatter::Template"
);
can_ok(
$log_basic
,
"name"
);
can_ok(
$log_basic
,
"format"
);
ok(
$log_basic
->name() =~ /\w\d+$/);
ok(
$log_basic
->
format
(INFO,
$msg
, 1) =~ /^\[.*?\] \w+
$msg
/);
my
$logger
= Log::Fine->logger(
"formatlogger0"
);
isa_ok(
$logger
,
"Log::Fine::Logger"
);
can_ok(
$logger
,
"name"
);
can_ok(
$logger
,
"registerHandle"
);
can_ok(
$logger
,
"log"
);
ok(
$logger
->name() =~ /\w\d+$/);
unlink
$logfile
if
(-e
$logfile
);
my
$handle
=
Log::Fine::Handle::File->new(
file
=>
$logfile
,
autoflush
=> 1,
formatter
=>
Log::Fine::Formatter::Template->new(
template
=>
"[%%TIME%%] %%LEVEL%% %%SUBROUT%%:%%LINENO%% %%MSG%%\n"
,
timestamp_format
=>
"%H:%M:%S"
));
isa_ok(
$handle
,
"Log::Fine::Handle::File"
);
can_ok(
$handle
,
"name"
);
ok(
$handle
->name() =~ /\w\d+$/);
$logger
->registerHandle(
$handle
);
$logger
->
log
(DEBG,
$msg
);
logFunc(
$logger
,
$msg
);
This::Test::doFunc(
$logger
,
$msg
);
ok(-e
$logfile
);
my
$fh
= FileHandle->new(
$logfile
);
my
$logmain
= <
$fh
>;
my
$logfunc
= <
$fh
>;
my
$logpack
= <
$fh
>;
$fh
->
close
();
ok(
$logmain
=~ /^\[.*?\] DEBG main\:\d+
$msg
/);
ok(
$logfunc
=~ /^\[.*?\] NOTI main\:\:logFunc\:\d+
$msg
/);
ok(
$logpack
=~ /^\[.*?\] ERR This\:\:Test\:\:doFunc\:\d+
$msg
/);
$handle
->fileHandle()->
close
();
unlink
$logfile
;
}
sub
myfunc
{
my
$formatter
=
shift
;
my
$msg
=
shift
;
return
$formatter
->
format
(INFO,
$msg
, 0);
}
sub
logFunc
{
my
$logger
=
shift
;
my
$msg
=
shift
;
$logger
->
log
(NOTI,
$msg
);
}
sub
countplus {
return
++
$counter
; }
sub
doIt
{
my
$fmt
=
shift
;
my
$msg
=
shift
;
return
$fmt
->
format
(WARN,
$msg
, 0);
}
sub
doFunc
{
my
$log
=
shift
;
my
$msg
=
shift
;
$log
->
log
(ERR,
$msg
);
}