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