/[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 6 by dpavlin, Sat Jul 16 14:44:38 2005 UTC revision 13 by dpavlin, Sat Jul 16 23:56:14 2005 UTC
# Line 17  Version 0.01 Line 17  Version 0.01
17    
18  our $VERSION = '0.01';  our $VERSION = '0.01';
19    
 #my $LOOKUP_REGEX = '\[[^\[\]]+\]';  
 #my $LOOKUP_REGEX_SAVE = '\[([^\[\]]+)\]';  
 my $LOOKUP_REGEX = 'lookup{[^\{\}]+}';  
 my $LOOKUP_REGEX_SAVE = 'lookup{([^\{\}]+)}';  
   
20  =head1 SYNOPSYS  =head1 SYNOPSYS
21    
22  This module defines common functions, and is used as base for other, more  This module defines common functions, and is used as base for other, more
# Line 109  sub fill_in { Line 104  sub fill_in {
104                          $log->debug("filter result: $format");                          $log->debug("filter result: $format");
105                  }                  }
106                  # do we have lookups?                  # do we have lookups?
107                  if ($format =~ /$LOOKUP_REGEX/o) {                  if ($self->{'lookup'}) {
                         $log->debug("format '$format' has lookup");  
108                          return $self->lookup($format);                          return $self->lookup($format);
109                  } else {                  } else {
110                          return $format;                          return $format;
# Line 171  sub get_data { Line 165  sub get_data {
165  }  }
166    
167    
168  =head1 INTERNAL METHODS  =head2 progress_bar
169    
170  Here is a quick list of internal methods, mostly useful to turn debugging  Draw progress bar on STDERR.
 on them (see L<LOGGING> below for explanation).  
171    
172  =cut   $webpac->progress_bar($current, $max);
   
 =head2 _eval  
   
 Internal function to eval code without C<strict 'subs'>.  
173    
174  =cut  =cut
175    
176  sub _eval {  sub progress_bar {
177          my $self = shift;          my $self = shift;
178    
179          my $code = shift || return;          my ($curr,$max) = @_;
180    
181          my $log = $self->_get_logger();          my $log = $self->_get_logger();
182    
183          no strict 'subs';          $log->logconfess("no current value!") if (! $curr);
184          my $ret = eval $code;          $log->logconfess("no maximum value!") if (! $max);
185          if ($@) {  
186                  $log->error("problem with eval code [$code]: $@");          if ($curr > $max) {
187                    $max = $curr;
188                    $log->debug("overflow to $curr");
189          }          }
190    
191          $log->debug("eval: ",$code," [",$ret,"]");          $self->{'last_pcnt'} ||= 1;
192            $self->{'start_t'} ||= time();
193    
194          return $ret || undef;          my $p = int($curr * 100 / $max) || 1;
195    
196            # reset on re-run
197            if ($p < $self->{'last_pcnt'}) {
198                    $self->{'last_pcnt'} = $p;
199                    $self->{'start_t'} = time();
200            }
201    
202            if ($p != $self->{'last_pcnt'}) {
203    
204                    my $t = time();
205                    my $rate = ($curr / ($t - $self->{'start_t'} || 1));
206                    my $eta = ($max-$curr) / ($rate || 1);
207                    printf STDERR ("%5d [%-38s] %-5d %0.1f/s %s\r",$curr,"=" x ($p/3)."$p%>", $max, $rate, $self->fmt_time($eta));
208                    $self->{'last_pcnt'} = $p;
209                    $self->{'last_curr'} = $curr;
210            }
211            print STDERR "\n" if ($p == 100);
212  }  }
213    
214  =head2 _sort_by_order  =head2 fmt_time
215    
216  Sort xml tags data structure accoding to C<order=""> attribute.  Format time (in seconds) for display.
217    
218     print $webpac->fmt_time(time());
219    
220    This method is called by L<progress_bar> to display remaining time.
221    
222  =cut  =cut
223    
224  sub _sort_by_order {  sub fmt_time {
225          my $self = shift;          my $self = shift;
226    
227          my $va = $self->{'import_xml'}->{'indexer'}->{$a}->{'order'} ||          my $t = shift || 0;
228                  $self->{'import_xml'}->{'indexer'}->{$a};          my $out = "";
         my $vb = $self->{'import_xml'}->{'indexer'}->{$b}->{'order'} ||  
                 $self->{'import_xml'}->{'indexer'}->{$b};  
229    
230          return $va <=> $vb;          my ($ss,$mm,$hh) = gmtime($t);
231            $out .= "${hh}h" if ($hh);
232            $out .= sprintf("%02d:%02d", $mm,$ss);
233            $out .= "  " if ($hh == 0);
234            return $out;
235  }  }
236    
237  =head2 _x  #
238    #
239    #
240    
241  Convert string from UTF-8 to code page defined in C<import_xml>.  =head1 INTERNAL METHODS
242    
243   my $text = $webpac->_x('utf8 text');  Here is a quick list of internal methods, mostly useful to turn debugging
244    on them (see L<LOGGING> below for explanation).
245    
246    =cut
247    
248  Default application code page is C<ISO-8859-2>. You will probably want to  =head2 _eval
249  change that when creating new instance of object based on this one.  
250    Internal function to eval code without C<strict 'subs'>.
251    
252  =cut  =cut
253    
254  sub _x {  sub _eval {
255          my $self = shift;          my $self = shift;
         my $utf8 = shift || return;  
256    
257          # create UTF-8 convertor for import_xml files          my $code = shift || return;
258          $self->{'utf2cp'} ||= Text::Iconv->new('UTF-8' ,$self->{'code_page'} || 'ISO-8859-2');  
259            my $log = $self->_get_logger();
260    
261          return $self->{'utf2cp'}->convert($utf8) ||          no strict 'subs';
262                  $self->_get_logger()->logwarn("can't convert '$utf8'");          my $ret = eval $code;
263            if ($@) {
264                    $log->error("problem with eval code [$code]: $@");
265            }
266    
267            $log->debug("eval: ",$code," [",$ret,"]");
268    
269            return $ret || undef;
270  }  }
271    
272  =head2 _init_logger  =head2 _init_logger
# Line 248  This function will init C<Log::Log4perl> Line 276  This function will init C<Log::Log4perl>
276    $webpac->_init_logger('/path/to/log.conf');    $webpac->_init_logger('/path/to/log.conf');
277    
278  If no path to configuration file is given, dummy empty configuration  If no path to configuration file is given, dummy empty configuration
279  will be create.  will be created. If any mode which inherits from this one is called
280    with C<debug> flag, it will turn logging to debug level.
281    
282  =cut  =cut
283    
# Line 259  sub _init_logger { Line 288  sub _init_logger {
288                  Log::Log4perl->init($file);                  Log::Log4perl->init($file);
289          } else {          } else {
290                  my $conf = q( );                  my $conf = q( );
291                    if ($self->{'debug'}) {
292                            $conf = << '_log4perl_';
293    
294    log4perl.rootLogger=INFO, SCREEN
295    
296    log4perl.logger.WebPAC.=DEBUG
297    
298    log4perl.appender.SCREEN=Log::Log4perl::Appender::Screen
299    log4perl.appender.SCREEN.layout=PatternLayout
300    log4perl.appender.SCREEN.layout.ConversionPattern=%d %p> %F{1}:%L %M - %m%n
301    
302    _log4perl_
303                    }
304                  Log::Log4perl->init( \$conf );                  Log::Log4perl->init( \$conf );
305          }          }
306  }  }
Legend:
Removed from v.6  
changed lines
  Added in v.13
  ViewVC Help
Powered by ViewVC 1.1.26