--- trunk/lib/WebPAC/Common.pm 2005/07/17 10:42:23 15 +++ trunk/lib/WebPAC/Common.pm 2006/10/25 20:53:14 763 @@ -3,7 +3,11 @@ use warnings; use strict; -use Log::Log4perl qw(get_logger :levels); +use Log::Log4perl qw/get_logger :levels/; +use Time::HiRes qw/time/; + +# If ture, enable logging debug +my $log_debug = 0; =head1 NAME @@ -11,11 +15,11 @@ =head1 VERSION -Version 0.01 +Version 0.04 =cut -our $VERSION = '0.01'; +our $VERSION = '0.04'; =head1 SYNOPSYS @@ -39,6 +43,8 @@ my $log = $self->_get_logger(); + $self->{last_pcnt_t} ||= time(); + $log->logconfess("no current value!") if (! $curr); $log->logconfess("no maximum value!") if (! $max); @@ -58,14 +64,16 @@ $self->{'start_t'} = time(); } - if ($p != $self->{'last_pcnt'}) { + my $t = time(); + + if ($p != $self->{'last_pcnt'} || ( $t - $self->{last_pcnt_t} ) > 2 ) { - my $t = time(); my $rate = ($curr / ($t - $self->{'start_t'} || 1)); my $eta = ($max-$curr) / ($rate || 1); printf STDERR ("%5d [%-38s] %-5d %0.1f/s %s\r",$curr,"=" x ($p/3)."$p%>", $max, $rate, $self->fmt_time($eta)); $self->{'last_pcnt'} = $p; $self->{'last_curr'} = $curr; + $self->{last_pcnt_t} = $t; } print STDERR "\n" if ($p == 100); } @@ -138,17 +146,28 @@ will be created. If any mode which inherits from this one is called with C flag, it will turn logging to debug level. +This function will also read C value from current object and try +to read that as configuration file if it exists, if it doesn't it will +fallback to default C. + +You can disable all logging by adding C to constructor of WebPAC +object. Object in C class will disable logging +automatically. + =cut sub _init_logger { my $self = shift; my $file = shift; - if ($file) { - Log::Log4perl->init($file); - } else { - my $conf = q( ); - if ($self->{'debug'}) { - $conf = << '_log4perl_'; + $file ||= $self->{'log_conf'}; + $file = 'conf/log.conf'; + my $name = (caller(2))[3] || caller; + + my $conf = q( ); + if ($self->{'no_log'}) { + warn "# $name disabled logging\n" if ($log_debug); + } elsif ($self->{'debug'}) { + $conf = << '_log4perl_'; log4perl.rootLogger=INFO, SCREEN @@ -159,9 +178,19 @@ log4perl.appender.SCREEN.layout.ConversionPattern=%d %p> %F{1}:%L %M - %m%n _log4perl_ - } - Log::Log4perl->init( \$conf ); + warn "# $name is using debug logger\n" if ($log_debug); + } elsif ($name =~ m/Test::Exception/o) { + warn "# disabled logging for Text::Exception\n" if ($log_debug); + } elsif (-e $file) { + warn "# $name is using $file logger\n" if ($log_debug); + Log::Log4perl->init($file); + return 1; + } else { + warn "# $name is using null logger\n" if ($log_debug); } + Log::Log4perl->init( \$conf ); + + return 1; } @@ -174,16 +203,48 @@ =cut +my $_logger_seen; + sub _get_logger { my $self = shift; - $self->{'_logger_ok'} ||= $self->_init_logger; - my $name = (caller(1))[3] || caller; - return get_logger($name); + + # make name full + my $f = ''; + if ($log_debug) { + foreach ( 0 .. 5 ) { + my $s = (caller($_))[3]; + $f .= "#### $_ >> $s\n" if ($s); + } + } + + $self->{'_logger_'} ||= $self->_init_logger; + + my $log = get_logger( $name ); + warn "# get_logger( $name ) level ", $log->level, "\n$f" if ($log_debug && !defined($_logger_seen->{$name})); + $_logger_seen->{$name}++; + return $log; } +=head2 _log + +Quick cludge to make logging object available to scripts which +use webpac line this: + + my $log = _new WebPAC::Common()->_get_logger(); + +=cut + +sub _new { + my $class = shift; + my $self = {@_}; + bless($self, $class); + + $self ? return $self : return undef; +} + =head1 LOGGING Logging in WebPAC is performed by L with config file @@ -198,4 +259,6 @@ also use method names, and not only classes (which are just few) to filter logging. +=cut +1;