t/unit_core_log.t

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