libs/DesignPattern/Logger.pm

## ------------------------------------------------------------------------
##  $Id: Logger.pm,v 1.1 2003/02/19 00:34:52 joko Exp $
## ------------------------------------------------------------------------
##  $Log: Logger.pm,v $
##  Revision 1.1  2003/02/19 00:34:52  joko
##  + initial commit, again refactored to this place
##
##  Revision 1.3  2003/02/18 18:33:59  joko
##  + fix: just logs if possible
##
##  Revision 1.2  2003/02/18 16:37:22  joko
##  + fix: ...::Hardwired is an optional module
##
##  Revision 1.1  2003/02/18 15:57:34  joko
##  + initial commit, refactored from DesignPattern::Object::Logger
##
##  Revision 1.2  2003/02/14 14:20:42  joko
##  + decreased default log-level to debug
##
##  Revision 1.1  2002/12/22 14:17:38  joko
##  + initial check-in, refactored
##
##  Revision 1.1  2002/12/19 01:14:48  cvsjoko
##  + initial check-in
##
## ------------------------------------------------------------------------


package DesignPattern::Logger;

use strict;
use warnings;

use Data::Dumper;
use Log::Dispatch;
use Log::Dispatch::Screen;
use Log::Dispatch::Config;
use Cwd;
use DesignPattern::Object;

use vars qw(
  $LEVEL_DEFAULT
  $ENABLE_NAMESPACE
  $NAMESPACE_LEVEL
  $ENABLE_METHODS
  $METHOD_LEVELS
  $TRACE_STACK_LEVELS
);

# default behaviour
$LEVEL_DEFAULT = 'debug';
$ENABLE_NAMESPACE = 1;
$NAMESPACE_LEVEL = undef;
$ENABLE_METHODS = 0;
$METHOD_LEVELS = [3];
$TRACE_STACK_LEVELS = [];


# TODO: review, revise and rewire this!
#my $logger = Log::Dispatch::Config->instance;

sub __init {
  my $self = shift;
  my $action = shift;
  my $message = shift;
  #my $options = shift;   # ??? or: $self->{__logger}->{options} already...?

  # configure
  if (!$self->{__logger}->{configured}) {
    $self->{__logger}->{configured} = 1;
    $self->_configure_LogDispatch();
  }
  
  # set passed-in arguments
  $self->{__logger}->{action} = $action;
  $self->{__logger}->{message} = $message;

  # trace
    #my $tmp = caller(2);
    #print Dumper($tmp);
    #exit;
  

  # handle caller

    # determine class- and subroutinename of context calling us
    # this task can be controlled by tuning its behaviour
    # this can be changed by setting
    #   DesignPattern::Logger::...
    #   ...
    #   ...
    my $calling_class;
    my $calling_sub;


    # Default behaviour is:
    #   Use classname from $self and suppress subroutine name.
    #   In case of using this together with DesignPattern::Bridge,
    #   the classnames of child objects are suppressed.
    #   Instead, the classname of the parent container object
    #   gets used *always*.
      $calling_class = '';
      $calling_sub = '';

      # Log class names (en-/disabled, take from specified level)
      if ($ENABLE_NAMESPACE) {
        $calling_class = ref $self;
        if ($NAMESPACE_LEVEL) {
          my @entry = caller($NAMESPACE_LEVEL);
          $calling_class = $entry[0];
        }
      }

      # Log method names (en-/disabled, multi-level)
      if ($ENABLE_METHODS) {
        my @methods;
        foreach (@{$METHOD_LEVELS}) {
          (my $c_package, my $c_filename, my $c_line, my $c_subroutine, my $c_hasargs,
          my $c_wantarray, my $c_evaltext, my $c_is_require, my $c_hints, my $c_bitmask) = caller($_);
          $c_subroutine =~ s/.*:://;
          push @methods, $c_subroutine;
        }
        $calling_sub = join(': ', @methods);
      }
  
    
  # set default arguments
  $self->{__logger}->{classname} = $calling_class;
  $self->{__logger}->{functionname} = $calling_sub;
  # FIXME: deprecate this!
  $self->{__logger}->{caller} = caller;
  
  # set default values
  $self->{__logger}->{action} ||= '';
  $self->{__logger}->{options}->{tag} ||= '';
  
  # FIXME: deprecate this!
  #$self->{__logger}->{level} ||= 'info';
  #$self->{__logger}->{level} ||= 'debug';
  $self->{__logger}->{level} ||= $LEVEL_DEFAULT;

  # handle stacktrace
    foreach (@$TRACE_STACK_LEVELS) {
      #print "trace-level: ", $_, "\n";
      #(my $c_package, my $c_filename, my $c_line, my $c_subroutine, my $c_hasargs,
      #my $c_wantarray, my $c_evaltext, my $c_is_require, my $c_hints, my $c_bitmask) = caller($_);
      my @entry = caller($_);
      push @{$self->{__logger}->{trace}->{stack}}, \@entry;
    }
  
}

