/[webpac2]/trunk/lib/WebPAC/Input.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/Input.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 483 by dpavlin, Sun May 14 09:34:05 2006 UTC revision 513 by dpavlin, Tue May 16 13:08:31 2006 UTC
# Line 3  package WebPAC::Input; Line 3  package WebPAC::Input;
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6  use WebPAC::Common 0.03;  use blib;
7    
8    use WebPAC::Common;
9  use base qw/WebPAC::Common/;  use base qw/WebPAC::Common/;
10  use Text::Iconv;  use Text::Iconv;
11  use Data::Dumper;  use Data::Dumper;
# Line 14  WebPAC::Input - read different file form Line 16  WebPAC::Input - read different file form
16    
17  =head1 VERSION  =head1 VERSION
18    
19  Version 0.04  Version 0.05
20    
21  =cut  =cut
22    
23  our $VERSION = '0.04';  our $VERSION = '0.05';
24    
25  =head1 SYNOPSIS  =head1 SYNOPSIS
26    
# Line 160  This function will read whole database i Line 162  This function will read whole database i
162          limit => 500,          limit => 500,
163          offset => 6000,          offset => 6000,
164          lookup => $lookup_obj,          lookup => $lookup_obj,
165            stats => 1,
166   );   );
167    
168  By default, C<code_page> is assumed to be C<852>.  By default, C<code_page> is assumed to be C<852>.
# Line 168  C<offset> is optional parametar to posit Line 171  C<offset> is optional parametar to posit
171    
172  C<limit> is optional parametar to read just C<limit> records from database  C<limit> is optional parametar to read just C<limit> records from database
173    
174    C<stats> create optional report about usage of fields and subfields
175    
176  Returns size of database, regardless of C<offset> and C<limit>  Returns size of database, regardless of C<offset> and C<limit>
177  parametars, see also C<size>.  parametars, see also C<size>.
178    
# Line 224  sub open { Line 229  sub open {
229                  filter => $filter_ref,                  filter => $filter_ref,
230          );          );
231    
232          unless ($db) {          unless (defined($db)) {
233                  $log->logwarn("can't open database $arg->{path}, skipping...");                  $log->logwarn("can't open database $arg->{path}, skipping...");
234                  return;                  return;
235          }          }
# Line 238  sub open { Line 243  sub open {
243          my $to_rec = $size;          my $to_rec = $size;
244    
245          if (my $s = $self->{offset}) {          if (my $s = $self->{offset}) {
246                  $log->info("skipping to MFN $s");                  $log->debug("skipping to MFN $s");
247                  $from_rec = $s;                  $from_rec = $s;
248          } else {          } else {
249                  $self->{offset} = $from_rec;                  $self->{offset} = $from_rec;
# Line 253  sub open { Line 258  sub open {
258          # store size for later          # store size for later
259          $self->{size} = ($to_rec - $from_rec) ? ($to_rec - $from_rec + 1) : 0;          $self->{size} = ($to_rec - $from_rec) ? ($to_rec - $from_rec + 1) : 0;
260    
261          $log->info("processing $self->{size}/$size records [$from_rec-$to_rec] convert $code_page -> $self->{code_page}");          $log->info("processing $self->{size}/$size records [$from_rec-$to_rec] convert $code_page -> $self->{code_page}", $self->{stats} ? ' [stats]' : '');
262    
263          # read database          # read database
264          for (my $pos = $from_rec; $pos <= $to_rec; $pos++) {          for (my $pos = $from_rec; $pos <= $to_rec; $pos++) {
# Line 279  sub open { Line 284  sub open {
284                  # create lookup                  # create lookup
285                  $self->{'lookup'}->add( $rec ) if ($rec && $self->{'lookup'});                  $self->{'lookup'}->add( $rec ) if ($rec && $self->{'lookup'});
286    
287                    # update counters for statistics
288                    if ($self->{stats}) {
289                            map {
290                                    my $fld = $_;
291                                    $self->{_stats}->{fld}->{ $fld }++;
292                                    if (ref($rec->{ $fld }) eq 'ARRAY') {
293                                            map {
294                                                    if (ref($_) eq 'HASH') {
295                                                            map {
296                                                                    $self->{_stats}->{sf}->{ $fld }->{ $_ }++;
297                                                            } keys %{ $_ };
298                                                    } else {
299                                                            $self->{_stats}->{repeatable}->{ $fld }++;
300                                                    }
301                                            } @{ $rec->{$fld} };
302                                    }
303                            } keys %{ $rec };
304                    }
305    
306                  $self->progress_bar($pos,$to_rec) unless ($self->{no_progress_bar});                  $self->progress_bar($pos,$to_rec) unless ($self->{no_progress_bar});
307    
308          }          }
# Line 400  sub seek { Line 424  sub seek {
424          return $self->{pos} = (($pos - 1) || -1);          return $self->{pos} = (($pos - 1) || -1);
425  }  }
426    
427    =head2 stats
428    
429    Dump statistics about field and subfield usage
430    
431      print $input->stats;
432    
433    =cut
434    
435    sub stats {
436            my $self = shift;
437    
438            my $log = $self->_get_logger();
439    
440            my $s = $self->{_stats};
441            if (! $s) {
442                    $log->warn("called stats, but there is no statistics collected");
443                    return;
444            }
445    
446            my $max_fld = 0;
447    
448            my $out = join("\n",
449                    map {
450                            my $f = $_ || die "no field";
451                            my $v = $s->{fld}->{$f} || die "no s->{fld}->{$f}";
452                            $max_fld = $v if ($v > $max_fld);
453    
454                            my $o = sprintf("%4d %d ~", $f, $v);
455    
456                            if (defined($s->{sf}->{$f})) {
457                                    map {
458                                            $o .= sprintf(" %s:%d", $_, $s->{sf}->{$f}->{$_});
459                                    } sort keys %{ $s->{sf}->{$f} };
460                            }
461    
462                            if (my $v_r = $s->{repeatable}->{$f}) {
463                                    $o .= " ($v_r)" if ($v_r != $v);
464                            }
465    
466                            $o;
467                    } sort { $a <=> $b } keys %{ $s->{fld} }
468            );
469    
470            $log->debug( sub { Dumper($s) } );
471    
472            return $out;
473    }
474    
475  =head1 MEMORY USAGE  =head1 MEMORY USAGE
476    
Legend:
Removed from v.483  
changed lines
  Added in v.513
  ViewVC Help
Powered by ViewVC 1.1.26