/[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 3 by dpavlin, Sat Jul 16 11:07:38 2005 UTC revision 16 by dpavlin, Sun Jul 17 11:37:07 2005 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  =head1 NAME  =head1 NAME
10    
# Line 17  Version 0.01 Line 18  Version 0.01
18    
19  our $VERSION = '0.01';  our $VERSION = '0.01';
20    
21  =head1 INTERNAL METHODS  =head1 SYNOPSYS
22    
23  Here is a quick list of internal methods, mostly useful to turn debugging  This module defines common functions, and is used as base for other, more
24  on them (see L<LOGGING> below for explanation).  specific modules.
25    
26  =cut  =head1 FUNCTIONS
27    
28  =head2 _eval  =head2 progress_bar
29    
30  Internal function to eval code without C<strict 'subs'>.  Draw progress bar on STDERR.
31    
32     $webpac->progress_bar($current, $max);
33    
34  =cut  =cut
35    
36  sub _eval {  sub progress_bar {
37          my $self = shift;          my $self = shift;
38    
39          my $code = shift || return;          my ($curr,$max) = @_;
40    
41          my $log = $self->_get_logger();          my $log = $self->_get_logger();
42    
43          no strict 'subs';          $log->logconfess("no current value!") if (! $curr);
44          my $ret = eval $code;          $log->logconfess("no maximum value!") if (! $max);
45          if ($@) {  
46                  $log->error("problem with eval code [$code]: $@");          if ($curr > $max) {
47                    $max = $curr;
48                    $log->debug("overflow to $curr");
49          }          }
50    
51          $log->debug("eval: ",$code," [",$ret,"]");          $self->{'last_pcnt'} ||= 1;
52            $self->{'start_t'} ||= time();
53    
54          return $ret || undef;          my $p = int($curr * 100 / $max) || 1;
55    
56            # reset on re-run
57            if ($p < $self->{'last_pcnt'}) {
58                    $self->{'last_pcnt'} = $p;
59                    $self->{'start_t'} = time();
60            }
61    
62            if ($p != $self->{'last_pcnt'}) {
63    
64                    my $t = time();
65                    my $rate = ($curr / ($t - $self->{'start_t'} || 1));
66                    my $eta = ($max-$curr) / ($rate || 1);
67                    printf STDERR ("%5d [%-38s] %-5d %0.1f/s %s\r",$curr,"=" x ($p/3)."$p%>", $max, $rate, $self->fmt_time($eta));
68                    $self->{'last_pcnt'} = $p;
69                    $self->{'last_curr'} = $curr;
70            }
71            print STDERR "\n" if ($p == 100);
72  }  }
73    
74  =head2 _sort_by_order  =head2 fmt_time
75    
76    Format time (in seconds) for display.
77    
78  Sort xml tags data structure accoding to C<order=""> attribute.   print $webpac->fmt_time(time());
79    
80    This method is called by L<progress_bar> to display remaining time.
81    
82  =cut  =cut
83    
84  sub _sort_by_order {  sub fmt_time {
85          my $self = shift;          my $self = shift;
86    
87          my $va = $self->{'import_xml'}->{'indexer'}->{$a}->{'order'} ||          my $t = shift || 0;
88                  $self->{'import_xml'}->{'indexer'}->{$a};          my $out = "";
         my $vb = $self->{'import_xml'}->{'indexer'}->{$b}->{'order'} ||  
                 $self->{'import_xml'}->{'indexer'}->{$b};  
89    
90          return $va <=> $vb;          my ($ss,$mm,$hh) = gmtime($t);
91            $out .= "${hh}h" if ($hh);
92            $out .= sprintf("%02d:%02d", $mm,$ss);
93            $out .= "  " if ($hh == 0);
94            return $out;
95  }  }
96    
97  =head2 _x  #
98    #
99    #
100    
101  Convert string from UTF-8 to code page defined in C<import_xml>.  =head1 INTERNAL METHODS
102    
103   my $text = $webpac->_x('utf8 text');  Here is a quick list of internal methods, mostly useful to turn debugging
104    on them (see L<LOGGING> below for explanation).
105    
106    =cut
107    
108  Default application code page is C<ISO-8859-2>. You will probably want to  =head2 _eval
109  change that when creating new instance of object based on this one.  
110    Internal function to eval code without C<strict 'subs'>.
111    
112  =cut  =cut
113    
114  sub _x {  sub _eval {
115          my $self = shift;          my $self = shift;
         my $utf8 = shift || return;  
116    
117          # create UTF-8 convertor for import_xml files          my $code = shift || return;
118          $self->{'utf2cp'} ||= Text::Iconv->new('UTF-8' ,$self->{'code_page'} || 'ISO-8859-2');  
119            my $log = $self->_get_logger();
120    
121            no strict 'subs';
122            my $ret = eval $code;
123            if ($@) {
124                    $log->error("problem with eval code [$code]: $@");
125            }
126    
127            $log->debug("eval: ",$code," [",$ret,"]");
128    
129          return $self->{'utf2cp'}->convert($utf8) ||          return $ret || undef;
                 $self->_get_logger()->logwarn("can't convert '$utf8'");  
130  }  }
131    
132  =head2 _init_logger  =head2 _init_logger
# Line 93  This function will init C<Log::Log4perl> Line 135  This function will init C<Log::Log4perl>
135    
136    $webpac->_init_logger('/path/to/log.conf');    $webpac->_init_logger('/path/to/log.conf');
137    
138    If no path to configuration file is given, dummy empty configuration
139    will be created. If any mode which inherits from this one is called
140    with C<debug> flag, it will turn logging to debug level.
141    
142  =cut  =cut
143    
144  sub _init_logger {  sub _init_logger {
# Line 102  sub _init_logger { Line 148  sub _init_logger {
148                  Log::Log4perl->init($file);                  Log::Log4perl->init($file);
149          } else {          } else {
150                  my $conf = q( );                  my $conf = q( );
151                    if ($self->{'debug'}) {
152                            $conf = << '_log4perl_';
153    
154    log4perl.rootLogger=INFO, SCREEN
155    
156    log4perl.logger.WebPAC.=DEBUG
157    
158    log4perl.appender.SCREEN=Log::Log4perl::Appender::Screen
159    log4perl.appender.SCREEN.layout=PatternLayout
160    log4perl.appender.SCREEN.layout.ConversionPattern=%d %p> %F{1}:%L %M - %m%n
161    
162    _log4perl_
163                    }
164                  Log::Log4perl->init( \$conf );                  Log::Log4perl->init( \$conf );
165          }          }
166  }  }
Legend:
Removed from v.3  
changed lines
  Added in v.16
  ViewVC Help
Powered by ViewVC 1.1.26