sub __out {
  my $self = shift;
  my $message = shift;
  
  # if message given here, append to message stored inside object
  $self->{__logger}->{message} .= ' - ' . $message if $message;
  
  # TODO: refactor this:
  #  - push '$self->__get_prefix()' to additional log-entry-metadata, don't show it on/in any console/logfile output
  #$logger->log( level => $self->{__logger}->{level}, message => $self->__get_prefix_long() . $message );
  #$logger->log( level => $self->{__logger}->{level}, message => $message );
  #$logger->warning( __PACKAGE__ . "->_skip: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
  #$self->{__logger}->{instance}->log( level => $self->{__logger}->{level}, message => $self->__get_prefix_short() . $self->{__logger}->{message} );
  #$self->{__logger}->{instance}->log( level => $self->{__logger}->{level}, message => $self->__get_prefix_module() . $self->{__logger}->{message} );
  $self->{__logger}->{instance}->log( level => $self->{__logger}->{level}, message => $self->__get_prefix_best() . $self->{__logger}->{message} );
}


sub __handle_options {
  my $self = shift;
  #my $options = shift;   # ??? or: $self->{__logger}->{options} already...?
}

sub __get_prefix_long {
  my $self = shift;
  return __PACKAGE__ . "->$self->{__logger}->{action}: '$self->{__logger}->{caller}' (mixed into '$self->{__logger}->{classname}'): ($self->{__logger}->{options}->{tag}) - ";
}

sub __get_prefix_short {
  my $self = shift;
  my $tag_append = '';
  $tag_append = "$self->{__logger}->{options}->{tag} - " if $self->{__logger}->{options}->{tag};
  return $self->{__logger}->{classname} . "->$self->{__logger}->{action}: $tag_append";
}

sub __get_prefix_module {
  my $self = shift;
  my $tag_append = '';
  $tag_append = "$self->{__logger}->{options}->{tag} - " if $self->{__logger}->{options}->{tag};
  return $self->{__logger}->{classname} . ": $tag_append";
}


sub __get_prefix_best {
  my $self = shift;
  my $namespace = $self->{__logger}->{classname};
  my $method = '';
  my $tag_append = '';
  #$namespace = $namespace . ": " if $namespace;
  $method = "->" . $self->{__logger}->{functionname} if $self->{__logger}->{functionname};
  #$method .= ': ' if $method;
  $tag_append = "$self->{__logger}->{options}->{tag} - " if $self->{__logger}->{options}->{tag};
  
  my @line;
  push @line, $namespace if $namespace;
  push @line, $method if $method;
  push @line, $tag_append if $tag_append;
  
  #print Dumper(@line);
  
  #return join(': ', @line);
  my $result = join('', @line);
  $result .= ': ' if $result;
  
  return $result;
  
}


sub log {
  my $self = shift;
  my $message = shift;
  
  # automagically instantiate the object if not there
  # TODO: do this by creating a dummy object inheriting from DesignPattern::Logger,
  # for now this just don't work because which dummy one to take: Data::Code::Null?
  #if (! ref $self) {
  #  $self = DesignPattern::Object->fromPackage('DesignPattern::Logger');
  #}
  
  $self->{__logger}->{level} = shift;    # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
  $self->{__logger}->{options} = shift;   # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
  
  #$self->__init('log', $message);
  $self->__init('log', $message);
  $self->__out();
  
}

sub skip {
  my $self = shift;
  my $message = shift;
  my $condition = shift;
  $self->{__logger}->{level} = shift;    # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
  $self->{__logger}->{options} = shift;   # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump

  my $classname = ref $self;
  my $caller = caller;

  $self->{__logger}->{options}->{tag} ||= '';

  if ($condition) {
    # V1:
    #$logger->warning( __PACKAGE__ . "->_skip: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
    # V2:
    $self->__init('skip', $message);
    $self->__out();
    return 1;
  }
}

