/[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.2 - (show annotations)
Tue Feb 18 16:37:22 2003 UTC (21 years, 5 months ago) by joko
Branch: MAIN
Changes since 1.1: +6 -3 lines
+ fix: ...::Hardwired is an optional module

1 ## ------------------------------------------------------------------------
2 ## $Id: Object.pm,v 1.1 2003/02/18 15:57:34 joko Exp $
3 ## ------------------------------------------------------------------------
4 ## $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 ## 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 eval ("use Log::Dispatch::Configurator::Hardwired;");
29 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