File: filescreen.t

package info (click to toggle)
liblog-any-perl 1.717-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 448 kB
  • sloc: perl: 1,499; makefile: 11
file content (134 lines) | stat: -rw-r--r-- 5,496 bytes parent folder | download | duplicates (4)
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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
use strict;
use warnings;
use Test::More;
use File::Temp qw(tempdir);
use Log::Any::Adapter::Util qw(cmp_deeply read_file);

plan tests => 33;
my $__FILE__ = quotemeta __FILE__;

require Log::Any::Adapter;

{
    my $tempdir = tempdir( 'name-XXXX', TMPDIR => 1, CLEANUP => 1 );
    my $file = "$tempdir/temp.log";
    Log::Any::Adapter->set( 'File', $file, log_level => 'info' );
    my $log = Log::Any->get_logger();
    ok( ! $log->is_debug, "file won't log debugs" );
    ok( $log->is_warn, "file will log warnings" );
    $log->debug("to file");
    is( scalar( read_file($file) ), '', "debug not logged to file" );
    $log->warn("to file");
    like( scalar( read_file($file) ), qr/^\[.*\] to file\n$/, "warn logged to file" );
    $log->warn("\x{263A} \x{263B}");
    like( scalar( read_file($file) ), qr/\x{263A} \x{263B}$/ms, "warn logged UTF-8 to file" );
    {
        my $file = "$tempdir/temp2.log";
        Log::Any::Adapter->set({lexically => \my $lex}, 'File', $file);
        ok( $log->is_trace, "file will log trace lexically" );
    }

    { # Test that File adapter validates log level properly
        my @warnings;
        local $SIG{__WARN__} = sub { push @warnings, $_[0] };
        Log::Any::Adapter->set( {lexically => \my $lex}, 'File', $file, log_level => 'FOOBAR' );
        my $log = Log::Any->get_logger();
        ok( $log->is_trace, "log defaults to trace level" );
        is scalar @warnings, 1, 'one warning issued';
        like $warnings[0],
            qr{Invalid log level "FOOBAR"\. Defaulting to "trace" at $__FILE__ line \d+},
            'warning is correct';
    }

    { # Test that File adapter accepts binmode properly
        my @warnings;
        local $SIG{__WARN__} = sub { push @warnings, $_[0] };
        Log::Any::Adapter->set( {lexically => \my $lex}, 'File', $file, binmode => 'raw' );
        my $log = Log::Any->get_logger();
        $log->warn("\x{263A} \x{263B}");
        like( scalar( read_file($file) ), qr/\x{263A} \x{263B}$/ms, "warn logged raw to file" );
        like $warnings[0], qr{Wide character in print}, 'got warning printing UTF-8 as raw';
    }

    { # Test that File adapter allows critical log_level
        Log::Any::Adapter->set( {lexically => \my $lex}, 'File', $file, log_level => 'emergency' );
        my $log = Log::Any->get_logger();
        ok $log->is_emergency, 'emergency log level file will log emergency';
        ok !$log->is_alert, 'emergency log level file will not log alert';
    }
}

{
    my $buf = '';
    open my $fh, ">", \$buf;
    local *STDOUT = $fh;
    Log::Any::Adapter->set('Stdout', log_level => 'info');
    my $log = Log::Any->get_logger();
    ok( ! $log->is_debug, "stdout won't log debugs" );
    ok( $log->is_warn, "stdout will log warnings" );
    $log->debug("to stdout");
    is( $buf, '', "debug not logged to stdout" );
    $log->warn("to stdout");
    like( $buf, qr/^to stdout\n$/, "warn logged to stdout" );
    {
        Log::Any::Adapter->set({lexically => \my $lex}, 'Stdout');
        ok( $log->is_trace, "stdout will log trace lexically" );
    }

    { # Test that Stdout adapter validates log level properly
        my @warnings;
        local $SIG{__WARN__} = sub { push @warnings, $_[0] };
        Log::Any::Adapter->set( {lexically => \my $lex}, 'Stdout', log_level => 'FOOBAR' );
        my $log = Log::Any->get_logger();
        ok( $log->is_trace, "log defaults to trace level" );
        is scalar @warnings, 1, 'one warning issued';
        like $warnings[0],
            qr{Invalid log level "FOOBAR"\. Defaulting to "trace" at $__FILE__ line \d+},
            'warning is correct';
    }

    { # Test that Stdout adapter allows critical log_level
        Log::Any::Adapter->set( {lexically => \my $lex}, 'Stdout', log_level => 'emergency' );
        my $log = Log::Any->get_logger();
        ok $log->is_emergency, 'emergency log level file will log emergency';
        ok !$log->is_alert, 'emergency log level file will not log alert';
    }
}

{
    my $buf = '';
    open my $fh, ">", \$buf;
    local *STDERR = $fh;
    Log::Any::Adapter->set('Stderr', log_level => 'info');
    my $log = Log::Any->get_logger();
    ok( ! $log->is_debug, "stderr won't log debugs" );
    ok( $log->is_warn, "stderr will log warnings" );
    $log->debug("to stderr");
    is( $buf, '', "debug not logged to stderr" );
    $log->warn("to stderr");
    like( $buf, qr/^to stderr\n$/, "warn logged to stderr" );
    {
        Log::Any::Adapter->set({lexically => \my $lex}, 'Stderr');
        ok( $log->is_trace, "stderr will log trace lexically" );
    }

    { # Test that Stderr adapter validates log level properly
        my @warnings;
        local $SIG{__WARN__} = sub { push @warnings, $_[0] };
        Log::Any::Adapter->set( {lexically => \my $lex}, 'Stderr', log_level => 'FOOBAR' );
        my $log = Log::Any->get_logger();
        ok( $log->is_trace, "log defaults to trace level" );
        is scalar @warnings, 1, 'one warning issued';
        like $warnings[0],
            qr{Invalid log level "FOOBAR"\. Defaulting to "trace" at $__FILE__ line \d+},
            'warning is correct';
    }

    { # Test that Stderr adapter allows critical log_level
        Log::Any::Adapter->set( {lexically => \my $lex}, 'Stderr', log_level => 'emergency' );
        my $log = Log::Any->get_logger();
        ok $log->is_emergency, 'emergency log level file will log emergency';
        ok !$log->is_alert, 'emergency log level file will not log alert';
    }
}