t/unit_core_log.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 23;
   5
   6 my $LOG;
   7
   8 BEGIN {
   9     chdir 't' if -d 't';
  10     use lib '../lib';
  11     $LOG = 'Catalyst::Log';
  12     use_ok $LOG or die;
  13 }
  14 my @MESSAGES;
  15 {
  16     no warnings 'redefine';
  17     *Catalyst::Log::_send_to_log = sub {
  18         my $self = shift;
  19         push @MESSAGES, @_;
  20     };
  21 }
  22
  23 can_ok $LOG, 'new';
  24 ok my $log = $LOG->new, '... and creating a new log object should succeed';
  25 isa_ok $log, $LOG, '... and the object it returns';
  26
  27 can_ok $log, 'is_info';
  28 ok $log->is_info, '... and the default behavior is to allow info messages';
  29
  30 can_ok $log, 'info';
  31 ok $log->info('hello there!'),
  32     '... passing it an info message should succeed';
  33
  34 can_ok $log, "_flush";
  35 $log->_flush;
  36 ok @MESSAGES, '... and flushing the log should succeed';
  37 is scalar @MESSAGES, 1, '... with one log message';
  38 like $MESSAGES[0], qr/^\[info\] hello there!$/,
  39     '... which should match the format we expect';
  40
  41 {
  42
  43     package Catalyst::Log::Subclass;
  44     use base qw/Catalyst::Log/;
  45
  46     sub _send_to_log {
  47         my $self = shift;
  48         push @MESSAGES, '---';
  49         push @MESSAGES, @_;
  50     }
  51 }
  52
  53 my $SUBCLASS = 'Catalyst::Log::Subclass';
  54 can_ok $SUBCLASS, 'new';
  55 ok $log = Catalyst::Log::Subclass->new,
  56     '... and the log subclass constructor shoudl return a new object';
  57 isa_ok $log, $SUBCLASS, '... and the object it returns';
  58 isa_ok $log, $LOG,      '... and it also';
  59
  60 can_ok $log, 'info';
  61 ok $log->info('hi there!'),
  62     '... passing it an info message should succeed';
  63
  64 can_ok $log, "_flush";
  65 @MESSAGES = (); # clear the message log
  66 $log->_flush;
  67 ok @MESSAGES, '... and flushing the log should succeed';
  68 is scalar @MESSAGES, 2, '... with two log messages';
  69 is $MESSAGES[0], '---', '... with the first one being our new data';
  70 like $MESSAGES[1], qr/^\[info\] hi there!$/,
  71     '... which should match the format we expect';
  72