--- nfo/perl/libs/DesignPattern/Logger.pm 2003/02/19 00:34:52 1.1 +++ nfo/perl/libs/DesignPattern/Logger.pm 2003/02/20 21:06:27 1.2 @@ -1,7 +1,15 @@ ## ------------------------------------------------------------------------ -## $Id: Logger.pm,v 1.1 2003/02/19 00:34:52 joko Exp $ +## $Id: Logger.pm,v 1.2 2003/02/20 21:06:27 joko Exp $ ## ------------------------------------------------------------------------ ## $Log: Logger.pm,v $ +## Revision 1.2 2003/02/20 21:06:27 joko +## + configurable by package globals +## + standalone mode (object creation via 'new') +## + some comments +## + Log::Dispatch gets configured inside here now +## + coordinated stack tracing +## + convenient shortcut methods resembling the syslog levels +## ## Revision 1.1 2003/02/19 00:34:52 joko ## + initial commit, again refactored to this place ## @@ -38,6 +46,23 @@ 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; @@ -58,16 +83,79 @@ $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} = ref $self; + $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} ||= '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; + } } @@ -84,7 +172,8 @@ #$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_module() . $self->{__logger}->{message} ); + $self->{__logger}->{instance}->log( level => $self->{__logger}->{level}, message => $self->__get_prefix_best() . $self->{__logger}->{message} ); } @@ -113,6 +202,32 @@ } +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; @@ -243,5 +358,66 @@ } +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__