sub trace {
  my $self = shift;
  my $message = shift;
  my $data = shift;
  my $condition = shift;
  $self->{__logger}->{level} = shift;    # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
  $self->{__logger}->{options} = shift;   # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
  
  my $classname = ref $self;
  my $caller = caller;

  $self->{__logger}->{options}->{tag} ||= '';

  # don't do _any_ tracing if disabled
  return if $self->{TRACE_DISABLED};
  
  # overwrite condition with local configured want-TRACE
  $condition ||= $self->{TRACE};
  
  # dump data
    my $result = 0;
    if ($condition) {
      $message .= " - " . Dumper($data);
      
      # V1:
      # $self->__init('trace');
      # $logger->info( __PACKAGE__ . "->trace: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
      
      # V2:
      $self->__init('trace', $message);
      $self->__out();
      
      $result = 1;
    } else {
      $result = 0;
    }

  # handle additional options
  if ($self->{TRACE_OPTIONS}) {
    exit if $self->{__logger}->{options}->{exit};
  }

  return $result;
}


sub _configure_LogDispatch {
  my $self = shift;

  my $configurator = DesignPattern::Object->fromPackage('Log::Dispatch::Configurator::Hardwired');
  
  # FIXME?
  my $basepath = cwd() . '/..';
  
  # configure custom logHandler
  
    if ($configurator) {
  
      $configurator->{file_filename} = "$basepath/var/log/logfile.txt";
      $configurator->{screen_min_level} = 'info';
      
      if ($self->{quiet}) {
        $configurator->{screen_min_level} = 8;
      }
  
      if ($self->{debug}) {
        $configurator->{screen_min_level} = 'debug';
      }
      
      if ($self->{verbose}) {
        $configurator->{verbose} = 1;
      }

      Log::Dispatch::Config->configure($configurator);
      $self->{__logger}->{instance} = Log::Dispatch::Config->instance;

    } else {

      #Log::Dispatch::Config->configure();
      #Log::Dispatch->configure();
      #$self->{__logger}->{instance} = Log::Dispatch->new;
      $self->{__logger}->{instance} = Log::Dispatch::Screen->new( name => 'screen', 'min_level' => 'debug', stderr => 1 );
    
    }


}

sub configure_logger {
  my $self = shift;

  # automagically instantiate the object if not there
  # TODO: do this by creating a dummy object inheriting from DesignPattern::Logger,
  # for now this just don't work because which dummy one to take: Data::Code::Null?
  if (! ref $self) {
    $self = DesignPattern::Object->fromPackage('DesignPattern::Logger');
  }

  #print "logconfig\n";
  $self->_configure_LogDispatch();
}


# for standalone use
sub new { my $class = shift; my $self = {}; bless $self, $class; }

# convenient shortcuts
# FIXME: create these automagically by mungling with symbolic references
# or: make this object tied to recieve kinda events on method calls

sub debug {
  my $self = shift;
  my $message = shift;
  $self->log($message, 'debug');
}

sub warning {
  my $self = shift;
  my $message = shift;
  $self->log($message, 'warning');
}

sub info {
  my $self = shift;
  my $message = shift;
  $self->log($message, 'info');
}

sub notice {
  my $self = shift;
  my $message = shift;
  $self->log($message, 'notice');
}


=pod

=head1 TODO
  
  o $TRACE_STACK_LEVELS   (traces stack history)
  o $ENABLE_DEBUG   (en-/disables level 'debug')
  o $ENABLE_LOG   (en-/disables logging completely)


=cut


