########################################### # Tests for Log4perl used by a wrapper class # Mike Schilli, 2002 (m@perlmeister.com) ########################################### BEGIN { if($ENV{INTERNAL_DEBUG}) { require Log::Log4perl::InternalDebug; Log::Log4perl::InternalDebug->enable(); } } use warnings; use strict; use Test::More; use File::Basename; BEGIN { plan tests => 5 } ################################################## package Wrapper::Log4perl; use Log::Log4perl; use Log::Log4perl::Level; our @ISA = qw(Log::Log4perl); sub get_logger { # This is highly stupid (object duplication) and definitely not what we # want anybody to do, but just to have a test case for a logger in a # wrapper package return Wrapper::Log4perl::Logger->new(@_); } ################################################## package Wrapper::Log4perl::Logger; Log::Log4perl->wrapper_register(__PACKAGE__); sub new { my $real_logger = Log::Log4perl::get_logger(@_); bless { real_logger => $real_logger }, $_[0]; } sub AUTOLOAD { no strict; my $self = shift; $AUTOLOAD =~ s/.*:://; $self->{real_logger}->$AUTOLOAD(@_); } sub DESTROY {} ################################################## package main; use Log::Log4perl; local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 1; use Log::Log4perl::Level; my $log0 = Wrapper::Log4perl->get_logger(""); $log0->level($DEBUG); my $app0 = Log::Log4perl::Appender->new( "Log::Log4perl::Appender::TestBuffer"); my $layout = Log::Log4perl::Layout::PatternLayout->new( "File: %F{1} Line number: %L package: %C trace: %T"); $app0->layout($layout); $log0->add_appender($app0); ################################################## my $rootlogger = Wrapper::Log4perl->get_logger(""); my $line = __LINE__ + 1; $rootlogger->debug("Hello"); my $buf = $app0->buffer(); $buf =~ s#(\S+022Wrap\.t)#basename( $1 )#eg; # [rt 74836] Carp.pm added a dot at the end with 1.25. # Be dot-agnostic. $buf =~ s/\.$//; is($buf, "File: 022Wrap.t Line number: $line package: main " . "trace: at 022Wrap.t line $line", "appender check"); # with the new wrapper_register in Log4perl 1.29, this will even work # *without* modifying caller_depth $Log::Log4perl::caller_depth--; $app0->buffer(""); $line = __LINE__ + 1; $rootlogger->debug("Hello"); # Win32 # [rt 74836] Carp.pm added a dot at the end with 1.25. # Be dot-agnostic. $buf = $app0->buffer(); $buf =~ s/\.$//; $buf =~ s#(\S+022Wrap\.t)#basename( $1 )#eg; is($buf, "File: 022Wrap.t Line number: $line package: main " . "trace: at 022Wrap.t line $line", "appender check"); ################################################## package L4p::Wrapper; Log::Log4perl->wrapper_register(__PACKAGE__); no strict qw(refs); *get_logger = sub { my @args = @_; if(defined $args[0] and $args[0] eq __PACKAGE__) { $args[0] =~ s/__PACKAGE__/Log::Log4perl/g; } Log::Log4perl::get_logger( @args ); }; package main; my $logger = L4p::Wrapper::get_logger(); is $logger->{category}, "main", "cat on () is main"; $logger = L4p::Wrapper::get_logger(__PACKAGE__); is $logger->{category}, "main", "cat on (__PACKAGE__) is main"; $logger = L4p::Wrapper->get_logger(); is $logger->{category}, "main", "cat on ->() is main"; # use Data::Dumper; # print Dumper($logger);