1# vim: filetype=perl :
2use strict;
3use warnings;
4use Time::Local qw< timelocal timegm >;
5
6use Test::More tests => 38;    # last test to print
7
8#use Test::More 'no_plan';
9
10my $start;
11BEGIN { $start = time() }
12
13use Log::Log4perl::Tiny qw( :levels );
14
15use lib 't';
16use TestLLT qw( set_logger log_is log_like );
17
18my $logger = Log::Log4perl::Tiny::get_logger();
19ok($logger, 'got a logger instance');
20
21$logger->level($INFO);
22set_logger($logger);
23
24my $hostname = eval {
25   require Sys::Hostname;
26   Sys::Hostname::hostname();
27} || '';
28
29my @tests = (
30   ['%c', ['whatever'], 'main'],
31   ['%C', ['whatever'], 'main'],
32   ['%d', ['whatever'], qr{\A\d{4}/\d\d/\d\d \d\d:\d\d:\d\d\z}],
33   [
34      '%D', ['whatever'],
35      qr<\A\d{4}-\d\d-\d\d \d\d:\d\d:\d\d.\d{6}[-+]\d{4}\z>
36   ],
37   [
38      '%{utc}D', ['whatever'],
39      qr<\A\d{4}-\d\d-\d\d \d\d:\d\d:\d\d.\d{6}\+0000\z>
40   ],
41   [
42      '%{local}D', ['whatever'],
43      qr<\A\d{4}-\d\d-\d\d \d\d:\d\d:\d\d.\d{6}[-+]\d{4}\z>
44   ],
45   ['%F', ['whatever'], qr{\At[/\\]05\.format\.t\z}],
46   ['%H', ['whatever'], $hostname],
47   [
48      '%l', ['whatever'],
49      qr{\Amain::__ANON__ t[/\\]05\.format\.t \(\d+\)\z}
50   ],
51   ['%L', ['whatever'], qr{\A\d+\z}],
52   ['%m', [qw( frozz buzz )], 'frozzbuzz'],
53   ['%M', ['whatever'], 'main::__ANON__'],
54   ['%n', ['whatever'], "\n"],
55   ['%p', ['whatever'], 'INFO'],
56   ['%P', ['whatever'], $$],
57   ['%r', ['whatever'], qr{\A\d+\z}],
58   ['%R', ['whatever'], qr{\A\d+\z}],
59   [
60      '%T', ['whatever'],
61      qr{(?mxs:
62         \A
63            main::__ANON__ .*? called\ at\ t[/\\]TestLLT.*
64            ,\ TestLLT::log_like .*? called\ at\ t[/\\]05\.format\.t
65            \ line\ \d+
66         )}
67   ],
68   ['%m%n', [qw( foo bar )], "foobar$/"],
69   [
70      '[%d] [%-5p] %m%n',
71      ['whatever', 'you', 'like'],
72qr{\A\[\d{4}/\d\d/\d\d \d\d:\d\d:\d\d\] \[INFO \] whateveryoulike\n\z}
73   ],
74   ['%{}n', ['whatever'], "%{}n"],
75   ['%%n',  ['whatever'], "%n"],
76   ['%%',   ['whatever'], "%"],
77   ['%',    ['whatever'], "%"],
78);
79
80for my $test (@tests) {
81   my ($format, $input, $output) = @$test;
82   $logger->format($format);
83   $output = $output->() if ref($output) eq 'CODE';
84   if (ref $output) {
85      log_like { $logger->info(@$input) } $output, "format: '$format'";
86   }
87   else {
88      log_is { $logger->info(@$input) } $output, "format: '$format'";
89   }
90} ## end for my $test (@tests)
91
92# Ensure that %n is not dependent on $/ or $\
93{
94   local $/;
95   local $\;
96   $logger->format('%n');
97   log_is { $logger->info('whatever') } "\n",
98     'format: "%n" with $/ and $\ undefined';
99}
100
101{
102   my $collector = '';
103   open my $fh, '>', \$collector;
104   $logger->fh($fh);
105   $logger->format('%D%n%{utc}D%n%{local}D');
106   $logger->info('whatever');
107   close $fh;
108
109   my ($default, $utc, $local) = split /\n/, $collector;
110   is $default, $local, 'default and local are the same';
111
112   my @ts = map {
113      my @time = m{
114         (\d+) - (\d+) - (\d+)  # date
115         \s+
116         (\d+) : (\d+) : (\d+)  # time
117      }mxs;
118      $time[0] -= 1900;
119      $time[1]--;
120      [reverse @time];
121   } ($utc, $local);
122
123   is_deeply timegm(@{$ts[0]}), timelocal(@{$ts[1]}),
124     'local and UTC refer to same time';
125}
126
127# Ensure %r and %R return milliseconds
128{
129   sleep 1
130     while time() <= $start + 2;    # ensure we go beyond 1000 milliseconds
131      # 2015-01-01 we have to sleep until we go around 2000 milliseconds to
132    # be sure we are beyond 1000 milliseconds, got one test complain because
133    # we arrived at 999 (on Windows).
134
135   my $collector = '';
136   open my $fh, '>', \$collector;
137   $logger->fh($fh);
138   $logger->format('%r %R');
139   $logger->info('whatever');
140   close $fh;
141
142   my $stop  = time();
143   my $upper = (1 + $stop - $start) * 1000;
144
145   my ($r, $R) = split /\s/, $collector;
146   like($r, qr/\A\d+\z/, '%r has only digits');
147   like($R, qr/\A\d+\z/, '%R has only digits');
148   ok($r >= $R, "%r ($r) is greater or equal to %R ($R)");
149   ok($r >= 1000,
150      "%r ($r) is greater than or equal to 1000 (waited one second)");
151   ok($r < $upper,
152      "%r ($r) is lower than other milliseconds benchmark ($upper)");
153   ok($R >= 1000, "%R ($R) is greater than or equal to 1000");
154}
155
156# Ensure %R gets reset
157{
158   my $collector = '';
159   open my $fh, '>', \$collector;
160   $logger->fh($fh);
161   $logger->format('%r %R');
162   $logger->info('whatever');
163   close $fh;
164
165   my $stop  = time();
166   my $upper = (1 + $stop - $start) * 1000;
167
168   my ($r, $R) = split /\s/, $collector;
169   ok($r >= $R + 1000, "new call, %r ($r) is 'much' greater than %R ($R)");
170}
171
172# Extension: %e
173for my $test (
174   ['%{foo}e', {foo => 'bar'}, 'bar'],
175   [
176      '%{foo-sub}e',
177      {
178         'foo-sub' => sub { 'bar' }
179      },
180      'bar'
181   ],
182   [
183      '%{foo-sub-tod}e',
184      {
185         'foo-sub-tod' => sub { return join '.', @{$_[0]{tod}} }
186      },
187      qr{(?mxs: \A \d+ \. \d+ \z)},
188   ],
189  )
190{
191   my ($format, $locals, $expected) = @$test;
192
193   delete $logger->{loglocals};
194   $logger->loglocal($_ => $locals->{$_}) for keys %$locals;
195
196   my $collector = '';
197   open my $fh, '>', \$collector;
198   $logger->fh($fh);
199   $logger->format($format);
200   $logger->info('whatever');
201   close $fh;
202
203   ref($expected)
204     ? like($collector, $expected, $format)
205     : is($collector, $expected, $format);
206} ## end for my $test (['%{foo}e'...])
207