File: 02_log.t

package info (click to toggle)
liblog-dispatch-config-perl 1.04-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 224 kB
  • sloc: perl: 233; makefile: 2
file content (39 lines) | stat: -rw-r--r-- 731 bytes parent folder | download | duplicates (2)
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
use strict;
use Test::More tests => 4;

use Log::Dispatch::Config;
use FileHandle;
use IO::Scalar;
use File::Spec;

sub slurp {
    my $fh = FileHandle->new(shift) or die $!;
    local $/;
    return $fh->getline;
}

my $log;
BEGIN { $log = 't/log.out'; unlink $log if -e $log }
END   { unlink $log if -e $log }

Log::Dispatch::Config->configure('t/log.cfg');

my $err;
{
    tie *STDERR, 'IO::Scalar', \$err;

    my $disp = Log::Dispatch::Config->instance;
    $disp->debug('debug');
    $disp->alert('alert');
}

my $filename = __FILE__;
my $file = slurp $log;
like $file, qr(debug at \Q$filename\E), 'debug';
like $file, qr(alert at \Q$filename\E), 'alert';

ok $err !~ qr/debug/, 'no debug';
is $err, "alert %", 'alert %';