/[cvs]/nfo/perl/libs/DesignPattern/Logger.pm
ViewVC logotype

Diff of /nfo/perl/libs/DesignPattern/Logger.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by joko, Wed Feb 19 00:34:52 2003 UTC revision 1.3 by joko, Fri Mar 28 07:23:25 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ------------------------------------------------------------------------  ## ------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.3  2003/03/28 07:23:25  joko
6    ##  fix to basepath calculation
7    ##
8    ##  Revision 1.2  2003/02/20 21:06:27  joko
9    ##  + configurable by package globals
10    ##  + standalone mode (object creation via 'new')
11    ##  + some comments
12    ##  + Log::Dispatch gets configured inside here now
13    ##  + coordinated stack tracing
14    ##  + convenient shortcut methods resembling the syslog levels
15    ##
16  ##  Revision 1.1  2003/02/19 00:34:52  joko  ##  Revision 1.1  2003/02/19 00:34:52  joko
17  ##  + initial commit, again refactored to this place  ##  + initial commit, again refactored to this place
18  ##  ##
# Line 38  use Log::Dispatch::Config; Line 49  use Log::Dispatch::Config;
49  use Cwd;  use Cwd;
50  use DesignPattern::Object;  use DesignPattern::Object;
51    
52    use vars qw(
53      $LEVEL_DEFAULT
54      $ENABLE_NAMESPACE
55      $NAMESPACE_LEVEL
56      $ENABLE_METHODS
57      $METHOD_LEVELS
58      $TRACE_STACK_LEVELS
59    );
60    
61    # default behaviour
62    $LEVEL_DEFAULT = 'debug';
63    $ENABLE_NAMESPACE = 1;
64    $NAMESPACE_LEVEL = undef;
65    $ENABLE_METHODS = 0;
66    $METHOD_LEVELS = [3];
67    $TRACE_STACK_LEVELS = [];
68    
69    
70  # TODO: review, revise and rewire this!  # TODO: review, revise and rewire this!
71  #my $logger = Log::Dispatch::Config->instance;  #my $logger = Log::Dispatch::Config->instance;
# Line 58  sub __init { Line 86  sub __init {
86    $self->{__logger}->{action} = $action;    $self->{__logger}->{action} = $action;
87    $self->{__logger}->{message} = $message;    $self->{__logger}->{message} = $message;
88    
89      # trace
90        #my $tmp = caller(2);
91        #print Dumper($tmp);
92        #exit;
93      
94    
95      # handle caller
96    
97        # determine class- and subroutinename of context calling us
98        # this task can be controlled by tuning its behaviour
99        # this can be changed by setting
100        #   DesignPattern::Logger::...
101        #   ...
102        #   ...
103        my $calling_class;
104        my $calling_sub;
105    
106    
107        # Default behaviour is:
108        #   Use classname from $self and suppress subroutine name.
109        #   In case of using this together with DesignPattern::Bridge,
110        #   the classnames of child objects are suppressed.
111        #   Instead, the classname of the parent container object
112        #   gets used *always*.
113          $calling_class = '';
114          $calling_sub = '';
115    
116          # Log class names (en-/disabled, take from specified level)
117          if ($ENABLE_NAMESPACE) {
118            $calling_class = ref $self;
119            if ($NAMESPACE_LEVEL) {
120              my @entry = caller($NAMESPACE_LEVEL);
121              $calling_class = $entry[0];
122            }
123          }
124    
125          # Log method names (en-/disabled, multi-level)
126          if ($ENABLE_METHODS) {
127            my @methods;
128            foreach (@{$METHOD_LEVELS}) {
129              (my $c_package, my $c_filename, my $c_line, my $c_subroutine, my $c_hasargs,
130              my $c_wantarray, my $c_evaltext, my $c_is_require, my $c_hints, my $c_bitmask) = caller($_);
131              $c_subroutine =~ s/.*:://;
132              push @methods, $c_subroutine;
133            }
134            $calling_sub = join(': ', @methods);
135          }
136      
137        
138    
139    # set default arguments    # set default arguments
140    $self->{__logger}->{classname} = ref $self;    $self->{__logger}->{classname} = $calling_class;
141      $self->{__logger}->{functionname} = $calling_sub;
142      # FIXME: deprecate this!
143    $self->{__logger}->{caller} = caller;    $self->{__logger}->{caller} = caller;
144        
145    # set default values    # set default values
146    $self->{__logger}->{action} ||= '';    $self->{__logger}->{action} ||= '';
147    $self->{__logger}->{options}->{tag} ||= '';    $self->{__logger}->{options}->{tag} ||= '';
148        
149      # FIXME: deprecate this!
150    #$self->{__logger}->{level} ||= 'info';    #$self->{__logger}->{level} ||= 'info';
151    $self->{__logger}->{level} ||= 'debug';    #$self->{__logger}->{level} ||= 'debug';
152      $self->{__logger}->{level} ||= $LEVEL_DEFAULT;
153    
154      # handle stacktrace
155        foreach (@$TRACE_STACK_LEVELS) {
156          #print "trace-level: ", $_, "\n";
157          #(my $c_package, my $c_filename, my $c_line, my $c_subroutine, my $c_hasargs,
158          #my $c_wantarray, my $c_evaltext, my $c_is_require, my $c_hints, my $c_bitmask) = caller($_);
159          my @entry = caller($_);
160          push @{$self->{__logger}->{trace}->{stack}}, \@entry;
161        }
162        
163  }  }
164    
# Line 84  sub __out { Line 175  sub __out {
175    #$logger->log( level => $self->{__logger}->{level}, message => $message );    #$logger->log( level => $self->{__logger}->{level}, message => $message );
176    #$logger->warning( __PACKAGE__ . "->_skip: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");    #$logger->warning( __PACKAGE__ . "->_skip: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
177    #$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_short() . $self->{__logger}->{message} );
178    $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} );
179      $self->{__logger}->{instance}->log( level => $self->{__logger}->{level}, message => $self->__get_prefix_best() . $self->{__logger}->{message} );
180  }  }
181    
182    
# Line 113  sub __get_prefix_module { Line 205  sub __get_prefix_module {
205  }  }
206    
207    
208    sub __get_prefix_best {
209      my $self = shift;
210      my $namespace = $self->{__logger}->{classname};
211      my $method = '';
212      my $tag_append = '';
213      #$namespace = $namespace . ": " if $namespace;
214      $method = "->" . $self->{__logger}->{functionname} if $self->{__logger}->{functionname};
215      #$method .= ': ' if $method;
216      $tag_append = "$self->{__logger}->{options}->{tag} - " if $self->{__logger}->{options}->{tag};
217      
218      my @line;
219      push @line, $namespace if $namespace;
220      push @line, $method if $method;
221      push @line, $tag_append if $tag_append;
222      
223      #print Dumper(@line);
224      
225      #return join(': ', @line);
226      my $result = join('', @line);
227      $result .= ': ' if $result;
228      
229      return $result;
230      
231    }
232    
233    
234  sub log {  sub log {
235    my $self = shift;    my $self = shift;
236    my $message = shift;    my $message = shift;
# Line 206  sub _configure_LogDispatch { Line 324  sub _configure_LogDispatch {
324    
325    my $configurator = DesignPattern::Object->fromPackage('Log::Dispatch::Configurator::Hardwired');    my $configurator = DesignPattern::Object->fromPackage('Log::Dispatch::Configurator::Hardwired');
326        
327    # FIXME?    # check if running inside a 'PROJECT' space
328    my $basepath = cwd() . '/..';    my $basepath = cwd();
329      my $postpone = '/..';
330      if (-d $basepath . $postpone . '/PROJECT') {
331        $basepath .= $postpone;
332        $basepath .= "/var/log";
333      }
334        
335    # configure custom logHandler    # configure custom logHandler
336        
337      if ($configurator) {      if ($configurator) {
338        
339        $configurator->{file_filename} = "$basepath/var/log/logfile.txt";        $configurator->{file_filename} = "$basepath/app.log";
340        $configurator->{screen_min_level} = 'info';        $configurator->{screen_min_level} = 'info';
341                
342        if ($self->{quiet}) {        if ($self->{quiet}) {
# Line 243  sub _configure_LogDispatch { Line 366  sub _configure_LogDispatch {
366    
367  }  }
368    
369    sub configure_logger {
370      my $self = shift;
371    
372      # automagically instantiate the object if not there
373      # TODO: do this by creating a dummy object inheriting from DesignPattern::Logger,
374      # for now this just don't work because which dummy one to take: Data::Code::Null?
375      if (! ref $self) {
376        $self = DesignPattern::Object->fromPackage('DesignPattern::Logger');
377      }
378    
379      #print "logconfig\n";
380      $self->_configure_LogDispatch();
381    }
382    
383    
384    
385    # for standalone use
386    sub new { my $class = shift; my $self = {}; bless $self, $class; }
387    
388    # convenient shortcuts
389    # FIXME: create these automagically by mungling with symbolic references
390    # or: make this object tied to recieve kinda events on method calls
391    
392    sub debug {
393      my $self = shift;
394      my $message = shift;
395      $self->log($message, 'debug');
396    }
397    
398    sub warning {
399      my $self = shift;
400      my $message = shift;
401      $self->log($message, 'warning');
402    }
403    
404    sub info {
405      my $self = shift;
406      my $message = shift;
407      $self->log($message, 'info');
408    }
409    
410    sub notice {
411      my $self = shift;
412      my $message = shift;
413      $self->log($message, 'notice');
414    }
415    
416    
417    
418    =pod
419    
420    =head1 TODO
421      
422      o $TRACE_STACK_LEVELS   (traces stack history)
423      o $ENABLE_DEBUG   (en-/disables level 'debug')
424      o $ENABLE_LOG   (en-/disables logging completely)
425    
426    
427    =cut
428    
429    
430  1;  1;
431  __END__  __END__
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed