/[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 308 by dpavlin, Tue Dec 20 19:01:22 2005 UTC revision 506 by dpavlin, Mon May 15 09:59:05 2006 UTC
# Line 14  WebPAC::Input - read different file form Line 14  WebPAC::Input - read different file form
14    
15  =head1 VERSION  =head1 VERSION
16    
17  Version 0.03  Version 0.05
18    
19  =cut  =cut
20    
21  our $VERSION = '0.03';  our $VERSION = '0.05';
22    
23  =head1 SYNOPSIS  =head1 SYNOPSIS
24    
# Line 47  Perhaps a little code snippet. Line 47  Perhaps a little code snippet.
47      );      );
48    
49      $db->open('/path/to/database');      $db->open('/path/to/database');
50      print "database size: ",$db->size,"\n";          print "database size: ",$db->size,"\n";
51      while (my $rec = $db->fetch) {          while (my $rec = $db->fetch) {
52      }                  # do something with $rec
53            }
54    
55    
56    
# Line 63  Create new input database object. Line 64  Create new input database object.
64          module => 'WebPAC::Input::MARC',          module => 'WebPAC::Input::MARC',
65          code_page => 'ISO-8859-2',          code_page => 'ISO-8859-2',
66          low_mem => 1,          low_mem => 1,
67            recode => 'char pairs',
68            no_progress_bar => 1,
69    );    );
70    
71  C<module> is low-level file format module. See L<WebPAC::Input::Isis> and  C<module> is low-level file format module. See L<WebPAC::Input::Isis> and
# Line 74  default, it C<ISO-8859-2>. Line 77  default, it C<ISO-8859-2>.
77    
78  Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).  Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).
79    
80    C<recode> is optional string constisting of character or words pairs that
81    should be replaced in input stream.
82    
83    C<no_progress_bar> disables progress bar output on C<STDOUT>
84    
85  This function will also call low-level C<init> if it exists with same  This function will also call low-level C<init> if it exists with same
86  parametars.  parametars.
87    
# Line 152  This function will read whole database i Line 160  This function will read whole database i
160          limit => 500,          limit => 500,
161          offset => 6000,          offset => 6000,
162          lookup => $lookup_obj,          lookup => $lookup_obj,
163            stats => 1,
164   );   );
165    
166  By default, C<code_page> is assumed to be C<852>.  By default, C<code_page> is assumed to be C<852>.
# Line 160  C<offset> is optional parametar to posit Line 169  C<offset> is optional parametar to posit
169    
170  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
171    
172    C<stats> create optional report about usage of fields and subfields
173    
174  Returns size of database, regardless of C<offset> and C<limit>  Returns size of database, regardless of C<offset> and C<limit>
175  parametars, see also C<size>.  parametars, see also C<size>.
176    
# Line 183  sub open { Line 194  sub open {
194          # create Text::Iconv object          # create Text::Iconv object
195          $self->{iconv} = Text::Iconv->new($code_page,$self->{'code_page'});          $self->{iconv} = Text::Iconv->new($code_page,$self->{'code_page'});
196    
197            my $filter_ref;
198    
199            if ($self->{recode}) {
200                    my @r = split(/\s/, $self->{recode});
201                    if ($#r % 2 != 1) {
202                            $log->logwarn("recode needs even number of elements (some number of valid pairs)");
203                    } else {
204                            my $recode;
205                            while (@r) {
206                                    my $from = shift @r;
207                                    my $to = shift @r;
208                                    $recode->{$from} = $to;
209                            }
210    
211                            my $regex = join '|' => keys %{ $recode };
212    
213                            $log->debug("using recode regex: $regex");
214                            
215                            $filter_ref = sub {
216                                    my $t = shift;
217                                    $t =~ s/($regex)/$recode->{$1}/g;
218                                    return $t;
219                            };
220    
221                    }
222    
223            }
224    
225          my ($db, $size) = $self->{open_db}->( $self,          my ($db, $size) = $self->{open_db}->( $self,
226                  path => $arg->{path},                  path => $arg->{path},
227                    filter => $filter_ref,
228          );          );
229    
230          unless ($db) {          unless (defined($db)) {
231                  $log->logwarn("can't open database $arg->{path}, skipping...");                  $log->logwarn("can't open database $arg->{path}, skipping...");
232                  return;                  return;
233          }          }
# Line 197  sub open { Line 237  sub open {
237                  return;                  return;
238          }          }
239    
240          my $offset = 1;          my $from_rec = 1;
241          my $limit = $size;          my $to_rec = $size;
242    
243          if (my $s = $self->{offset}) {          if (my $s = $self->{offset}) {
244                  $log->info("skipping to MFN $s");                  $log->info("skipping to MFN $s");
245                  $offset = $s;                  $from_rec = $s;
246          } else {          } else {
247                  $self->{offset} = $offset;                  $self->{offset} = $from_rec;
248          }          }
249    
250          if ($self->{limit}) {          if ($self->{limit}) {
251                  $log->debug("limiting to ",$self->{limit}," records");                  $log->debug("limiting to ",$self->{limit}," records");
252                  $limit = $offset + $self->{limit} - 1;                  $to_rec = $from_rec + $self->{limit} - 1;
253                  $limit = $size if ($limit > $size);                  $to_rec = $size if ($to_rec > $size);
254          }          }
255    
256          # store size for later          # store size for later
257          $self->{size} = ($limit - $offset) ? ($limit - $offset + 1) : 0;          $self->{size} = ($to_rec - $from_rec) ? ($to_rec - $from_rec + 1) : 0;
258    
259          $log->info("processing $self->{size} records in $code_page, convert to $self->{code_page}");          $log->info("processing $self->{size}/$size records [$from_rec-$to_rec] convert $code_page -> $self->{code_page}", $self->{stats} ? ' [stats]' : '');
260    
261          # read database          # read database
262          for (my $pos = $offset; $pos <= $limit; $pos++) {          for (my $pos = $from_rec; $pos <= $to_rec; $pos++) {
263    
264                  $log->debug("position: $pos\n");                  $log->debug("position: $pos\n");
265    
# Line 242  sub open { Line 282  sub open {
282                  # create lookup                  # create lookup
283                  $self->{'lookup'}->add( $rec ) if ($rec && $self->{'lookup'});                  $self->{'lookup'}->add( $rec ) if ($rec && $self->{'lookup'});
284    
285                  $self->progress_bar($pos,$limit);                  # update counters for statistics
286                    if ($self->{stats}) {
287                            map {
288                                    my $fld = $_;
289                                    $self->{_stats}->{fld}->{ $fld }++;
290                                    if (ref($rec->{ $fld }) eq 'ARRAY') {
291                                            map {
292                                                    if (ref($_) eq 'HASH') {
293                                                            map {
294                                                                    $self->{_stats}->{sf}->{ $fld }->{ $_ }++;
295                                                            } keys %{ $_ };
296                                                    } else {
297                                                            $self->{_stats}->{repeatable}->{ $fld }++;
298                                                    }
299                                            } @{ $rec->{$fld} };
300                                    }
301                            } keys %{ $rec };
302                    }
303    
304                    $self->progress_bar($pos,$to_rec) unless ($self->{no_progress_bar});
305    
306          }          }
307    
# Line 250  sub open { Line 309  sub open {
309          $self->{last_pcnt} = 0;          $self->{last_pcnt} = 0;
310    
311          # store max mfn and return it.          # store max mfn and return it.
312          $self->{max_pos} = $limit;          $self->{max_pos} = $to_rec;
313          $log->debug("max_pos: $limit");          $log->debug("max_pos: $to_rec");
314    
315          return $size;          return $size;
316  }  }
# Line 288  sub fetch { Line 347  sub fetch {
347                  return;                  return;
348          }          }
349    
350          $self->progress_bar($mfn,$self->{max_pos});          $self->progress_bar($mfn,$self->{max_pos}) unless ($self->{no_progress_bar});
351    
352          my $rec;          my $rec;
353    
# Line 363  sub seek { Line 422  sub seek {
422          return $self->{pos} = (($pos - 1) || -1);          return $self->{pos} = (($pos - 1) || -1);
423  }  }
424    
425    =head2 stats
426    
427    Dump statistics about field and subfield usage
428    
429      print Dumper( $input->stats );
430    
431    =cut
432    
433    sub stats {
434            my $self = shift;
435            return $self->{_stats};
436    }
437    
438  =head1 MEMORY USAGE  =head1 MEMORY USAGE
439    
Legend:
Removed from v.308  
changed lines
  Added in v.506
  ViewVC Help
Powered by ViewVC 1.1.26