--- trunk/lib/WebPAC/Common.pm 2005/07/16 11:07:38 3 +++ trunk/lib/WebPAC/Common.pm 2006/09/06 17:51:07 632 @@ -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,80 +15,121 @@ =head1 VERSION -Version 0.01 +Version 0.02 =cut -our $VERSION = '0.01'; +our $VERSION = '0.02'; -=head1 INTERNAL METHODS +=head1 SYNOPSYS -Here is a quick list of internal methods, mostly useful to turn debugging -on them (see L below for explanation). +This module defines common functions, and is used as base for other, more +specific modules. -=cut +=head1 FUNCTIONS -=head2 _eval +=head2 progress_bar -Internal function to eval code without C. +Draw progress bar on STDERR. + + $webpac->progress_bar($current, $max); =cut -sub _eval { +sub progress_bar { my $self = shift; - my $code = shift || return; + my ($curr,$max) = @_; my $log = $self->_get_logger(); - no strict 'subs'; - my $ret = eval $code; - if ($@) { - $log->error("problem with eval code [$code]: $@"); + $log->logconfess("no current value!") if (! $curr); + $log->logconfess("no maximum value!") if (! $max); + + if ($curr > $max) { + $max = $curr; + $log->debug("overflow to $curr"); } - $log->debug("eval: ",$code," [",$ret,"]"); + $self->{'last_pcnt'} ||= 1; + $self->{'start_t'} ||= time(); - return $ret || undef; + my $p = int($curr * 100 / $max) || 1; + + # reset on re-run + if ($p < $self->{'last_pcnt'}) { + $self->{'last_pcnt'} = $p; + $self->{'start_t'} = time(); + } + + if ($p != $self->{'last_pcnt'}) { + + 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; + } + print STDERR "\n" if ($p == 100); } -=head2 _sort_by_order +=head2 fmt_time -Sort xml tags data structure accoding to C attribute. +Format time (in seconds) for display. + + print $webpac->fmt_time(time()); + +This method is called by L to display remaining time. =cut -sub _sort_by_order { +sub fmt_time { my $self = shift; - my $va = $self->{'import_xml'}->{'indexer'}->{$a}->{'order'} || - $self->{'import_xml'}->{'indexer'}->{$a}; - my $vb = $self->{'import_xml'}->{'indexer'}->{$b}->{'order'} || - $self->{'import_xml'}->{'indexer'}->{$b}; + my $t = shift || 0; + my $out = ""; - return $va <=> $vb; + my ($ss,$mm,$hh) = gmtime($t); + $out .= "${hh}h" if ($hh); + $out .= sprintf("%02d:%02d", $mm,$ss); + $out .= " " if ($hh == 0); + return $out; } -=head2 _x +# +# +# -Convert string from UTF-8 to code page defined in C. +=head1 INTERNAL METHODS - my $text = $webpac->_x('utf8 text'); +Here is a quick list of internal methods, mostly useful to turn debugging +on them (see L below for explanation). -Default application code page is C. You will probably want to -change that when creating new instance of object based on this one. +=cut + +=head2 _eval + +Internal function to eval code without C. =cut -sub _x { +sub _eval { my $self = shift; - my $utf8 = shift || return; - # create UTF-8 convertor for import_xml files - $self->{'utf2cp'} ||= Text::Iconv->new('UTF-8' ,$self->{'code_page'} || 'ISO-8859-2'); + my $code = shift || return; + + my $log = $self->_get_logger(); + + no strict 'subs'; + my $ret = eval $code; + if ($@) { + $log->error("problem with eval code [$code]: $@"); + } + + $log->debug("eval: ",$code," [",$ret,"]"); - return $self->{'utf2cp'}->convert($utf8) || - $self->_get_logger()->logwarn("can't convert '$utf8'"); + return $ret || undef; } =head2 _init_logger @@ -93,17 +138,55 @@ $webpac->_init_logger('/path/to/log.conf'); +If no path to configuration file is given, dummy empty configuration +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) { + $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 + +log4perl.logger.WebPAC.=DEBUG + +log4perl.appender.SCREEN=Log::Log4perl::Appender::Screen +log4perl.appender.SCREEN.layout=PatternLayout +log4perl.appender.SCREEN.layout.ConversionPattern=%d %p> %F{1}:%L %M - %m%n + +_log4perl_ + 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 { - my $conf = q( ); - Log::Log4perl->init( \$conf ); + warn "# $name is using null logger\n" if ($log_debug); } + Log::Log4perl->init( \$conf ); + + return 1; } @@ -116,16 +199,38 @@ =cut +my $_logger_seen; + sub _get_logger { my $self = shift; - $self->{'_logger_ok'} ||= $self->_init_logger; + my $name = (caller(2))[3] || caller; + $self->{'_logger_'} ||= $self->_init_logger; - my $name = (caller(1))[3] || caller; - return get_logger($name); + my $log = get_logger( $name ); + warn "# get_logger( $name ) level ", $log->level, "\n" 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 @@ -140,4 +245,6 @@ also use method names, and not only classes (which are just few) to filter logging. +=cut +1;