File: lazy-open.t

package info (click to toggle)
liblog-dispatch-perl 2.71-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 560 kB
  • sloc: perl: 1,457; sh: 24; makefile: 2
file content (68 lines) | stat: -rw-r--r-- 1,504 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
use strict;
use warnings FATAL => 'all';

use Test::More 0.88;

use File::Spec;
use File::Temp qw( tempdir );
use Log::Dispatch;

my $dir = tempdir( CLEANUP => 1 );

{
    my $logger = Log::Dispatch->new(
        outputs => [
            [
                'File',
                min_level => 'debug',
                newline   => 1,
                name      => 'lazy_open',
                filename  => File::Spec->catfile( $dir, 'lazy_open.log' ),
                lazy_open => 1,
            ],
        ],
    );

    ok(
        !$logger->output('lazy_open')->{fh},
        'lazy_open output has not created a fh before first write'
    );

    $logger->log( level => 'info', message => 'first message' );
    is(
        _slurp( $logger->output('lazy_open')->{filename} ),
        "first message\n",
        'first line from lazy_open output'
    );

    ok(
        $logger->output('lazy_open')->{fh},
        'lazy_open output has still an open fh'
    );

    $logger->log( level => 'info', message => 'second message' );

    is(
        _slurp( $logger->output('lazy_open')->{filename} ),
        "first message\nsecond message\n",
        'full content from caw output'
    );

    ok(
        $logger->output('lazy_open')->{fh},
        'lazy_open output has still an open fh'
    );
}

done_testing();

sub _slurp {
    open my $fh, '<', $_[0]
        or die "Cannot read $_[0]: $!";
    my $s = do {
        local $/ = undef;
        <$fh>;
    };
    close $fh or die $!;
    return $s;
}