use strict; use warnings; my @n_lower = qw(loglevel log_level); my @n_ucfirst = qw(LogLevel Log_Level); my @n_uc = qw(LOGLEVEL LOG_LEVEL); my @n = (@n_lower, @n_ucfirst, @n_uc); my @outputs = qw(dir file screen syslog); my @s_lower = qw(quiet verbose debug trace); my @s_ucfirst = map {ucfirst} @s_lower; my @s_uc = map {uc} @s_lower; my @s = (@s_lower, @s_ucfirst, @s_uc); my @global_vars = (@n, @s); for my $o (@outputs) { push @global_vars, $o."_".$_ for @n_lower } for my $o (@outputs) { push @global_vars, ucfirst($o)."_".$_ for @n_ucfirst } for my $o (@outputs) { push @global_vars, uc($o)."_".$_ for @n_uc } for my $o (@outputs) { push @global_vars, $o."_".$_ for @s_lower } for my $o (@outputs) { push @global_vars, ucfirst($o)."_".$_ for @s_ucfirst } for my $o (@outputs) { push @global_vars, uc($o)."_".$_ for @s_uc } my %orig_env; BEGIN { %orig_env = %ENV } sub reset_vars { %App::options = (); delete $ENV{$_} for keys %ENV; $ENV{$_} = $orig_env{$_} for keys %orig_env; @ARGV = (); no strict 'refs'; no warnings; for my $v (@global_vars) { $v = "main::$v"; $$v = undef } } sub test_init { my %args = @_; my $name = $args{name}; my $init_args = $args{init_args} ? [@{ $args{init_args} }] : []; push @$init_args, -init => 0; reset_vars(); $args{pre}->() if $args{pre}; $Log::Any::App::init_called = 0; my $spec = Log::Any::App::init($init_args); if (defined $args{num_dirs}) { is(scalar(@{ $spec->{dir} }), $args{num_dirs}, "$name: num of dir output is $args{num_dirs}"); } if (defined $args{num_files}) { is(scalar(@{ $spec->{file} }), $args{num_files}, "$name: num of file output is $args{num_files}"); } if (defined $args{num_screens}) { is(scalar(@{ $spec->{screen} }), $args{num_screens}, "$name: num of screen output is $args{num_screens}"); } if (defined $args{num_syslogs}) { is(scalar(@{ $spec->{syslog} }), $args{num_syslogs}, "$name: num of syslog output is $args{num_syslogs}"); } if (defined $args{level}) { is(uc($spec->{level}), uc($args{level}), "$name: general level is $args{level}"); } if (defined $args{dir_level}) { is(uc($spec->{dir}[0]{level}), uc($args{dir_level}), "$name: dir level is $args{dir_level}"); } if (defined $args{file_level}) { is(uc($spec->{file}[0]{level}), uc($args{file_level}), "$name: file level is $args{file_level}"); } if (defined $args{screen_level}) { is(uc($spec->{screen}[0]{level}), uc($args{screen_level}), "$name: screen level is $args{screen_level}"); } if (defined $args{syslog_level}) { is(uc($spec->{syslog}[0]{level}), uc($args{syslog_level}), "$name: syslog level is $args{syslog_level}"); } if (defined $args{dir_params}) { _test_params("dir", $spec->{dir}[0], $args{dir_params}, $name); } if (defined $args{file_params}) { _test_params("file", $spec->{file}[0], $args{file_params}, $name); } if (defined $args{screen_params}) { _test_params("screen", $spec->{screen}[0], $args{screen_params}, $name); } if (defined $args{syslog_params}) { _test_params("syslog", $spec->{syslog}[0], $args{syslog_params}, $name); } if ($args{check}) { $args{check}->($spec, $name); } } sub _test_params { my ($kind, $ospec, $params, $name) = @_; while (my ($k, $v) = each %$params) { if (ref($v) eq 'Regexp') { like($ospec->{$k}, $v, "$name: $kind param '$k' matches $v"); } else { is ($ospec->{$k}, $v, "$name: $kind param '$k' is $v"); } } } 1;