1use strict;
2use warnings FATAL => 'all';
3
4use Test::More 0.88;
5
6use File::Spec;
7use File::Temp qw( tempdir );
8use Log::Dispatch;
9
10my $dir = tempdir( CLEANUP => 1 );
11
12# test that the same handle is returned if close-on-write is not set...
13
14{
15    my $logger = Log::Dispatch->new(
16        outputs => [
17            [
18                'File',
19                min_level => 'debug',
20                newline   => 1,
21                name      => 'no_caw',
22                filename  => File::Spec->catfile( $dir, 'no_caw.log' ),
23                close_after_write => 0,
24            ],
25            [
26                'File',
27                min_level         => 'debug',
28                newline           => 1,
29                name              => 'caw',
30                filename          => File::Spec->catfile( $dir, 'caw.log' ),
31                close_after_write => 1,
32            ],
33        ],
34    );
35
36    ok(
37        $logger->output('no_caw')->{fh},
38        'no_caw output has created a fh before first write'
39    );
40    ok(
41        !$logger->output('caw')->{fh},
42        'caw output has not created a fh before first write'
43    );
44
45    $logger->log( level => 'info', message => 'first message' );
46    is(
47        _slurp( $logger->output('no_caw')->{filename} ),
48        "first message\n",
49        'first line from no_caw output'
50    );
51    is(
52        _slurp( $logger->output('caw')->{filename} ),
53        "first message\n",
54        'first line from caw output'
55    );
56
57    my %handle = (
58        no_caw => $logger->output('no_caw')->{fh},
59        caw    => $logger->output('caw')->{fh},
60    );
61
62    $logger->log( level => 'info', message => 'second message' );
63
64    is(
65        _slurp( $logger->output('no_caw')->{filename} ),
66        "first message\nsecond message\n",
67        'full content from no_caw output'
68    );
69    is(
70        _slurp( $logger->output('caw')->{filename} ),
71        "first message\nsecond message\n",
72        'full content from caw output'
73    );
74
75    # check the filehandles again...
76    is(
77        $logger->output('no_caw')->{fh},
78        $handle{no_caw},
79        'handle has not changed when not using CAW'
80    );
81    is(
82        $logger->output('caw')->{fh},
83        undef,
84        'handle is deleted when using CAW'
85    );
86}
87
88done_testing();
89
90sub _slurp {
91    open my $fh, '<', $_[0]
92        or die "Cannot read $_[0]: $!";
93    my $s = do {
94        local $/ = undef;
95        <$fh>;
96    };
97    close $fh or die $!;
98    return $s;
99}
100