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