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