/[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 73 by dpavlin, Sun Nov 20 20:13:33 2005 UTC revision 856 by dpavlin, Sun May 27 16:00:26 2007 UTC
# Line 5  use strict; Line 5  use strict;
5    
6  use Log::Log4perl qw/get_logger :levels/;  use Log::Log4perl qw/get_logger :levels/;
7  use Time::HiRes qw/time/;  use Time::HiRes qw/time/;
8    use Data::Dump qw/dump/;
9    
10  # If ture, enable logging debug  # If ture, enable logging debug
11  my $log_debug = 0;  my $log_debug = 0;
# Line 15  WebPAC::Common - internal methods called Line 16  WebPAC::Common - internal methods called
16    
17  =head1 VERSION  =head1 VERSION
18    
19  Version 0.01  Version 0.04
20    
21  =cut  =cut
22    
23  our $VERSION = '0.01';  our $VERSION = '0.04';
24    
25  =head1 SYNOPSYS  =head1 SYNOPSYS
26    
# Line 43  sub progress_bar { Line 44  sub progress_bar {
44    
45          my $log = $self->_get_logger();          my $log = $self->_get_logger();
46    
47            $self->{last_pcnt_t} ||= time();
48    
49          $log->logconfess("no current value!") if (! $curr);          $log->logconfess("no current value!") if (! $curr);
50          $log->logconfess("no maximum value!") if (! $max);          $log->logconfess("no maximum value!") if (! $max);
51    
# Line 62  sub progress_bar { Line 65  sub progress_bar {
65                  $self->{'start_t'} = time();                  $self->{'start_t'} = time();
66          }          }
67    
68          if ($p != $self->{'last_pcnt'}) {          my $t = time();
69    
70            if ($p != $self->{'last_pcnt'} || ( $t - $self->{last_pcnt_t} ) > 2 ) {
71    
                 my $t = time();  
72                  my $rate = ($curr / ($t - $self->{'start_t'} || 1));                  my $rate = ($curr / ($t - $self->{'start_t'} || 1));
73                  my $eta = ($max-$curr) / ($rate || 1);                  my $eta = ($max-$curr) / ($rate || 1);
74                  printf STDERR ("%5d [%-38s] %-5d %0.1f/s %s\r",$curr,"=" x ($p/3)."$p%>", $max, $rate, $self->fmt_time($eta));                  printf STDERR ("%5d [%-38s] %-5d %0.1f/s %s\r",$curr,"=" x ($p/3)."$p%>", $max, $rate, $self->fmt_time($eta));
75                  $self->{'last_pcnt'} = $p;                  $self->{'last_pcnt'} = $p;
76                  $self->{'last_curr'} = $curr;                  $self->{'last_curr'} = $curr;
77                    $self->{last_pcnt_t} = $t;
78          }          }
79          print STDERR "\n" if ($p == 100);          print STDERR "\n" if ($p == 100);
80  }  }
# Line 97  sub fmt_time { Line 102  sub fmt_time {
102          return $out;          return $out;
103  }  }
104    
105    =head2 fill_in
106    
107    Fill in variable names by values
108    
109      print $webpac->fill_in( 'foo = $foo bar = $bar',
110            foo => 42, bar => 11,
111      );
112    
113    =cut
114    
115    sub fill_in {
116            my $self = shift;
117    
118            my $format = shift || die "no format?";
119            my $d = {@_};
120    
121            foreach my $n ( keys %$d ) {
122                    $format =~ s/\$\Q$n\E/$d->{$n}/gs;
123            }
124    
125            die "unknown variables in '$format' input data = ", dump( $d ) if ( $format =~ m/\$\w+/ );
126    
127            return $format;
128    }
129    
130  #  #
131  #  #
132  #  #
# Line 199  method Line 229  method
229    
230  =cut  =cut
231    
232    my $_logger_seen;
233    
234  sub _get_logger {  sub _get_logger {
235          my $self = shift;          my $self = shift;
236    
237          my $name = (caller(2))[3] || caller;          my $name = (caller(1))[3] || caller;
238          $self->{'_logger_'} ||= $self->_init_logger;  
239            # make name full
240            my $f = '';
241            if ($log_debug) {
242                    foreach ( 0 .. 5 ) {
243                            my $s = (caller($_))[3];
244                            $f .= "#### $_ >> $s\n" if ($s);
245                    }
246            }
247    
248          warn "# get_logger( $name )\n" if ($log_debug);          $self->{'_logger_'} ||= $self->_init_logger;
249    
250          return get_logger($name);          my $log = get_logger( $name );
251            warn "# get_logger( $name ) level ", $log->level, "\n$f" if ($log_debug && !defined($_logger_seen->{$name}));
252            $_logger_seen->{$name}++;
253            return $log;
254  }  }
255    
256    
257    =head2 _log
258    
259    Quick cludge to make logging object available to scripts which
260    use webpac line this:
261    
262      my $log = _new WebPAC::Common()->_get_logger();
263    
264    =cut
265    
266    sub _new {
267            my $class = shift;
268            my $self = {@_};
269            bless($self, $class);
270    
271            $self ? return $self : return undef;
272    }
273    
274  =head1 LOGGING  =head1 LOGGING
275    
276  Logging in WebPAC is performed by L<Log::Log4perl> with config file  Logging in WebPAC is performed by L<Log::Log4perl> with config file
# Line 225  B<This is different from normal Log4perl Line 285  B<This is different from normal Log4perl
285  also use method names, and not only classes (which are just few)  also use method names, and not only classes (which are just few)
286  to filter logging.  to filter logging.
287    
288    =cut
289    
290    1;
Legend:
Removed from v.73  
changed lines
  Added in v.856
  ViewVC Help
Powered by ViewVC 1.1.26