/[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 16 by dpavlin, Sun Jul 17 11:37:07 2005 UTC revision 763 by dpavlin, Wed Oct 25 20:53:14 2006 UTC
# Line 6  use strict; Line 6  use strict;
6  use Log::Log4perl qw/get_logger :levels/;  use Log::Log4perl qw/get_logger :levels/;
7  use Time::HiRes qw/time/;  use Time::HiRes qw/time/;
8    
9    # If ture, enable logging debug
10    my $log_debug = 0;
11    
12  =head1 NAME  =head1 NAME
13    
14  WebPAC::Common - internal methods called from other WebPAC modules  WebPAC::Common - internal methods called from other WebPAC modules
15    
16  =head1 VERSION  =head1 VERSION
17    
18  Version 0.01  Version 0.04
19    
20  =cut  =cut
21    
22  our $VERSION = '0.01';  our $VERSION = '0.04';
23    
24  =head1 SYNOPSYS  =head1 SYNOPSYS
25    
# Line 40  sub progress_bar { Line 43  sub progress_bar {
43    
44          my $log = $self->_get_logger();          my $log = $self->_get_logger();
45    
46            $self->{last_pcnt_t} ||= time();
47    
48          $log->logconfess("no current value!") if (! $curr);          $log->logconfess("no current value!") if (! $curr);
49          $log->logconfess("no maximum value!") if (! $max);          $log->logconfess("no maximum value!") if (! $max);
50    
# Line 59  sub progress_bar { Line 64  sub progress_bar {
64                  $self->{'start_t'} = time();                  $self->{'start_t'} = time();
65          }          }
66    
67          if ($p != $self->{'last_pcnt'}) {          my $t = time();
68    
69            if ($p != $self->{'last_pcnt'} || ( $t - $self->{last_pcnt_t} ) > 2 ) {
70    
                 my $t = time();  
71                  my $rate = ($curr / ($t - $self->{'start_t'} || 1));                  my $rate = ($curr / ($t - $self->{'start_t'} || 1));
72                  my $eta = ($max-$curr) / ($rate || 1);                  my $eta = ($max-$curr) / ($rate || 1);
73                  printf STDERR ("%5d [%-38s] %-5d %0.1f/s %s\r",$curr,"=" x ($p/3)."$p%>", $max, $rate, $self->fmt_time($eta));                  printf STDERR ("%5d [%-38s] %-5d %0.1f/s %s\r",$curr,"=" x ($p/3)."$p%>", $max, $rate, $self->fmt_time($eta));
74                  $self->{'last_pcnt'} = $p;                  $self->{'last_pcnt'} = $p;
75                  $self->{'last_curr'} = $curr;                  $self->{'last_curr'} = $curr;
76                    $self->{last_pcnt_t} = $t;
77          }          }
78          print STDERR "\n" if ($p == 100);          print STDERR "\n" if ($p == 100);
79  }  }
# Line 139  If no path to configuration file is give Line 146  If no path to configuration file is give
146  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
147  with C<debug> flag, it will turn logging to debug level.  with C<debug> flag, it will turn logging to debug level.
148    
149    This function will also read C<log_conf> value from current object and try
150    to read that as configuration file if it exists, if it doesn't it will
151    fallback to default C<conf/log.conf>.
152    
153    You can disable all logging by adding C<no_log> to constructor of WebPAC
154    object. Object in C<Test::Exception> class will disable logging
155    automatically.
156    
157  =cut  =cut
158    
159  sub _init_logger {  sub _init_logger {
160          my $self = shift;          my $self = shift;
161          my $file = shift;          my $file = shift;
162          if ($file) {          $file ||= $self->{'log_conf'};
163                  Log::Log4perl->init($file);          $file = 'conf/log.conf';
164          } else {          my $name = (caller(2))[3] || caller;
165                  my $conf = q( );  
166                  if ($self->{'debug'}) {          my $conf = q( );
167                          $conf = << '_log4perl_';          if ($self->{'no_log'}) {
168                    warn "# $name disabled logging\n" if ($log_debug);
169            } elsif ($self->{'debug'}) {
170                    $conf = << '_log4perl_';
171    
172  log4perl.rootLogger=INFO, SCREEN  log4perl.rootLogger=INFO, SCREEN
173    
# Line 160  log4perl.appender.SCREEN.layout=PatternL Line 178  log4perl.appender.SCREEN.layout=PatternL
178  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
179    
180  _log4perl_  _log4perl_
181                  }                  warn "# $name is using debug logger\n" if ($log_debug);
182                  Log::Log4perl->init( \$conf );          } elsif ($name =~ m/Test::Exception/o) {
183                    warn "# disabled logging for Text::Exception\n" if ($log_debug);
184            } elsif (-e $file) {
185                    warn "# $name is using $file logger\n" if ($log_debug);
186                    Log::Log4perl->init($file);
187                    return 1;
188            } else {
189                    warn "# $name is using null logger\n" if ($log_debug);
190          }          }
191            Log::Log4perl->init( \$conf );
192    
193            return 1;
194  }  }
195    
196    
# Line 175  method Line 203  method
203    
204  =cut  =cut
205    
206    my $_logger_seen;
207    
208  sub _get_logger {  sub _get_logger {
209          my $self = shift;          my $self = shift;
210    
         $self->{'_logger_ok'} ||= $self->_init_logger;  
   
211          my $name = (caller(1))[3] || caller;          my $name = (caller(1))[3] || caller;
212          return get_logger($name);  
213            # make name full
214            my $f = '';
215            if ($log_debug) {
216                    foreach ( 0 .. 5 ) {
217                            my $s = (caller($_))[3];
218                            $f .= "#### $_ >> $s\n" if ($s);
219                    }
220            }
221    
222            $self->{'_logger_'} ||= $self->_init_logger;
223    
224            my $log = get_logger( $name );
225            warn "# get_logger( $name ) level ", $log->level, "\n$f" if ($log_debug && !defined($_logger_seen->{$name}));
226            $_logger_seen->{$name}++;
227            return $log;
228  }  }
229    
230    
231    =head2 _log
232    
233    Quick cludge to make logging object available to scripts which
234    use webpac line this:
235    
236      my $log = _new WebPAC::Common()->_get_logger();
237    
238    =cut
239    
240    sub _new {
241            my $class = shift;
242            my $self = {@_};
243            bless($self, $class);
244    
245            $self ? return $self : return undef;
246    }
247    
248  =head1 LOGGING  =head1 LOGGING
249    
250  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 199  B<This is different from normal Log4perl Line 259  B<This is different from normal Log4perl
259  also use method names, and not only classes (which are just few)  also use method names, and not only classes (which are just few)
260  to filter logging.  to filter logging.
261    
262    =cut
263    
264    1;
Legend:
Removed from v.16  
changed lines
  Added in v.763
  ViewVC Help
Powered by ViewVC 1.1.26