4 use Test::More tests => 24;
8 local *Catalyst::Log::_send_to_log;
11 no warnings 'redefine';
12 *Catalyst::Log::_send_to_log = sub {
18 my $LOG = 'Catalyst::Log';
21 ok my $log = $LOG->new, '... and creating a new log object should succeed';
22 isa_ok $log, $LOG, '... and the object it returns';
24 can_ok $log, "autoflush";
27 can_ok $log, 'is_info';
28 ok $log->is_info, '... and the default behavior is to allow info messages';
31 ok $log->info('hello there!'),
32 '... passing it an info message should succeed';
34 can_ok $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';
43 package Catalyst::Log::Subclass;
44 use base qw/Catalyst::Log/;
48 push @MESSAGES, '---';
53 my $SUBCLASS = 'Catalyst::Log::Subclass';
54 can_ok $SUBCLASS, 'new';
55 ok $log = Catalyst::Log::Subclass->new,
56 '... and the log subclass constructor should return a new object';
57 isa_ok $log, $SUBCLASS, '... and the object it returns';
58 isa_ok $log, $LOG, '... and it also';
60 can_ok $log, "autoflush";
64 ok $log->info('hi there!'),
65 '... passing it an info message should succeed';
67 can_ok $log, "_flush";
68 @MESSAGES = (); # clear the message log
70 ok @MESSAGES, '... and flushing the log should succeed';
71 is scalar @MESSAGES, 2, '... with two log messages';
72 is $MESSAGES[0], '---', '... with the first one being our new data';
73 like $MESSAGES[1], qr/^\[info\] hi there!$/,
74 '... which should match the format we expect';