libs/DesignPattern/Logger.pm

## ------------------------------------------------------------------------
##  $Id: Object.pm,v 1.3 2003/02/18 18:33:59 joko Exp $
## ------------------------------------------------------------------------
##  $Log: Object.pm,v $
##  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;


# 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;

  # set default arguments
  $self->{__logger}->{classname} = ref $self;
  $self->{__logger}->{caller} = caller;
  
  # set default values
  $self->{__logger}->{action} ||= '';
  $self->{__logger}->{options}->{tag} ||= '';
  
  #$self->{__logger}->{level} ||= 'info';
  $self->{__logger}->{level} ||= 'debug';
  
}

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} );
}


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 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 );
    
    }


}

1;
__END__
1	joko	1.1	## ------------------------------------------------------------------------
2			## $Id: Object.pm,v 1.3 2003/02/18 18:33:59 joko Exp $
3			## ------------------------------------------------------------------------
4			## $Log: Object.pm,v $
5			## Revision 1.3 2003/02/18 18:33:59 joko
6			## + fix: just logs if possible
7			##
8			## Revision 1.2 2003/02/18 16:37:22 joko
9			## + fix: ...::Hardwired is an optional module
10			##
11			## Revision 1.1 2003/02/18 15:57:34 joko
12			## + initial commit, refactored from DesignPattern::Object::Logger
13			##
14			## 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 DesignPattern::Logger;
27
28			use strict;
29			use warnings;
30
31			use Data::Dumper;
32			use Log::Dispatch;
33			use Log::Dispatch::Screen;
34			use Log::Dispatch::Config;
35			use Cwd;
36			use DesignPattern::Object;
37
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->{__logger}->{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->{__logger}->{action} = $action;
56			$self->{__logger}->{message} = $message;
57
58			# set default arguments
59			$self->{__logger}->{classname} = ref $self;
60			$self->{__logger}->{caller} = caller;
61
62			# set default values
63			$self->{__logger}->{action} \|\|= '';
64			$self->{__logger}->{options}->{tag} \|\|= '';
65
66			#$self->{__logger}->{level} \|\|= 'info';
67			$self->{__logger}->{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->{__logger}->{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->{__logger}->{level}, message => $self->__get_prefix_long() . $message );
81			#$logger->log( level => $self->{__logger}->{level}, message => $message );
82			#$logger->warning( __PACKAGE__ . "->_skip: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
83			#$self->{__logger}->{instance}->log( level => $self->{__logger}->{level}, message => $self->__get_prefix_short() . $self->{__logger}->{message} );
84			$self->{__logger}->{instance}->log( level => $self->{__logger}->{level}, message => $self->__get_prefix_module() . $self->{__logger}->{message} );
85			}
86
87
88			sub __handle_options {
89			my $self = shift;
90			#my $options = shift; # ??? or: $self->{__logger}->{options} already...?
91			}
92
93			sub __get_prefix_long {
94			my $self = shift;
95			return __PACKAGE__ . "->$self->{__logger}->{action}: '$self->{__logger}->{caller}' (mixed into '$self->{__logger}->{classname}'): ($self->{__logger}->{options}->{tag}) - ";
96			}
97
98			sub __get_prefix_short {
99			my $self = shift;
100			my $tag_append = '';
101			$tag_append = "$self->{__logger}->{options}->{tag} - " if $self->{__logger}->{options}->{tag};
102			return $self->{__logger}->{classname} . "->$self->{__logger}->{action}: $tag_append";
103			}
104
105			sub __get_prefix_module {
106			my $self = shift;
107			my $tag_append = '';
108			$tag_append = "$self->{__logger}->{options}->{tag} - " if $self->{__logger}->{options}->{tag};
109			return $self->{__logger}->{classname} . ": $tag_append";
110			}
111
112
113			sub log {
114			my $self = shift;
115			my $message = shift;
116
117			# automagically instantiate the object if not there
118			# TODO: do this by creating a dummy object inheriting from DesignPattern::Logger,
119			# for now this just don't work because which dummy one to take: Data::Code::Null?
120			#if (! ref $self) {
121			# $self = DesignPattern::Object->fromPackage('DesignPattern::Logger');
122			#}
123
124			$self->{__logger}->{level} = shift; # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
125			$self->{__logger}->{options} = shift; # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
126
127			#$self->__init('log', $message);
128			$self->__init('log', $message);
129			$self->__out();
130
131			}
132
133			sub skip {
134			my $self = shift;
135			my $message = shift;
136			my $condition = shift;
137			$self->{__logger}->{level} = shift; # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
138			$self->{__logger}->{options} = shift; # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
139
140			my $classname = ref $self;
141			my $caller = caller;
142
143			$self->{__logger}->{options}->{tag} \|\|= '';
144
145			if ($condition) {
146			# V1:
147			#$logger->warning( __PACKAGE__ . "->_skip: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
148			# V2:
149			$self->__init('skip', $message);
150			$self->__out();
151			return 1;
152			}
153			}
154
155			sub trace {
156			my $self = shift;
157			my $message = shift;
158			my $data = shift;
159			my $condition = shift;
160			$self->{__logger}->{level} = shift; # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
161			$self->{__logger}->{options} = shift; # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
162
163			my $classname = ref $self;
164			my $caller = caller;
165
166			$self->{__logger}->{options}->{tag} \|\|= '';
167
168			# don't do _any_ tracing if disabled
169			return if $self->{TRACE_DISABLED};
170
171			# overwrite condition with local configured want-TRACE
172			$condition \|\|= $self->{TRACE};
173
174			# dump data
175			my $result = 0;
176			if ($condition) {
177			$message .= " - " . Dumper($data);
178
179			# V1:
180			# $self->__init('trace');
181			# $logger->info( __PACKAGE__ . "->trace: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
182
183			# V2:
184			$self->__init('trace', $message);
185			$self->__out();
186
187			$result = 1;
188			} else {
189			$result = 0;
190			}
191
192			# handle additional options
193			if ($self->{TRACE_OPTIONS}) {
194			exit if $self->{__logger}->{options}->{exit};
195			}
196
197			return $result;
198			}
199
200
201			sub _configure_LogDispatch {
202			my $self = shift;
203
204			my $configurator = DesignPattern::Object->fromPackage('Log::Dispatch::Configurator::Hardwired');
205
206			# FIXME?
207			my $basepath = cwd() . '/..';
208
209			# configure custom logHandler
210
211			if ($configurator) {
212
213			$configurator->{file_filename} = "$basepath/var/log/logfile.txt";
214			$configurator->{screen_min_level} = 'info';
215
216			if ($self->{quiet}) {
217			$configurator->{screen_min_level} = 8;
218			}
219
220			if ($self->{debug}) {
221			$configurator->{screen_min_level} = 'debug';
222			}
223
224			if ($self->{verbose}) {
225			$configurator->{verbose} = 1;
226			}
227
228			Log::Dispatch::Config->configure($configurator);
229			$self->{__logger}->{instance} = Log::Dispatch::Config->instance;
230
231			} else {
232
233			#Log::Dispatch::Config->configure();
234			#Log::Dispatch->configure();
235			#$self->{__logger}->{instance} = Log::Dispatch->new;
236			$self->{__logger}->{instance} = Log::Dispatch::Screen->new( name => 'screen', 'min_level' => 'debug', stderr => 1 );
237
238			}
239
240
241			}
242
243			1;
244			__END__
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26