/[webpac2]/trunk/lib/WebPAC/Common.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/WebPAC/Common.pm

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

revision 15 by dpavlin, Sun Jul 17 10:42:23 2005 UTC revision 363 by dpavlin, Sun Jan 8 20:27:06 2006 UTC
# Line 3  package WebPAC::Common; Line 3  package WebPAC::Common;
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6  use Log::Log4perl qw(get_logger :levels);  use Log::Log4perl qw/get_logger :levels/;
7    use Time::HiRes qw/time/;
8    
9    # If ture, enable logging debug
10    my $log_debug = 0;
11    
12  =head1 NAME  =head1 NAME
13    
# Line 11  WebPAC::Common - internal methods called Line 15  WebPAC::Common - internal methods called
15    
16  =head1 VERSION  =head1 VERSION
17    
18  Version 0.01  Version 0.02
19    
20  =cut  =cut
21    
22  our $VERSION = '0.01';  our $VERSION = '0.02';
23    
24  =head1 SYNOPSYS  =head1 SYNOPSYS
25    
# Line 138  If no path to configuration file is give Line 142  If no path to configuration file is give
142  will be created. If any mode which inherits from this one is called  will be created. If any mode which inherits from this one is called
143  with C<debug> flag, it will turn logging to debug level.  with C<debug> flag, it will turn logging to debug level.
144    
145    This function will also read C<log_conf> value from current object and try
146    to read that as configuration file if it exists, if it doesn't it will
147    fallback to default C<conf/log.conf>.
148    
149    You can disable all logging by adding C<no_log> to constructor of WebPAC
150    object. Object in C<Test::Exception> class will disable logging
151    automatically.
152    
153  =cut  =cut
154    
155  sub _init_logger {  sub _init_logger {
156          my $self = shift;          my $self = shift;
157          my $file = shift;          my $file = shift;
158          if ($file) {          $file ||= $self->{'log_conf'};
159                  Log::Log4perl->init($file);          $file = 'conf/log.conf';
160          } else {          my $name = (caller(2))[3] || caller;
161                  my $conf = q( );  
162                  if ($self->{'debug'}) {          my $conf = q( );
163                          $conf = << '_log4perl_';          if ($self->{'no_log'}) {
164                    warn "# $name disabled logging\n" if ($log_debug);
165            } elsif ($self->{'debug'}) {
166                    $conf = << '_log4perl_';
167    
168  log4perl.rootLogger=INFO, SCREEN  log4perl.rootLogger=INFO, SCREEN
169    
# Line 159  log4perl.appender.SCREEN.layout=PatternL Line 174  log4perl.appender.SCREEN.layout=PatternL
174  log4perl.appender.SCREEN.layout.ConversionPattern=%d %p> %F{1}:%L %M - %m%n  log4perl.appender.SCREEN.layout.ConversionPattern=%d %p> %F{1}:%L %M - %m%n
175    
176  _log4perl_  _log4perl_
177                  }                  warn "# $name is using debug logger\n" if ($log_debug);
178                  Log::Log4perl->init( \$conf );          } elsif ($name =~ m/Test::Exception/o) {
179                    warn "# disabled logging for Text::Exception\n" if ($log_debug);
180            } elsif (-e $file) {
181                    warn "# $name is using $file logger\n" if ($log_debug);
182                    Log::Log4perl->init($file);
183                    return 1;
184            } else {
185                    warn "# $name is using null logger\n" if ($log_debug);
186          }          }
187            Log::Log4perl->init( \$conf );
188    
189            return 1;
190  }  }
191    
192    
# Line 177  method Line 202  method
202  sub _get_logger {  sub _get_logger {
203          my $self = shift;          my $self = shift;
204    
205          $self->{'_logger_ok'} ||= $self->_init_logger;          my $name = (caller(2))[3] || caller;
206            $self->{'_logger_'} ||= $self->_init_logger;
207    
208          my $name = (caller(1))[3] || caller;          my $log = get_logger( $name );
209          return get_logger($name);          warn "# get_logger( $name ) level ", $log->level, "\n" if ($log_debug);
210            return $log;
211  }  }
212    
213    
214    =head2 _log
215    
216    Quick cludge to make logging object available to scripts which
217    use webpac line this:
218    
219      my $log = _new WebPAC::Common()->_get_logger();
220    
221    =cut
222    
223    sub _new {
224            my $class = shift;
225            my $self = {@_};
226            bless($self, $class);
227    
228            $self ? return $self : return undef;
229    }
230    
231  =head1 LOGGING  =head1 LOGGING
232    
233  Logging in WebPAC is performed by L<Log::Log4perl> with config file  Logging in WebPAC is performed by L<Log::Log4perl> with config file
Legend:
Removed from v.15  
changed lines
  Added in v.363
  ViewVC Help
Powered by ViewVC 1.1.26