t/warnlogger-with-levels.t

   1 use strict;
   2 use warnings;
   3
   4 use Log::Contextual::WarnLogger;  # -levels => [qw(custom1 custom2)];
   5 use Log::Contextual qw{:log set_logger} => -logger =>
   6    Log::Contextual::WarnLogger->new({ env_prefix => 'FOO' });
   7
   8 use Test::More qw(no_plan);
   9 use Test::Fatal;
  10
  11 {
  12     my $l;
  13     like(
  14         exception { $l = Log::Contextual::WarnLogger->new({ levels => '' }) },
  15         qr/invalid levels specification: must be non-empty arrayref/,
  16         'cannot pass empty string for levels',
  17     );
  18
  19     like(
  20         exception { $l = Log::Contextual::WarnLogger->new({ levels => [] }) },
  21         qr/invalid levels specification: must be non-empty arrayref/,
  22         'cannot pass empty list for levels',
  23     );
  24
  25     is(
  26         exception { $l = Log::Contextual::WarnLogger->new({ levels => undef, env_prefix => 'FOO' }) },
  27         undef,
  28         'ok to leave levels undefined',
  29     );
  30 }
  31
  32
  33 {
  34     my $l = Log::Contextual::WarnLogger->new({
  35         env_prefix => 'BAR',
  36         levels => [qw(custom1 custom2)]
  37     });
  38
  39     foreach my $sub (qw(is_custom1 is_custom2 custom1 custom2))
  40     {
  41         is(
  42             exception { $l->$sub },
  43             undef,
  44             $sub . ' is handled by AUTOLOAD',
  45         );
  46     }
  47
  48     foreach my $sub (qw(is_foo foo))
  49     {
  50         is(
  51             exception { $l->$sub },
  52             undef,
  53             'arbitrary sub ' . $sub . ' is handled by AUTOLOAD',
  54         );
  55     }
  56 }
  57
  58 {
  59     # levels is optional - most things should still work otherwise.
  60     my $l = Log::Contextual::WarnLogger->new({
  61         env_prefix => 'BAR',
  62     });
  63
  64     # if we don't know the level, and there are no environment variables set,
  65     # just log everything.
  66     {
  67         ok($l->is_custom1, 'is_custom1 defaults to true on WarnLogger');
  68         ok($l->is_custom2, 'is_custom2 defaults to true on WarnLogger');
  69     }
  70
  71     # otherwise, go with what the variable says.
  72     {
  73         local $ENV{BAR_CUSTOM1} = 0;
  74         local $ENV{BAR_CUSTOM2} = 1;
  75         ok(!$l->is_custom1, 'is_custom1 is false on WarnLogger');
  76         ok($l->is_custom2, 'is_custom2 is true on WarnLogger');
  77
  78         ok($l->is_foo, 'is_foo defaults to true on WarnLogger');
  79
  80         local $ENV{BAR_UPTO} = 'foo';
  81         like(
  82             exception { $l->is_bar },
  83             qr/Unrecognized log level 'foo' in \$ENV{BAR_UPTO}/,
  84             'Cannot use an unrecognized log level in UPTO',
  85         );
  86     }
  87 }
  88
  89 # these tests taken from t/warnlogger.t
  90
  91 my $l = Log::Contextual::WarnLogger->new({
  92     env_prefix => 'BAR',
  93     levels => [qw(custom1 custom2)]
  94 });
  95
  96 {
  97     local $ENV{BAR_CUSTOM1} = 0;
  98     local $ENV{BAR_CUSTOM2} = 1;
  99     ok(!$l->is_custom1, 'is_custom1 is false on WarnLogger');
 100     ok($l->is_custom2, 'is_custom2 is true on WarnLogger');
 101
 102     ok(!$l->is_foo, 'is_foo is false (custom levels supplied) on WarnLogger');
 103 }
 104
 105 {
 106     local $ENV{BAR_UPTO} = 'custom1';
 107
 108     ok($l->is_custom1, 'is_custom1 is true on WarnLogger');
 109     ok($l->is_custom2, 'is_custom2 is true on WarnLogger');
 110 }
 111
 112 {
 113     local $ENV{BAR_UPTO} = 'custom2';
 114
 115     ok(!$l->is_custom1, 'is_custom1 is false on WarnLogger');
 116     ok($l->is_custom2, 'is_custom2 is true on WarnLogger');
 117 }
 118
 119 {
 120     local $ENV{BAR_UPTO} = 'foo';
 121
 122     like(
 123         exception { $l->is_custom1 },
 124         qr/Unrecognized log level 'foo'/,
 125         'Cannot use an unrecognized log level in UPTO',
 126     );
 127 }
 128