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 |
9 |
|
## minor update: renamed attribute |
10 |
|
## |
11 |
|
## Revision 1.4 2003/03/29 07:16:00 joko |
12 |
|
## minor update: changed default log-file-name to 'perl_app.log' |
13 |
|
## |
14 |
|
## Revision 1.3 2003/03/28 07:23:25 joko |
15 |
|
## fix to basepath calculation |
16 |
|
## |
17 |
## Revision 1.2 2003/02/20 21:06:27 joko |
## Revision 1.2 2003/02/20 21:06:27 joko |
18 |
## + configurable by package globals |
## + configurable by package globals |
19 |
## + standalone mode (object creation via 'new') |
## + standalone mode (object creation via 'new') |
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 |
|
|
344 |
|
|
345 |
my $configurator = DesignPattern::Object->fromPackage('Log::Dispatch::Configurator::Hardwired'); |
my $configurator = DesignPattern::Object->fromPackage('Log::Dispatch::Configurator::Hardwired'); |
346 |
|
|
347 |
# FIXME? |
# check if running inside a 'PROJECT' space |
348 |
my $basepath = cwd() . '/..'; |
my $basepath = cwd(); |
349 |
|
my $postpone = '/..'; |
350 |
|
if (-d $basepath . $postpone . '/PROJECT') { |
351 |
|
$basepath .= $postpone; |
352 |
|
$basepath .= "/var/log"; |
353 |
|
} |
354 |
|
|
355 |
# configure custom logHandler |
# configure custom logHandler |
356 |
|
|
357 |
if ($configurator) { |
if ($configurator) { |
358 |
|
|
359 |
$configurator->{file_filename} = "$basepath/var/log/logfile.txt"; |
$configurator->{file_filename} = "$basepath/perl_app.log"; |
360 |
$configurator->{screen_min_level} = 'info'; |
$configurator->{screen_min_level} = 'info'; |
361 |
|
|
362 |
if ($self->{quiet}) { |
if ($self->{quiet}) { |
367 |
$configurator->{screen_min_level} = 'debug'; |
$configurator->{screen_min_level} = 'debug'; |
368 |
} |
} |
369 |
|
|
370 |
if ($self->{verbose}) { |
if ($self->{LOG_VERBOSE}) { |
371 |
$configurator->{verbose} = 1; |
$configurator->{verbose} = 1; |
372 |
} |
} |
373 |
|
|