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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Thu Feb 20 21:08:08 2003 UTC (21 years, 4 months ago) by joko
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +4 -1 lines
FILE REMOVED
- refactored (again) - this time to DesignPattern::Logger

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

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