1use strict;
2use warnings;
3
4my @n_lower = qw(loglevel log_level);
5my @n_ucfirst = qw(LogLevel Log_Level);
6my @n_uc = qw(LOGLEVEL LOG_LEVEL);
7my @n = (@n_lower, @n_ucfirst, @n_uc);
8my @outputs = qw(dir file screen syslog);
9my @s_lower = qw(quiet verbose debug trace);
10my @s_ucfirst = map {ucfirst} @s_lower;
11my @s_uc = map {uc} @s_lower;
12my @s = (@s_lower, @s_ucfirst, @s_uc);
13
14my @global_vars = (@n, @s);
15for my $o (@outputs) { push @global_vars, $o."_".$_ for @n_lower }
16for my $o (@outputs) { push @global_vars, ucfirst($o)."_".$_ for @n_ucfirst }
17for my $o (@outputs) { push @global_vars, uc($o)."_".$_ for @n_uc }
18for my $o (@outputs) { push @global_vars, $o."_".$_ for @s_lower }
19for my $o (@outputs) { push @global_vars, ucfirst($o)."_".$_ for @s_ucfirst }
20for my $o (@outputs) { push @global_vars, uc($o)."_".$_ for @s_uc }
21
22my %orig_env;
23BEGIN { %orig_env = %ENV }
24
25sub reset_vars {
26    %App::options = ();
27    delete $ENV{$_} for keys %ENV; $ENV{$_} = $orig_env{$_} for keys %orig_env;
28    @ARGV = ();
29    no strict 'refs';
30    no warnings;
31    for my $v (@global_vars) { $v = "main::$v"; $$v = undef }
32}
33
34sub test_init {
35    my %args = @_;
36    my $name = $args{name};
37    my $init_args = $args{init_args} ? [@{ $args{init_args} }] : [];
38    push @$init_args, -init => 0;
39
40    reset_vars();
41    $args{pre}->() if $args{pre};
42    $Log::Any::App::init_called = 0;
43    my $spec = Log::Any::App::init($init_args);
44
45    if (defined $args{num_dirs}) {
46        is(scalar(@{ $spec->{dir} }), $args{num_dirs}, "$name: num of dir output is $args{num_dirs}");
47    }
48    if (defined $args{num_files}) {
49        is(scalar(@{ $spec->{file} }), $args{num_files}, "$name: num of file output is $args{num_files}");
50    }
51    if (defined $args{num_screens}) {
52        is(scalar(@{ $spec->{screen} }), $args{num_screens}, "$name: num of screen output is $args{num_screens}");
53    }
54    if (defined $args{num_syslogs}) {
55        is(scalar(@{ $spec->{syslog} }), $args{num_syslogs}, "$name: num of syslog output is $args{num_syslogs}");
56    }
57
58    if (defined $args{level}) {
59        is(uc($spec->{level}), uc($args{level}), "$name: general level is $args{level}");
60    }
61    if (defined $args{dir_level}) {
62        is(uc($spec->{dir}[0]{level}), uc($args{dir_level}), "$name: dir level is $args{dir_level}");
63    }
64    if (defined $args{file_level}) {
65        is(uc($spec->{file}[0]{level}), uc($args{file_level}), "$name: file level is $args{file_level}");
66    }
67    if (defined $args{screen_level}) {
68        is(uc($spec->{screen}[0]{level}), uc($args{screen_level}), "$name: screen level is $args{screen_level}");
69    }
70    if (defined $args{syslog_level}) {
71        is(uc($spec->{syslog}[0]{level}), uc($args{syslog_level}), "$name: syslog level is $args{syslog_level}");
72    }
73
74    if (defined $args{dir_params}) {
75        _test_params("dir", $spec->{dir}[0], $args{dir_params}, $name);
76    }
77    if (defined $args{file_params}) {
78        _test_params("file", $spec->{file}[0], $args{file_params}, $name);
79    }
80    if (defined $args{screen_params}) {
81        _test_params("screen", $spec->{screen}[0], $args{screen_params}, $name);
82    }
83    if (defined $args{syslog_params}) {
84        _test_params("syslog", $spec->{syslog}[0], $args{syslog_params}, $name);
85    }
86
87    if ($args{check}) {
88        $args{check}->($spec, $name);
89    }
90}
91
92sub _test_params {
93    my ($kind, $ospec, $params, $name) = @_;
94    while (my ($k, $v) = each %$params) {
95        if (ref($v) eq 'Regexp') {
96            like($ospec->{$k}, $v, "$name: $kind param '$k' matches $v");
97        } else {
98            is  ($ospec->{$k}, $v, "$name: $kind param '$k' is $v");
99        }
100    }
101}
102
1031;
104