/[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 29 by dpavlin, Sun Jul 24 11:17:44 2005 UTC revision 633 by dpavlin, Wed Sep 6 18:08:04 2006 UTC
# Line 15  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.03
19    
20  =cut  =cut
21    
22  our $VERSION = '0.01';  our $VERSION = '0.03';
23    
24  =head1 SYNOPSYS  =head1 SYNOPSYS
25    
# Line 143  will be created. If any mode which inher Line 143  will be created. If any mode which inher
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  This function will also read C<log_conf> value from current object and try
146  to read that as configuration file if it exists.  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    
# Line 153  sub _init_logger { Line 158  sub _init_logger {
158          $file ||= $self->{'log_conf'};          $file ||= $self->{'log_conf'};
159          $file = 'conf/log.conf';          $file = 'conf/log.conf';
160          my $name = (caller(2))[3] || caller;          my $name = (caller(2))[3] || caller;
161          if ($file) {  
162                  warn "# $name is using $file logger\n" if ($log_debug);          my $conf = q( );
163                  Log::Log4perl->init($file);          if ($self->{'no_log'}) {
164          } else {                  warn "# $name disabled logging\n" if ($log_debug);
165                  my $conf = q( );          } elsif ($self->{'debug'}) {
166                  if ($self->{'debug'}) {                  $conf = << '_log4perl_';
                         $conf = << '_log4perl_';  
167    
168  log4perl.rootLogger=INFO, SCREEN  log4perl.rootLogger=INFO, SCREEN
169    
# Line 170  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);                  warn "# $name is using debug logger\n" if ($log_debug);
178                  } else {          } elsif ($name =~ m/Test::Exception/o) {
179                          warn "# $name is using null logger\n" if ($log_debug);                  warn "# disabled logging for Text::Exception\n" if ($log_debug);
180                  }          } elsif (-e $file) {
181                  Log::Log4perl->init( \$conf );                  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 188  method Line 199  method
199    
200  =cut  =cut
201    
202    my $_logger_seen;
203    
204  sub _get_logger {  sub _get_logger {
205          my $self = shift;          my $self = shift;
206    
207          my $name = (caller(2))[3] || caller;          my $name = (caller(1))[3] || caller;
         $self->{'_logger_'} ||= $self->_init_logger;  
208    
209          warn "# get_logger( $name )\n" if ($log_debug);          # make name full
210            my $f = '';
211            if ($log_debug) {
212                    foreach ( 0 .. 5 ) {
213                            my $s = (caller($_))[3];
214                            $f .= "#### $_ >> $s\n" if ($s);
215                    }
216            }
217    
218            $self->{'_logger_'} ||= $self->_init_logger;
219    
220          return get_logger($name);          my $log = get_logger( $name );
221            warn "# get_logger( $name ) level ", $log->level, "\n$f" if ($log_debug && !defined($_logger_seen->{$name}));
222            $_logger_seen->{$name}++;
223            return $log;
224  }  }
225    
226    
227    =head2 _log
228    
229    Quick cludge to make logging object available to scripts which
230    use webpac line this:
231    
232      my $log = _new WebPAC::Common()->_get_logger();
233    
234    =cut
235    
236    sub _new {
237            my $class = shift;
238            my $self = {@_};
239            bless($self, $class);
240    
241            $self ? return $self : return undef;
242    }
243    
244  =head1 LOGGING  =head1 LOGGING
245    
246  Logging in WebPAC is performed by L<Log::Log4perl> with config file  Logging in WebPAC is performed by L<Log::Log4perl> with config file
# Line 214  B<This is different from normal Log4perl Line 255  B<This is different from normal Log4perl
255  also use method names, and not only classes (which are just few)  also use method names, and not only classes (which are just few)
256  to filter logging.  to filter logging.
257    
258    =cut
259    
260    1;
Legend:
Removed from v.29  
changed lines
  Added in v.633
  ViewVC Help
Powered by ViewVC 1.1.26