9 use base qw/WebPAC::Common/;
15 WebPAC::Input - read different file formats into WebPAC
23 our $VERSION = '0.08';
27 This module implements input as database which have fixed and known
28 I<size> while indexing and single unique numeric identifier for database
29 position ranging from 1 to I<size>.
31 Simply, something that is indexed by unmber from 1 .. I<size>.
33 Examples of such databases are CDS/ISIS files, MARC files, lines in
36 Specific file formats are implemented using low-level interface modules,
37 located in C<WebPAC::Input::*> namespace which export C<open_db>,
38 C<fetch_rec> and optional C<init> functions.
40 Perhaps a little code snippet.
44 my $db = WebPAC::Input->new(
45 module => 'WebPAC::Input::ISIS',
50 $db->open('/path/to/database');
51 print "database size: ",$db->size,"\n";
52 while (my $rec = $db->fetch) {
53 # do something with $rec
62 Create new input database object.
64 my $db = new WebPAC::Input(
65 module => 'WebPAC::Input::MARC',
66 encoding => 'ISO-8859-2',
68 recode => 'char pairs',
72 C<module> is low-level file format module. See L<WebPAC::Input::Isis> and
73 L<WebPAC::Input::MARC>.
75 Optional parametar C<encoding> specify application code page (which will be
76 used internally). This should probably be your terminal encoding, and by
77 default, it C<ISO-8859-2>.
79 Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).
81 C<recode> is optional string constisting of character or words pairs that
82 should be replaced in input stream.
84 C<no_progress_bar> disables progress bar output on C<STDOUT>
86 This function will also call low-level C<init> if it exists with same
96 my $log = $self->_get_logger;
98 $log->logconfess("code_page argument is not suppored any more. change it to encoding") if ($self->{lookup});
99 $log->logconfess("lookup argument is not suppored any more. rewrite call to lookup_ref") if ($self->{lookup});
101 $log->logconfess("specify low-level file format module") unless ($self->{module});
102 my $module = $self->{module};
105 $log->debug("require low-level module $self->{module} from $module");
108 #eval $self->{module} .'->import';
110 # check if required subclasses are implemented
111 foreach my $subclass (qw/open_db fetch_rec init/) {
112 my $n = $self->{module} . '::' . $subclass;
113 if (! defined &{ $n }) {
114 my $missing = "missing $subclass in $self->{module}";
115 $self->{$subclass} = sub { $log->logwarn($missing) };
117 $self->{$subclass} = \&{ $n };
122 $log->debug("calling init");
123 $self->{init}->($self, @_);
126 $self->{'encoding'} ||= 'ISO-8859-2';
128 # running with low_mem flag? well, use DBM::Deep then.
129 if ($self->{'low_mem'}) {
130 $log->info("running with low_mem which impacts performance (<32 Mb memory usage)");
132 my $db_file = "data.db";
135 unlink $db_file or $log->logdie("can't remove '$db_file' from last run");
136 $log->debug("removed '$db_file' from last run");
141 my $db = new DBM::Deep $db_file;
143 $log->logdie("DBM::Deep error: $!") unless ($db);
146 $log->logdie("can't open '$db_file' under low_mem: ",$db->error());
148 $log->debug("using file '$db_file' for DBM::Deep");
154 $self ? return $self : return undef;
159 This function will read whole database in memory and produce lookups.
162 path => '/path/to/database/file',
166 lookup => $lookup_obj,
170 # store lookup $k => $v
174 By default, C<code_page> is assumed to be C<852>.
176 C<offset> is optional parametar to position at some offset before reading from database.
178 C<limit> is optional parametar to read just C<limit> records from database
180 C<stats> create optional report about usage of fields and subfields
182 C<lookup_coderef> is closure to call when adding key => $value combinations to
185 Returns size of database, regardless of C<offset> and C<limit>
186 parametars, see also C<size>.
194 my $log = $self->_get_logger();
196 $log->logconfess("lookup argument is not suppored any more. rewrite call to lookup_coderef") if ($arg->{lookup});
197 $log->logconfess("lookup_coderef must be CODE, not ",ref($arg->{lookup_coderef}))
198 if ($arg->{lookup_coderef} && ref($arg->{lookup_coderef}) ne 'CODE');
200 $log->logcroak("need path") if (! $arg->{'path'});
201 my $code_page = $arg->{'code_page'} || '852';
203 # store data in object
204 $self->{'input_code_page'} = $code_page;
205 foreach my $v (qw/path offset limit/) {
206 $self->{$v} = $arg->{$v} if ($arg->{$v});
209 # create Text::Iconv object
210 $self->{iconv} = Text::Iconv->new($code_page,$self->{'encoding'}); ## FIXME remove!
214 if ($self->{recode}) {
215 my @r = split(/\s/, $self->{recode});
217 $log->logwarn("recode needs even number of elements (some number of valid pairs)");
223 $recode->{$from} = $to;
226 my $regex = join '|' => keys %{ $recode };
228 $log->debug("using recode regex: $regex");
232 $t =~ s/($regex)/$recode->{$1}/g;
240 my ($db, $size) = $self->{open_db}->( $self,
241 path => $arg->{path},
242 filter => $filter_ref,
246 unless (defined($db)) {
247 $log->logwarn("can't open database $arg->{path}, skipping...");
252 $log->logwarn("no records in database $arg->{path}, skipping...");
259 if (my $s = $self->{offset}) {
260 $log->debug("skipping to MFN $s");
263 $self->{offset} = $from_rec;
266 if ($self->{limit}) {
267 $log->debug("limiting to ",$self->{limit}," records");
268 $to_rec = $from_rec + $self->{limit} - 1;
269 $to_rec = $size if ($to_rec > $size);
272 # store size for later
273 $self->{size} = ($to_rec - $from_rec) ? ($to_rec - $from_rec + 1) : 0;
275 $log->info("processing $self->{size}/$size records [$from_rec-$to_rec] convert $code_page -> $self->{encoding}", $self->{stats} ? ' [stats]' : '');
278 for (my $pos = $from_rec; $pos <= $to_rec; $pos++) {
280 $log->debug("position: $pos\n");
282 my $rec = $self->{fetch_rec}->($self, $db, $pos );
284 $log->debug(sub { Dumper($rec) });
287 $log->warn("record $pos empty? skipping...");
292 if ($self->{low_mem}) {
293 $self->{db}->put($pos, $rec);
295 $self->{data}->{$pos} = $rec;
299 $arg->{'lookup_coderef'}->( $rec ) if ($rec && $arg->{'lookup_coderef'});
301 # update counters for statistics
302 if ($self->{stats}) {
304 foreach my $fld (keys %{ $rec }) {
305 $self->{_stats}->{fld}->{ $fld }++;
307 $log->logdie("invalid record fild $fld, not ARRAY")
308 unless (ref($rec->{ $fld }) eq 'ARRAY');
310 foreach my $row (@{ $rec->{$fld} }) {
312 if (ref($row) eq 'HASH') {
314 foreach my $sf (keys %{ $row }) {
315 $self->{_stats}->{sf}->{ $fld }->{ $sf }->{count}++;
316 $self->{_stats}->{sf}->{ $fld }->{ $sf }->{repeatable}++
317 if (ref($row->{$sf}) eq 'ARRAY');
321 $self->{_stats}->{repeatable}->{ $fld }++;
327 $self->progress_bar($pos,$to_rec) unless ($self->{no_progress_bar});
332 $self->{last_pcnt} = 0;
334 # store max mfn and return it.
335 $self->{max_pos} = $to_rec;
336 $log->debug("max_pos: $to_rec");
343 Fetch next record from database. It will also displays progress bar.
345 my $rec = $isis->fetch;
347 Record from this function should probably go to C<data_structure> for
355 my $log = $self->_get_logger();
357 $log->logconfess("it seems that you didn't load database!") unless ($self->{pos});
359 if ($self->{pos} == -1) {
360 $self->{pos} = $self->{offset};
365 my $mfn = $self->{pos};
367 if ($mfn > $self->{max_pos}) {
368 $self->{pos} = $self->{max_pos};
369 $log->debug("at EOF");
373 $self->progress_bar($mfn,$self->{max_pos}) unless ($self->{no_progress_bar});
377 if ($self->{low_mem}) {
378 $rec = $self->{db}->get($mfn);
380 $rec = $self->{data}->{$mfn};
388 Returns current record number (MFN).
392 First record in database has position 1.
404 Returns number of records in database
408 Result from this function can be used to loop through all records
410 foreach my $mfn ( 1 ... $isis->size ) { ... }
412 because it takes into account C<offset> and C<limit>.
418 return $self->{size};
423 Seek to specified MFN in file.
427 First record in database has position 1.
433 my $pos = shift || return;
435 my $log = $self->_get_logger();
438 $log->warn("seek before first record");
440 } elsif ($pos > $self->{max_pos}) {
441 $log->warn("seek beyond last record");
442 $pos = $self->{max_pos};
445 return $self->{pos} = (($pos - 1) || -1);
450 Dump statistics about field and subfield usage
459 my $log = $self->_get_logger();
461 my $s = $self->{_stats};
463 $log->warn("called stats, but there is no statistics collected");
471 my $f = $_ || die "no field";
472 my $v = $s->{fld}->{$f} || die "no s->{fld}->{$f}";
473 $max_fld = $v if ($v > $max_fld);
475 my $o = sprintf("%4s %d ~", $f, $v);
477 if (defined($s->{sf}->{$f})) {
479 $o .= sprintf(" %s:%d%s", $_,
480 $s->{sf}->{$f}->{$_}->{count},
481 $s->{sf}->{$f}->{$_}->{repeatable} ? '*' : '',
483 } sort keys %{ $s->{sf}->{$f} };
486 if (my $v_r = $s->{repeatable}->{$f}) {
487 $o .= " ($v_r)" if ($v_r != $v);
491 } sort { $a cmp $b } keys %{ $s->{fld} }
494 $log->debug( sub { Dumper($s) } );
501 C<low_mem> options is double-edged sword. If enabled, WebPAC
502 will run on memory constraint machines (which doesn't have enough
503 physical RAM to create memory structure for whole source database).
505 If your machine has 512Mb or more of RAM and database is around 10000 records,
506 memory shouldn't be an issue. If you don't have enough physical RAM, you
507 might consider using virtual memory (if your operating system is handling it
508 well, like on FreeBSD or Linux) instead of dropping to L<DBM::Deep> to handle
509 parsed structure of ISIS database (this is what C<low_mem> option does).
511 Hitting swap at end of reading source database is probably o.k. However,
512 hitting swap before 90% will dramatically decrease performance and you will
513 be better off with C<low_mem> and using rest of availble memory for
514 operating system disk cache (Linux is particuallary good about this).
515 However, every access to database record will require disk access, so
516 generation phase will be slower 10-100 times.
518 Parsed structures are essential - you just have option to trade RAM memory
519 (which is fast) for disk space (which is slow). Be sure to have planty of
520 disk space if you are using C<low_mem> and thus L<DBM::Deep>.
522 However, when WebPAC is running on desktop machines (or laptops :-), it's
523 highly undesireable for system to start swapping. Using C<low_mem> option can
524 reduce WecPAC memory usage to around 64Mb for same database with lookup
525 fields and sorted indexes which stay in RAM. Performance will suffer, but
526 memory usage will really be minimal. It might be also more confortable to
527 run WebPAC reniced on those machines.
532 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
534 =head1 COPYRIGHT & LICENSE
536 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
538 This program is free software; you can redistribute it and/or modify it
539 under the same terms as Perl itself.
543 1; # End of WebPAC::Input