Dispatch/Config/Object.pm

## ------------------------------------------------------------------------
##  $Id: Object.pm,v 1.2 2003/02/18 16:37:22 joko Exp $
## ------------------------------------------------------------------------
##  $Log: Object.pm,v $
##  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 Log::Dispatch::Config::Object;

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->{options} already...?

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

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

sub __out {
  my $self = shift;
  my $message = shift;
  
  # if message given here, append to message stored inside object
  $self->{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->{level}, message => $self->__get_prefix_long() . $message );
  #$logger->log( level => $self->{level}, message => $message );
  #$logger->warning( __PACKAGE__ . "->_skip: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
  #$self->{__logger}->{instance}->log( level => $self->{level}, message => $self->__get_prefix_short() . $self->{message} );
  $self->{__logger}->{instance}->log( level => $self->{level}, message => $self->__get_prefix_module() . $self->{message} );
}


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

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

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

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


sub log {
  my $self = shift;
  my $message = shift;
  $self->{level} = shift;    # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
  $self->{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->{level} = shift;    # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
  $self->{options} = shift;   # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump

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

  $self->{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->{level} = shift;    # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
  $self->{options} = shift;   # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
  
  my $classname = ref $self;
  my $caller = caller;

  $self->{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->{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	joko	1.3	## $Id: Object.pm,v 1.2 2003/02/18 16:37:22 joko Exp $
3	joko	1.1	## ------------------------------------------------------------------------
4	joko	1.2	## $Log: Object.pm,v $
5	joko	1.3	## Revision 1.2 2003/02/18 16:37:22 joko
6			## + fix: ...::Hardwired is an optional module
7			##
8	joko	1.2	## Revision 1.1 2003/02/18 15:57:34 joko
9			## + initial commit, refactored from DesignPattern::Object::Logger
10			##
11	joko	1.1	## Revision 1.2 2003/02/14 14:20:42 joko
12			## + decreased default log-level to debug
13			##
14			## Revision 1.1 2002/12/22 14:17:38 joko
15			## + initial check-in, refactored
16			##
17			## Revision 1.1 2002/12/19 01:14:48 cvsjoko
18			## + initial check-in
19			##
20			## ------------------------------------------------------------------------
21
22
23			package Log::Dispatch::Config::Object;
24
25			use strict;
26			use warnings;
27
28			use Data::Dumper;
29			use Log::Dispatch;
30	joko	1.3	use Log::Dispatch::Screen;
31	joko	1.1	use Log::Dispatch::Config;
32			use Cwd;
33	joko	1.3	use DesignPattern::Object;
34	joko	1.1
35
36			# TODO: review, revise and rewire this!
37			#my $logger = Log::Dispatch::Config->instance;
38
39			sub __init {
40			my $self = shift;
41			my $action = shift;
42			my $message = shift;
43			#my $options = shift; # ??? or: $self->{options} already...?
44
45			# configure
46			if (!$self->{__logger}->{configured}) {
47			$self->{__logger}->{configured} = 1;
48			$self->_configure_LogDispatch();
49			}
50
51			# set passed-in arguments
52			$self->{action} = $action;
53			$self->{message} = $message;
54
55			# set default arguments
56			$self->{classname} = ref $self;
57			$self->{caller} = caller;
58
59			# set default values
60			$self->{action} \|\|= '';
61			$self->{options}->{tag} \|\|= '';
62
63			#$self->{level} \|\|= 'info';
64			$self->{level} \|\|= 'debug';
65
66			}
67
68			sub __out {
69			my $self = shift;
70			my $message = shift;
71
72			# if message given here, append to message stored inside object
73			$self->{message} .= ' - ' . $message if $message;
74
75			# TODO: refactor this:
76			# - push '$self->__get_prefix()' to additional log-entry-metadata, don't show it on/in any console/logfile output
77			#$logger->log( level => $self->{level}, message => $self->__get_prefix_long() . $message );
78			#$logger->log( level => $self->{level}, message => $message );
79			#$logger->warning( __PACKAGE__ . "->_skip: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
80			#$self->{__logger}->{instance}->log( level => $self->{level}, message => $self->__get_prefix_short() . $self->{message} );
81			$self->{__logger}->{instance}->log( level => $self->{level}, message => $self->__get_prefix_module() . $self->{message} );
82			}
83
84
85			sub __handle_options {
86			my $self = shift;
87			#my $options = shift; # ??? or: $self->{options} already...?
88			}
89
90			sub __get_prefix_long {
91			my $self = shift;
92			return __PACKAGE__ . "->$self->{action}: '$self->{caller}' (mixed into '$self->{classname}'): ($self->{options}->{tag}) - ";
93			}
94
95			sub __get_prefix_short {
96			my $self = shift;
97			my $tag_append = '';
98			$tag_append = "$self->{options}->{tag} - " if $self->{options}->{tag};
99			return $self->{classname} . "->$self->{action}: $tag_append";
100			}
101
102			sub __get_prefix_module {
103			my $self = shift;
104			my $tag_append = '';
105			$tag_append = "$self->{options}->{tag} - " if $self->{options}->{tag};
106			return $self->{classname} . ": $tag_append";
107			}
108
109
110			sub log {
111			my $self = shift;
112			my $message = shift;
113			$self->{level} = shift; # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
114			$self->{options} = shift; # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
115
116			#$self->__init('log', $message);
117			$self->__init('log', $message);
118			$self->__out();
119
120			}
121
122			sub skip {
123			my $self = shift;
124			my $message = shift;
125			my $condition = shift;
126			$self->{level} = shift; # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
127			$self->{options} = shift; # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
128
129			my $classname = ref $self;
130			my $caller = caller;
131
132			$self->{options}->{tag} \|\|= '';
133
134			if ($condition) {
135			# V1:
136			#$logger->warning( __PACKAGE__ . "->_skip: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
137			# V2:
138			$self->__init('skip', $message);
139			$self->__out();
140			return 1;
141			}
142			}
143
144			sub trace {
145			my $self = shift;
146			my $message = shift;
147			my $data = shift;
148			my $condition = shift;
149			$self->{level} = shift; # TODO: implement propagation of this into Log::Dispatch-object '$logger'!
150			$self->{options} = shift; # TODO: implement additional behaviours: e.g. { exit => 1 } would exit after tracedump
151
152			my $classname = ref $self;
153			my $caller = caller;
154
155			$self->{options}->{tag} \|\|= '';
156
157			# don't do _any_ tracing if disabled
158			return if $self->{TRACE_DISABLED};
159
160			# overwrite condition with local configured want-TRACE
161			$condition \|\|= $self->{TRACE};
162
163			# dump data
164			my $result = 0;
165			if ($condition) {
166			$message .= " - " . Dumper($data);
167
168			# V1:
169			# $self->__init('trace');
170			# $logger->info( __PACKAGE__ . "->trace: '$caller' (mixed into '$classname'): ($options->{tag}) $message.");
171
172			# V2:
173			$self->__init('trace', $message);
174			$self->__out();
175
176			$result = 1;
177			} else {
178			$result = 0;
179			}
180
181			# handle additional options
182			if ($self->{TRACE_OPTIONS}) {
183			exit if $self->{options}->{exit};
184			}
185
186			return $result;
187			}
188
189
190			sub _configure_LogDispatch {
191			my $self = shift;
192	joko	1.3
193			my $configurator = DesignPattern::Object->fromPackage('Log::Dispatch::Configurator::Hardwired');
194	joko	1.1
195	joko	1.3	# FIXME?
196	joko	1.1	my $basepath = cwd() . '/..';
197
198			# configure custom logHandler
199	joko	1.3
200			if ($configurator) {
201
202			$configurator->{file_filename} = "$basepath/var/log/logfile.txt";
203			$configurator->{screen_min_level} = 'info';
204
205			if ($self->{quiet}) {
206			$configurator->{screen_min_level} = 8;
207			}
208
209			if ($self->{debug}) {
210			$configurator->{screen_min_level} = 'debug';
211			}
212
213			if ($self->{verbose}) {
214			$configurator->{verbose} = 1;
215			}
216
217			Log::Dispatch::Config->configure($configurator);
218			$self->{__logger}->{instance} = Log::Dispatch::Config->instance;
219
220			} else {
221	joko	1.1
222	joko	1.3	#Log::Dispatch::Config->configure();
223			#Log::Dispatch->configure();
224			#$self->{__logger}->{instance} = Log::Dispatch->new;
225			$self->{__logger}->{instance} = Log::Dispatch::Screen->new( name => 'screen', 'min_level' => 'debug', stderr => 1 );
226	joko	1.1
227			}
228
229
230			}
231
232			1;
233			__END__
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26