2 |
## $Id$ |
## $Id$ |
3 |
## ------------------------------------------------------------------------ |
## ------------------------------------------------------------------------ |
4 |
## $Log$ |
## $Log$ |
5 |
|
## Revision 1.6 2003/06/06 03:19:09 joko |
6 |
|
## minor fixes |
7 |
|
## |
8 |
## Revision 1.5 2003/05/13 08:40:15 joko |
## Revision 1.5 2003/05/13 08:40:15 joko |
9 |
## minor update: renamed attribute |
## minor update: renamed attribute |
10 |
## |
## |
46 |
## ------------------------------------------------------------------------ |
## ------------------------------------------------------------------------ |
47 |
|
|
48 |
|
|
49 |
|
=pod |
50 |
|
|
51 |
|
This is weird! Forget it. |
52 |
|
But we depend on it! |
53 |
|
Hmmm.... |
54 |
|
|
55 |
|
|
56 |
|
=cut |
57 |
|
|
58 |
|
|
59 |
package DesignPattern::Logger; |
package DesignPattern::Logger; |
60 |
|
|
61 |
use strict; |
use strict; |
147 |
foreach (@{$METHOD_LEVELS}) { |
foreach (@{$METHOD_LEVELS}) { |
148 |
(my $c_package, my $c_filename, my $c_line, my $c_subroutine, my $c_hasargs, |
(my $c_package, my $c_filename, my $c_line, my $c_subroutine, my $c_hasargs, |
149 |
my $c_wantarray, my $c_evaltext, my $c_is_require, my $c_hints, my $c_bitmask) = caller($_); |
my $c_wantarray, my $c_evaltext, my $c_is_require, my $c_hints, my $c_bitmask) = caller($_); |
150 |
|
$c_subroutine ||= ''; |
151 |
$c_subroutine =~ s/.*:://; |
$c_subroutine =~ s/.*:://; |
152 |
push @methods, $c_subroutine; |
push @methods, $c_subroutine; |
153 |
} |
} |
154 |
$calling_sub = join(': ', @methods); |
$calling_sub = join(': ', @methods) if @methods; |
155 |
} |
} |
156 |
|
|
157 |
|
|