1;
__END__
1	## ------------------------------------------------------------------------
2	## $Id: Logger.pm,v 1.1 2003/02/19 00:34:52 joko Exp $
3	## ------------------------------------------------------------------------
4	## $Log: Logger.pm,v $
5	## Revision 1.1 2003/02/19 00:34:52 joko
6	## + initial commit, again refactored to this place
7	##
8	## Revision 1.3 2003/02/18 18:33:59 joko
9	## + fix: just logs if possible
10	##
11	## Revision 1.2 2003/02/18 16:37:22 joko
12	## + fix: ...::Hardwired is an optional module
13	##
14	## Revision 1.1 2003/02/18 15:57:34 joko
15	## + initial commit, refactored from DesignPattern::Object::Logger
16	##
17	## Revision 1.2 2003/02/14 14:20:42 joko
18	## + decreased default log-level to debug
19	##
20	## Revision 1.1 2002/12/22 14:17:38 joko
21	## + initial check-in, refactored
22	##
23	## Revision 1.1 2002/12/19 01:14:48 cvsjoko
24	## + initial check-in
25	##
26	## ------------------------------------------------------------------------
27
28
29	package DesignPattern::Logger;
30
31	use strict;
32	use warnings;
33
34	use Data::Dumper;
35	use Log::Dispatch;
36	use Log::Dispatch::Screen;
37	use Log::Dispatch::Config;
38	use Cwd;
39	use DesignPattern::Object;
40
41	use vars qw(
42	$LEVEL_DEFAULT
43	$ENABLE_NAMESPACE
44	$NAMESPACE_LEVEL
45	$ENABLE_METHODS
46	$METHOD_LEVELS
47	$TRACE_STACK_LEVELS
48	);
49
50	# default behaviour
51	$LEVEL_DEFAULT = 'debug';
52	$ENABLE_NAMESPACE = 1;
53	$NAMESPACE_LEVEL = undef;
54	$ENABLE_METHODS = 0;
55	$METHOD_LEVELS = [3];
56	$TRACE_STACK_LEVELS = [];
57
58
59	# TODO: review, revise and rewire this!
60	#my $logger = Log::Dispatch::Config->instance;
61
62	sub __init {
63	my $self = shift;
64	my $action = shift;
65	my $message = shift;
66	#my $options = shift; # ??? or: $self->{__logger}->{options} already...?
67
68	# configure
69	if (!$self->{__logger}->{configured}) {
70	$self->{__logger}->{configured} = 1;
71	$self->_configure_LogDispatch();
72	}
73
74	# set passed-in arguments
75	$self->{__logger}->{action} = $action;
76	$self->{__logger}->{message} = $message;
77
78	# trace
79	#my $tmp = caller(2);
80	#print Dumper($tmp);
81	#exit;
82
83
84	# handle caller
85
86	# determine class- and subroutinename of context calling us
87	# this task can be controlled by tuning its behaviour
88	# this can be changed by setting
89	# DesignPattern::Logger::...
90	# ...
91	# ...
92	my $calling_class;
93	my $calling_sub;
94
95
96	# Default behaviour is:
97	# Use classname from $self and suppress subroutine name.
98	# In case of using this together with DesignPattern::Bridge,
99	# the classnames of child objects are suppressed.
100	# Instead, the classname of the parent container object
101	# gets used always.
102	$calling_class = '';
103	$calling_sub = '';
104
105	# Log class names (en-/disabled, take from specified level)
106	if ($ENABLE_NAMESPACE) {
107	$calling_class = ref $self;
108	if ($NAMESPACE_LEVEL) {
109	my @entry = caller($NAMESPACE_LEVEL);
110	$calling_class = $entry[0];
111	}
112	}
113
114	# Log method names (en-/disabled, multi-level)
115	if ($ENABLE_METHODS) {
116	my @methods;
117	foreach (@{$METHOD_LEVELS}) {
118	(my $c_package, my $c_filename, my $c_line, my $c_subroutine, my $c_hasargs,
119	my $c_wantarray, my $c_evaltext, my $c_is_require, my $c_hints, my $c_bitmask) = caller($_);
120	$c_subroutine =~ s/.*:://;
121	push @methods, $c_subroutine;
122	}
123	$calling_sub = join(': ', @methods);
124	}
125
126
127
128	# set default arguments
129	$self->{__logger}->{classname} = $calling_class;
130	$self->{__logger}->{functionname} = $calling_sub;
131	# FIXME: deprecate this!
132	$self->{__logger}->{caller} = caller;
133
134	# set default values
135	$self->{__logger}->{action} \|\|= '';
136	$self->{__logger}->{options}->{tag} \|\|= '';
137
138	# FIXME: deprecate this!
139	#$self->{__logger}->{level} \|\|= 'info';
140	#$self->{__logger}->{level} \|\|= 'debug';
141	$self->{__logger}->{level} \|\|= $LEVEL_DEFAULT;
142
143	# handle stacktrace
144	foreach (@$TRACE_STACK_LEVELS) {
145	#print "trace-level: ", $_, "\n";
146	#(my $c_package, my $c_filename, my $c_line, my $c_subroutine, my $c_hasargs,
147	#my $c_wantarray, my $c_evaltext, my $c_is_require, my $c_hints, my $c_bitmask) = caller($_);
148	my @entry = caller($_);
149	push @{$self->{__logger}->{trace}->{stack}}, \@entry;
150	}
151
152	}
153
154	sub __out {
155	my $self = shift;
156	my $message = shift;
157
158	# if message given here, append to message stored inside object
159	$self->{__logger}->{message} .= ' - ' . $message if $message;
160
161	# TODO: refactor this:
162	# - push '$self->__get_prefix()' to additional log-entry-metadata, don't show it on/in any console/logfile output
163	#$logger->log( level => $self->{__logger}->{level}, message => $self->__get_prefix_long() . $message );
164	#$logger->log( level => $self->{__logger}->{level}, message => $message );
165	#$logger->warning( __PACKAGE__ . "->_skip: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
166	#$self->{__logger}->{instance}->log( level => $self->{__logger}->{level}, message => $self->__get_prefix_short() . $self->{__logger}->{message} );
167	#$self->{__logger}->{instance}->log( level => $self->{__logger}->{level}, message => $self->__get_prefix_module() . $self->{__logger}->{message} );
168	$self->{__logger}->{instance}->log( level => $self->{__logger}->{level}, message => $self->__get_prefix_best() . $self->{__logger}->{message} );
169	}
170
171
172	sub __handle_options {
173	my $self = shift;
174	#my $options = shift; # ??? or: $self->{__logger}->{options} already...?
175	}
176
177	sub __get_prefix_long {
178	my $self = shift;
179	return __PACKAGE__ . "->$self->{__logger}->{action}: '$self->{__logger}->{caller}' (mixed into '$self->{__logger}->{classname}'): ($self->{__logger}->{options}->{tag}) - ";
180	}
181
182	sub __get_prefix_short {
183	my $self = shift;
184	my $tag_append = '';
185	$tag_append = "$self->{__logger}->{options}->{tag} - " if $self->{__logger}->{options}->{tag};
186	return $self->{__logger}->{classname} . "->$self->{__logger}->{action}: $tag_append";
187	}
188
189	sub __get_prefix_module {
190	my $self = shift;
191	my $tag_append = '';
192	$tag_append = "$self->{__logger}->{options}->{tag} - " if $self->{__logger}->{options}->{tag};
193	return $self->{__logger}->{classname} . ": $tag_append";
194	}
195
196
197	sub __get_prefix_best {
198	my $self = shift;
199	my $namespace = $self->{__logger}->{classname};
200	my $method = '';
201	my $tag_append = '';
202	#$namespace = $namespace . ": " if $namespace;
203	$method = "->" . $self->{__logger}->{functionname} if $self->{__logger}->{functionname};
204	#$method .= ': ' if $method;
205	$tag_append = "$self->{__logger}->{options}->{tag} - " if $self->{__logger}->{options}->{tag};
206
207	my @line;
208	push @line, $namespace if $namespace;
209	push @line, $method if $method;
210	push @line, $tag_append if $tag_append;
211
212	#print Dumper(@line);
213
214	#return join(': ', @line);
215	my $result = join('', @line);
216	$result .= ': ' if $result;
217
218	return $result;
219
220	}
221
222
223	sub log {
224	my $self = shift;
225	my $message = shift;
226
227	# automagically instantiate the object if not there
228	# TODO: do this by creating a dummy object inheriting from DesignPattern::Logger,
229	# for now this just don't work because which dummy one to take: Data::Code::Null?
230	#if (! ref $self) {
231	# $self = DesignPattern::Object->fromPackage('DesignPattern::Logger');
232	#}
233
234	$self->{__logger}->{level} = shift; # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
235	$self->{__logger}->{options} = shift; # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
236
237	#$self->__init('log', $message);
238	$self->__init('log', $message);
239	$self->__out();
240
241	}
242
243	sub skip {
244	my $self = shift;
245	my $message = shift;
246	my $condition = shift;
247	$self->{__logger}->{level} = shift; # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
248	$self->{__logger}->{options} = shift; # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
249
250	my $classname = ref $self;
251	my $caller = caller;
252
253	$self->{__logger}->{options}->{tag} \|\|= '';
254
255	if ($condition) {
256	# V1:
257	#$logger->warning( __PACKAGE__ . "->_skip: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
258	# V2:
259	$self->__init('skip', $message);
260	$self->__out();
261	return 1;
262	}
263	}
264
265	sub trace {
266	my $self = shift;
267	my $message = shift;
268	my $data = shift;
269	my $condition = shift;
270	$self->{__logger}->{level} = shift; # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
271	$self->{__logger}->{options} = shift; # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
272
273	my $classname = ref $self;
274	my $caller = caller;
275
276	$self->{__logger}->{options}->{tag} \|\|= '';
277
278	# don't do _any_ tracing if disabled
279	return if $self->{TRACE_DISABLED};
280
281	# overwrite condition with local configured want-TRACE
282	$condition \|\|= $self->{TRACE};
283
284	# dump data
285	my $result = 0;
286	if ($condition) {
287	$message .= " - " . Dumper($data);
288
289	# V1:
290	# $self->__init('trace');
291	# $logger->info( __PACKAGE__ . "->trace: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
292
293	# V2:
294	$self->__init('trace', $message);
295	$self->__out();
296
297	$result = 1;
298	} else {
299	$result = 0;
300	}
301
302	# handle additional options
303	if ($self->{TRACE_OPTIONS}) {
304	exit if $self->{__logger}->{options}->{exit};
305	}
306
307	return $result;
308	}
309
310
311	sub _configure_LogDispatch {
312	my $self = shift;
313
314	my $configurator = DesignPattern::Object->fromPackage('Log::Dispatch::Configurator::Hardwired');
315
316	# FIXME?
317	my $basepath = cwd() . '/..';
318
319	# configure custom logHandler
320
321	if ($configurator) {
322
323	$configurator->{file_filename} = "$basepath/var/log/logfile.txt";
324	$configurator->{screen_min_level} = 'info';
325
326	if ($self->{quiet}) {
327	$configurator->{screen_min_level} = 8;
328	}
329
330	if ($self->{debug}) {
331	$configurator->{screen_min_level} = 'debug';
332	}
333
334	if ($self->{verbose}) {
335	$configurator->{verbose} = 1;
336	}
337
338	Log::Dispatch::Config->configure($configurator);
339	$self->{__logger}->{instance} = Log::Dispatch::Config->instance;
340
341	} else {
342
343	#Log::Dispatch::Config->configure();
344	#Log::Dispatch->configure();
345	#$self->{__logger}->{instance} = Log::Dispatch->new;
346	$self->{__logger}->{instance} = Log::Dispatch::Screen->new( name => 'screen', 'min_level' => 'debug', stderr => 1 );
347
348	}
349
350
351	}
352
353	sub configure_logger {
354	my $self = shift;
355
356	# automagically instantiate the object if not there
357	# TODO: do this by creating a dummy object inheriting from DesignPattern::Logger,
358	# for now this just don't work because which dummy one to take: Data::Code::Null?
359	if (! ref $self) {
360	$self = DesignPattern::Object->fromPackage('DesignPattern::Logger');
361	}
362
363	#print "logconfig\n";
364	$self->_configure_LogDispatch();
365	}
366
367
368
369	# for standalone use
370	sub new { my $class = shift; my $self = {}; bless $self, $class; }
371
372	# convenient shortcuts
373	# FIXME: create these automagically by mungling with symbolic references
374	# or: make this object tied to recieve kinda events on method calls
375
376	sub debug {
377	my $self = shift;
378	my $message = shift;
379	$self->log($message, 'debug');
380	}
381
382	sub warning {
383	my $self = shift;
384	my $message = shift;
385	$self->log($message, 'warning');
386	}
387
388	sub info {
389	my $self = shift;
390	my $message = shift;
391	$self->log($message, 'info');
392	}
393
394	sub notice {
395	my $self = shift;
396	my $message = shift;
397	$self->log($message, 'notice');
398	}
399
400
401
402	=pod
403
404	=head1 TODO
405
406	o $TRACE_STACK_LEVELS (traces stack history)
407	o $ENABLE_DEBUG (en-/disables level 'debug')
408	o $ENABLE_LOG (en-/disables logging completely)
409
410
411	=cut
412
413
414	1;
415	__END__
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26