1#!/usr/bin/perl
2
3BEGIN {
4    if($ENV{INTERNAL_DEBUG}) {
5        require Log::Log4perl::InternalDebug;
6        Log::Log4perl::InternalDebug->enable();
7    }
8}
9
10use strict;
11use warnings;
12
13use Test::More tests => 2;
14use File::Spec;
15
16use Log::Log4perl;
17use Log::Log4perl::Layout::PatternLayout;
18use Log::Log4perl::Level;
19use Log::Log4perl::Appender::TestBuffer;
20
21my ($SECONDS, $MICRO_SECONDS) = ($^T, 100_000); # Script's startup time
22my $DEBUG = 0;
23
24
25# Pretend that the script was at sleep
26sub fake_sleep ($) {
27    my ($seconds) = @_;
28    $SECONDS += $seconds;
29    $MICRO_SECONDS = ($MICRO_SECONDS + 1_000) % 1_000_000;
30}
31
32sub fake_time {
33    return ($SECONDS, $MICRO_SECONDS);
34}
35
36
37
38my $logger = create_logger();
39
40
41# Start some logging
42$logger->info("Start");
43
44fake_sleep(1);
45$logger->debug("Pause: 1 sec");
46
47fake_sleep(2);
48$logger->info("Pause: 2 secs");
49
50fake_sleep(1);
51$logger->debug("Pause: 1 sec");
52
53$logger->warn("End");
54
55#  Debug traces to be turned on when troubleshooting
56if ($DEBUG) {
57    # Get the contents of the buffers
58    foreach my $appender (qw(A B)) {
59        my $buffer = Log::Log4perl::Appender::TestBuffer->by_name($appender)->buffer();
60        diag("========= $appender ==========");
61        diag($buffer);
62    }
63}
64
65# Get the elapsed times so far
66my @a = get_all_elapsed_ms('A');
67my @b = get_all_elapsed_ms('B');
68
69is_deeply(
70    \@a,
71    [
72        'A 0ms Start [0ms]',
73        'A 1001ms Pause: 1 sec [1001ms]',
74        'A 2001ms Pause: 2 secs [3002ms]',
75        'A 1001ms Pause: 1 sec [4003ms]',
76        'A 0ms End [4003ms]',
77    ]
78);
79
80is_deeply(
81    \@b,
82    [
83        'B 0ms Start [0ms]',
84        'B 3002ms Pause: 2 secs [3002ms]',
85        'B 1001ms End [4003ms]',
86    ]
87);
88
89
90#
91# Returns the elapsed times logged so far.
92#
93sub get_all_elapsed_ms {
94    my ($categoty) = @_;
95
96    return split /\n/,
97        Log::Log4perl::Appender::TestBuffer->by_name($categoty)->buffer()
98    ;
99}
100
101
102#
103# Initialize the logging system with a twist. Here we inject our own time
104# function into the appenders. This way we will be able to control time and
105# ensure a deterministic behaviour that can always be reproduced which is ideal
106# for unit tests.
107#
108# We need to create the appenders by hand in order to add a custom time
109# function. The final outcome should be something similar to the following
110# configuration:
111#
112#   log4perl.logger.test = ALL, A, B
113#
114#   log4perl.appender.A = Log::Log4perl::Appender::TestBuffer
115#   log4perl.appender.A.layout = Log::Log4perl::Layout::PatternLayout
116#   log4perl.appender.A.layout.ConversionPattern = A %Rms %m [%rms]%n
117#   log4perl.appender.A.Threshold = ALL
118#
119#   log4perl.appender.B = Log::Log4perl::Appender::TestBuffer
120#   log4perl.appender.B.layout = Log::Log4perl::Layout::PatternLayout
121#   log4perl.appender.B.layout.ConversionPattern = B %Rms %m [%rms]%n
122#   log4perl.appender.B.Threshold = INFO
123#
124sub create_logger {
125
126    my $logger = Log::Log4perl->get_logger("test");
127    $logger->level($ALL);
128
129    my %appenders = (
130        A => $ALL,
131        B => $INFO,
132    );
133
134    # Inject the time function into the appenders
135    while (my ($name, $threshold) = each %appenders) {
136        my $appender = Log::Log4perl::Appender->new(
137            "Log::Log4perl::Appender::TestBuffer",
138            name => $name,
139        );
140        if ($name eq 'B') {
141            $appender->threshold($INFO);
142        }
143
144        my $layout = Log::Log4perl::Layout::PatternLayout->new(
145            {time_function => \&fake_time},
146            "$name %Rms %m [%rms]%n"
147        );
148        $appender->layout($layout);
149        $logger->add_appender($appender);
150    }
151
152    return $logger;
153}
154
155