/[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.4 - (hide 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 joko 1.1 ## ------------------------------------------------------------------------
2 joko 1.4 ## $Id: Object.pm,v 1.3 2003/02/18 18:33:59 joko Exp $
3 joko 1.1 ## ------------------------------------------------------------------------
4 joko 1.2 ## $Log: Object.pm,v $
5 joko 1.4 ## Revision 1.3 2003/02/18 18:33:59 joko
6     ## + fix: just logs if possible
7     ##
8 joko 1.3 ## Revision 1.2 2003/02/18 16:37:22 joko
9     ## + fix: ...::Hardwired is an optional module
10     ##
11 joko 1.2 ## Revision 1.1 2003/02/18 15:57:34 joko
12     ## + initial commit, refactored from DesignPattern::Object::Logger
13     ##
14 joko 1.1 ## 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 joko 1.3 use Log::Dispatch::Screen;
34 joko 1.1 use Log::Dispatch::Config;
35     use Cwd;
36 joko 1.3 use DesignPattern::Object;
37 joko 1.1
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 joko 1.3
196     my $configurator = DesignPattern::Object->fromPackage('Log::Dispatch::Configurator::Hardwired');
197 joko 1.1
198 joko 1.3 # FIXME?
199 joko 1.1 my $basepath = cwd() . '/..';
200    
201     # configure custom logHandler
202 joko 1.3
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 joko 1.1
225 joko 1.3 #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 joko 1.1
230     }
231    
232    
233     }
234    
235     1;
236     __END__

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