1########################################### 2# Tests for Log4perl used by a wrapper class 3# Mike Schilli, 2002 (m@perlmeister.com) 4########################################### 5 6BEGIN { 7 if($ENV{INTERNAL_DEBUG}) { 8 require Log::Log4perl::InternalDebug; 9 Log::Log4perl::InternalDebug->enable(); 10 } 11} 12 13use warnings; 14use strict; 15 16use Test::More; 17use File::Basename; 18 19BEGIN { plan tests => 5 } 20 21################################################## 22package Wrapper::Log4perl; 23 24use Log::Log4perl; 25use Log::Log4perl::Level; 26 27our @ISA = qw(Log::Log4perl); 28 29sub get_logger { 30 # This is highly stupid (object duplication) and definitely not what we 31 # want anybody to do, but just to have a test case for a logger in a 32 # wrapper package 33 return Wrapper::Log4perl::Logger->new(@_); 34} 35 36################################################## 37package Wrapper::Log4perl::Logger; 38Log::Log4perl->wrapper_register(__PACKAGE__); 39sub new { 40 my $real_logger = Log::Log4perl::get_logger(@_); 41 bless { real_logger => $real_logger }, $_[0]; 42} 43sub AUTOLOAD { 44 no strict; 45 my $self = shift; 46 $AUTOLOAD =~ s/.*:://; 47 $self->{real_logger}->$AUTOLOAD(@_); 48} 49sub DESTROY {} 50 51################################################## 52package main; 53 54use Log::Log4perl; 55local $Log::Log4perl::caller_depth = 56 $Log::Log4perl::caller_depth + 1; 57use Log::Log4perl::Level; 58 59my $log0 = Wrapper::Log4perl->get_logger(""); 60$log0->level($DEBUG); 61 62my $app0 = Log::Log4perl::Appender->new( 63 "Log::Log4perl::Appender::TestBuffer"); 64my $layout = Log::Log4perl::Layout::PatternLayout->new( 65 "File: %F{1} Line number: %L package: %C trace: %T"); 66$app0->layout($layout); 67$log0->add_appender($app0); 68 69################################################## 70my $rootlogger = Wrapper::Log4perl->get_logger(""); 71my $line = __LINE__ + 1; 72$rootlogger->debug("Hello"); 73 74my $buf = $app0->buffer(); 75$buf =~ s#(\S+022Wrap\.t)#basename( $1 )#eg; 76 77# [rt 74836] Carp.pm added a dot at the end with 1.25. 78# Be dot-agnostic. 79$buf =~ s/\.$//; 80 81is($buf, 82 "File: 022Wrap.t Line number: $line package: main " . 83 "trace: at 022Wrap.t line $line", 84 "appender check"); 85 86 # with the new wrapper_register in Log4perl 1.29, this will even work 87 # *without* modifying caller_depth 88$Log::Log4perl::caller_depth--; 89$app0->buffer(""); 90$line = __LINE__ + 1; 91$rootlogger->debug("Hello"); 92 93 # Win32 94# [rt 74836] Carp.pm added a dot at the end with 1.25. 95# Be dot-agnostic. 96$buf = $app0->buffer(); 97$buf =~ s/\.$//; 98$buf =~ s#(\S+022Wrap\.t)#basename( $1 )#eg; 99 100is($buf, 101 "File: 022Wrap.t Line number: $line package: main " . 102 "trace: at 022Wrap.t line $line", 103 "appender check"); 104 105################################################## 106package L4p::Wrapper; 107Log::Log4perl->wrapper_register(__PACKAGE__); 108no strict qw(refs); 109*get_logger = sub { 110 111 my @args = @_; 112 113 if(defined $args[0] and $args[0] eq __PACKAGE__) { 114 $args[0] =~ s/__PACKAGE__/Log::Log4perl/g; 115 } 116 Log::Log4perl::get_logger( @args ); 117}; 118 119package main; 120 121my $logger = L4p::Wrapper::get_logger(); 122is $logger->{category}, "main", "cat on () is main"; 123 124$logger = L4p::Wrapper::get_logger(__PACKAGE__); 125is $logger->{category}, "main", "cat on (__PACKAGE__) is main"; 126 127$logger = L4p::Wrapper->get_logger(); 128is $logger->{category}, "main", "cat on ->() is main"; 129 130# use Data::Dumper; 131# print Dumper($logger); 132