/[cvs]/nfo/perl/libs/Log/Dispatch/Config/Object.pm
ViewVC logotype

Annotation of /nfo/perl/libs/Log/Dispatch/Config/Object.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Tue Feb 18 16:37:22 2003 UTC (21 years, 6 months ago) by joko
Branch: MAIN
Changes since 1.1: +6 -3 lines
+ fix: ...::Hardwired is an optional module

1 joko 1.1 ## ------------------------------------------------------------------------
2 joko 1.2 ## $Id: Object.pm,v 1.1 2003/02/18 15:57:34 joko Exp $
3 joko 1.1 ## ------------------------------------------------------------------------
4 joko 1.2 ## $Log: Object.pm,v $
5     ## Revision 1.1 2003/02/18 15:57:34 joko
6     ## + initial commit, refactored from DesignPattern::Object::Logger
7     ##
8 joko 1.1 ## Revision 1.2 2003/02/14 14:20:42 joko
9     ## + decreased default log-level to debug
10     ##
11     ## Revision 1.1 2002/12/22 14:17:38 joko
12     ## + initial check-in, refactored
13     ##
14     ## Revision 1.1 2002/12/19 01:14:48 cvsjoko
15     ## + initial check-in
16     ##
17     ## ------------------------------------------------------------------------
18    
19    
20     package Log::Dispatch::Config::Object;
21    
22     use strict;
23     use warnings;
24    
25     use Data::Dumper;
26     use Log::Dispatch;
27     use Log::Dispatch::Config;
28 joko 1.2 eval ("use Log::Dispatch::Configurator::Hardwired;");
29 joko 1.1 use Cwd;
30    
31    
32     # TODO: review, revise and rewire this!
33     #my $logger = Log::Dispatch::Config->instance;
34    
35     sub __init {
36     my $self = shift;
37     my $action = shift;
38     my $message = shift;
39     #my $options = shift; # ??? or: $self->{options} already...?
40    
41     # configure
42     if (!$self->{__logger}->{configured}) {
43     $self->{__logger}->{configured} = 1;
44     $self->_configure_LogDispatch();
45     }
46    
47     # set passed-in arguments
48     $self->{action} = $action;
49     $self->{message} = $message;
50    
51     # set default arguments
52     $self->{classname} = ref $self;
53     $self->{caller} = caller;
54    
55     # set default values
56     $self->{action} ||= '';
57     $self->{options}->{tag} ||= '';
58    
59     #$self->{level} ||= 'info';
60     $self->{level} ||= 'debug';
61    
62     }
63    
64     sub __out {
65     my $self = shift;
66     my $message = shift;
67    
68     # if message given here, append to message stored inside object
69     $self->{message} .= ' - ' . $message if $message;
70    
71     # TODO: refactor this:
72     # - push '$self->__get_prefix()' to additional log-entry-metadata, don't show it on/in any console/logfile output
73     #$logger->log( level => $self->{level}, message => $self->__get_prefix_long() . $message );
74     #$logger->log( level => $self->{level}, message => $message );
75     #$logger->warning( __PACKAGE__ . "->_skip: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
76     #$self->{__logger}->{instance}->log( level => $self->{level}, message => $self->__get_prefix_short() . $self->{message} );
77     $self->{__logger}->{instance}->log( level => $self->{level}, message => $self->__get_prefix_module() . $self->{message} );
78     }
79    
80    
81     sub __handle_options {
82     my $self = shift;
83     #my $options = shift; # ??? or: $self->{options} already...?
84     }
85    
86     sub __get_prefix_long {
87     my $self = shift;
88     return __PACKAGE__ . "->$self->{action}: '$self->{caller}' (mixed into '$self->{classname}'): ($self->{options}->{tag}) - ";
89     }
90    
91     sub __get_prefix_short {
92     my $self = shift;
93     my $tag_append = '';
94     $tag_append = "$self->{options}->{tag} - " if $self->{options}->{tag};
95     return $self->{classname} . "->$self->{action}: $tag_append";
96     }
97    
98     sub __get_prefix_module {
99     my $self = shift;
100     my $tag_append = '';
101     $tag_append = "$self->{options}->{tag} - " if $self->{options}->{tag};
102     return $self->{classname} . ": $tag_append";
103     }
104    
105    
106     sub log {
107     my $self = shift;
108     my $message = shift;
109     $self->{level} = shift; # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
110     $self->{options} = shift; # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
111    
112     #$self->__init('log', $message);
113     $self->__init('log', $message);
114     $self->__out();
115    
116     }
117    
118     sub skip {
119     my $self = shift;
120     my $message = shift;
121     my $condition = shift;
122     $self->{level} = shift; # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
123     $self->{options} = shift; # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
124    
125     my $classname = ref $self;
126     my $caller = caller;
127    
128     $self->{options}->{tag} ||= '';
129    
130     if ($condition) {
131     # V1:
132     #$logger->warning( __PACKAGE__ . "->_skip: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
133     # V2:
134     $self->__init('skip', $message);
135     $self->__out();
136     return 1;
137     }
138     }
139    
140     sub trace {
141     my $self = shift;
142     my $message = shift;
143     my $data = shift;
144     my $condition = shift;
145     $self->{level} = shift; # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
146     $self->{options} = shift; # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
147    
148     my $classname = ref $self;
149     my $caller = caller;
150    
151     $self->{options}->{tag} ||= '';
152    
153     # don't do _any_ tracing if disabled
154     return if $self->{TRACE_DISABLED};
155    
156     # overwrite condition with local configured want-TRACE
157     $condition ||= $self->{TRACE};
158    
159     # dump data
160     my $result = 0;
161     if ($condition) {
162     $message .= " - " . Dumper($data);
163    
164     # V1:
165     # $self->__init('trace');
166     # $logger->info( __PACKAGE__ . "->trace: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
167    
168     # V2:
169     $self->__init('trace', $message);
170     $self->__out();
171    
172     $result = 1;
173     } else {
174     $result = 0;
175     }
176    
177     # handle additional options
178     if ($self->{TRACE_OPTIONS}) {
179     exit if $self->{options}->{exit};
180     }
181    
182     return $result;
183     }
184    
185    
186     sub _configure_LogDispatch {
187     my $self = shift;
188     my $logHandlerMeta = Log::Dispatch::Configurator::Hardwired->new();
189    
190     my $basepath = cwd() . '/..';
191     #print "base: $basepath", "\n";
192     #exit;
193    
194     # configure custom logHandler
195     $logHandlerMeta->{file_filename} = "$basepath/var/log/logfile.txt";
196     $logHandlerMeta->{screen_min_level} = 'info';
197    
198     if ($self->{quiet}) {
199     $logHandlerMeta->{screen_min_level} = 8;
200     }
201    
202     if ($self->{debug}) {
203     $logHandlerMeta->{screen_min_level} = 'debug';
204     }
205    
206     if ($self->{verbose}) {
207     $logHandlerMeta->{verbose} = 1;
208     }
209    
210     Log::Dispatch::Config->configure($logHandlerMeta);
211    
212     $self->{__logger}->{instance} = Log::Dispatch::Config->instance;
213    
214     }
215    
216     1;
217     __END__

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed