my
$start
;
BEGIN {
$start
=
time
() }
use
TestLLT
qw( set_logger log_is log_like )
;
my
$logger
= Log::Log4perl::Tiny::get_logger();
ok(
$logger
,
'got a logger instance'
);
$logger
->level(
$INFO
);
set_logger(
$logger
);
my
$hostname
=
eval
{
Sys::Hostname::hostname();
} ||
''
;
my
@tests
= (
[
'%c'
, [
'whatever'
],
'main'
],
[
'%C'
, [
'whatever'
],
'main'
],
[
'%d'
, [
'whatever'
],
qr{\A\d{4}
/\d\d/\d\d \d\d:\d\d:\d\d\z}],
[
'%D'
, [
'whatever'
],
qr<\A\d{4}-\d\d-\d\d \d\d:\d\d:\d\d.\d{6}[-+]\d{4}\z>
],
[
'%{utc}D'
, [
'whatever'
],
qr<\A\d{4}-\d\d-\d\d \d\d:\d\d:\d\d.\d{6}\+0000\z>
],
[
'%{local}D'
, [
'whatever'
],
qr<\A\d{4}-\d\d-\d\d \d\d:\d\d:\d\d.\d{6}[-+]\d{4}\z>
],
[
'%F'
, [
'whatever'
],
qr{\At[/\\]05\.format\.t\z}
],
[
'%H'
, [
'whatever'
],
$hostname
],
[
'%l'
, [
'whatever'
],
qr{\Amain::__ANON__ t[/\\]05\.format\.t \(\d+\)\z}
],
[
'%L'
, [
'whatever'
],
qr{\A\d+\z}
],
[
'%m'
, [
qw( frozz buzz )
],
'frozzbuzz'
],
[
'%M'
, [
'whatever'
],
'main::__ANON__'
],
[
'%n'
, [
'whatever'
],
"\n"
],
[
'%p'
, [
'whatever'
],
'INFO'
],
[
'%P'
, [
'whatever'
], $$],
[
'%r'
, [
'whatever'
],
qr{\A\d+\z}
],
[
'%R'
, [
'whatever'
],
qr{\A\d+\z}
],
[
'%T'
, [
'whatever'
],
qr{(?mxs:
\A
main::__ANON__ .*? called\ at\ t[/\\]TestLLT.*
,\ TestLLT::log_like .*? called\ at\ t[/\\]05\.format\.t
\ line\ \d+
)}
],
[
'%m%n'
, [
qw( foo bar )
],
"foobar$/"
],
[
'[%d] [%-5p] %m%n'
,
[
'whatever'
,
'you'
,
'like'
],
qr{\A\[\d{4}
/\d\d/\d\d \d\d:\d\d:\d\d\] \[INFO \] whateveryoulike\n\z}
],
[
'%{}n'
, [
'whatever'
],
"%{}n"
],
[
'%%n'
, [
'whatever'
],
"%n"
],
[
'%%'
, [
'whatever'
],
"%"
],
[
'%'
, [
'whatever'
],
"%"
],
);
for
my
$test
(
@tests
) {
my
(
$format
,
$input
,
$output
) =
@$test
;
$logger
->
format
(
$format
);
$output
=
$output
->()
if
ref
(
$output
) eq
'CODE'
;
if
(
ref
$output
) {
log_like {
$logger
->info(
@$input
) }
$output
,
"format: '$format'"
;
}
else
{
log_is {
$logger
->info(
@$input
) }
$output
,
"format: '$format'"
;
}
}
{
local
$/;
local
$\;
$logger
->
format
(
'%n'
);
log_is {
$logger
->info(
'whatever'
) }
"\n"
,
'format: "%n" with $/ and $\ undefined'
;
}
{
my
$collector
=
''
;
open
my
$fh
,
'>'
, \
$collector
;
$logger
->fh(
$fh
);
$logger
->
format
(
'%D%n%{utc}D%n%{local}D'
);
$logger
->info(
'whatever'
);
close
$fh
;
my
(
$default
,
$utc
,
$local
) =
split
/\n/,
$collector
;
is
$default
,
$local
,
'default and local are the same'
;
my
@ts
=
map
{
my
@time
= m{
(\d+) - (\d+) - (\d+)
\s+
(\d+) : (\d+) : (\d+)
}mxs;
$time
[0] -= 1900;
$time
[1]--;
[
reverse
@time
];
} (
$utc
,
$local
);
is_deeply timegm(@{
$ts
[0]}), timelocal(@{
$ts
[1]}),
'local and UTC refer to same time'
;
}
{
sleep
1
while
time
() <=
$start
+ 2;
my
$collector
=
''
;
open
my
$fh
,
'>'
, \
$collector
;
$logger
->fh(
$fh
);
$logger
->
format
(
'%r %R'
);
$logger
->info(
'whatever'
);
close
$fh
;
my
$stop
=
time
();
my
$upper
= (1 +
$stop
-
$start
) * 1000;
my
(
$r
,
$R
) =
split
/\s/,
$collector
;
like(
$r
,
qr/\A\d+\z/
,
'%r has only digits'
);
like(
$R
,
qr/\A\d+\z/
,
'%R has only digits'
);
ok(
$r
>=
$R
,
"%r ($r) is greater or equal to %R ($R)"
);
ok(
$r
>= 1000,
"%r ($r) is greater than or equal to 1000 (waited one second)"
);
ok(
$r
<
$upper
,
"%r ($r) is lower than other milliseconds benchmark ($upper)"
);
ok(
$R
>= 1000,
"%R ($R) is greater than or equal to 1000"
);
}
{
my
$collector
=
''
;
open
my
$fh
,
'>'
, \
$collector
;
$logger
->fh(
$fh
);
$logger
->
format
(
'%r %R'
);
$logger
->info(
'whatever'
);
close
$fh
;
my
$stop
=
time
();
my
$upper
= (1 +
$stop
-
$start
) * 1000;
my
(
$r
,
$R
) =
split
/\s/,
$collector
;
ok(
$r
>=
$R
+ 1000,
"new call, %r ($r) is 'much' greater than %R ($R)"
);
}
for
my
$test
(
[
'%{foo}e'
, {
foo
=>
'bar'
},
'bar'
],
[
'%{foo-sub}e'
,
{
'foo-sub'
=>
sub
{
'bar'
}
},
'bar'
],
[
'%{foo-sub-tod}e'
,
{
'foo-sub-tod'
=>
sub
{
return
join
'.'
, @{
$_
[0]{tod}} }
},
qr{(?mxs: \A \d+ \. \d+ \z)}
,
],
)
{
my
(
$format
,
$locals
,
$expected
) =
@$test
;
delete
$logger
->{loglocals};
$logger
->loglocal(
$_
=>
$locals
->{
$_
})
for
keys
%$locals
;
my
$collector
=
''
;
open
my
$fh
,
'>'
, \
$collector
;
$logger
->fh(
$fh
);
$logger
->
format
(
$format
);
$logger
->info(
'whatever'
);
close
$fh
;
ref
(
$expected
)
? like(
$collector
,
$expected
,
$format
)
: is(
$collector
,
$expected
,
$format
);
}