9 use base qw/WebPAC::Common/;
15 WebPAC::Input - read different file formats into WebPAC
23 our $VERSION = '0.05';
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',
47 lookup => $lookup_obj,
51 $db->open('/path/to/database');
52 print "database size: ",$db->size,"\n";
53 while (my $rec = $db->fetch) {
54 # do something with $rec
63 Create new input database object.
65 my $db = new WebPAC::Input(
66 module => 'WebPAC::Input::MARC',
67 code_page => 'ISO-8859-2',
69 recode => 'char pairs',
73 C<module> is low-level file format module. See L<WebPAC::Input::Isis> and
74 L<WebPAC::Input::MARC>.
76 Optional parametar C<code_page> specify application code page (which will be
77 used internally). This should probably be your terminal encoding, and by
78 default, it C<ISO-8859-2>.
80 Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).
82 C<recode> is optional string constisting of character or words pairs that
83 should be replaced in input stream.
85 C<no_progress_bar> disables progress bar output on C<STDOUT>
87 This function will also call low-level C<init> if it exists with same
97 my $log = $self->_get_logger;
99 $log->logconfess("specify low-level file format module") unless ($self->{module});
100 my $module = $self->{module};
103 $log->debug("require low-level module $self->{module} from $module");
106 #eval $self->{module} .'->import';
108 # check if required subclasses are implemented
109 foreach my $subclass (qw/open_db fetch_rec init/) {
110 my $n = $self->{module} . '::' . $subclass;
111 if (! defined &{ $n }) {
112 my $missing = "missing $subclass in $self->{module}";
113 $self->{$subclass} = sub { $log->logwarn($missing) };
115 $self->{$subclass} = \&{ $n };
120 $log->debug("calling init");
121 $self->{init}->($self, @_);
124 $self->{'code_page'} ||= 'ISO-8859-2';
126 # running with low_mem flag? well, use DBM::Deep then.
127 if ($self->{'low_mem'}) {
128 $log->info("running with low_mem which impacts performance (<32 Mb memory usage)");
130 my $db_file = "data.db";
133 unlink $db_file or $log->logdie("can't remove '$db_file' from last run");
134 $log->debug("removed '$db_file' from last run");
139 my $db = new DBM::Deep $db_file;
141 $log->logdie("DBM::Deep error: $!") unless ($db);
144 $log->logdie("can't open '$db_file' under low_mem: ",$db->error());
146 $log->debug("using file '$db_file' for DBM::Deep");
152 $self ? return $self : return undef;
157 This function will read whole database in memory and produce lookups.
160 path => '/path/to/database/file',
164 lookup => $lookup_obj,
168 By default, C<code_page> is assumed to be C<852>.
170 C<offset> is optional parametar to position at some offset before reading from database.
172 C<limit> is optional parametar to read just C<limit> records from database
174 C<stats> create optional report about usage of fields and subfields
176 Returns size of database, regardless of C<offset> and C<limit>
177 parametars, see also C<size>.
185 my $log = $self->_get_logger();
187 $log->logcroak("need path") if (! $arg->{'path'});
188 my $code_page = $arg->{'code_page'} || '852';
190 # store data in object
191 $self->{'input_code_page'} = $code_page;
192 foreach my $v (qw/path offset limit/) {
193 $self->{$v} = $arg->{$v} if ($arg->{$v});
196 # create Text::Iconv object
197 $self->{iconv} = Text::Iconv->new($code_page,$self->{'code_page'});
201 if ($self->{recode}) {
202 my @r = split(/\s/, $self->{recode});
204 $log->logwarn("recode needs even number of elements (some number of valid pairs)");
210 $recode->{$from} = $to;
213 my $regex = join '|' => keys %{ $recode };
215 $log->debug("using recode regex: $regex");
219 $t =~ s/($regex)/$recode->{$1}/g;
227 my ($db, $size) = $self->{open_db}->( $self,
228 path => $arg->{path},
229 filter => $filter_ref,
232 unless (defined($db)) {
233 $log->logwarn("can't open database $arg->{path}, skipping...");
238 $log->logwarn("no records in database $arg->{path}, skipping...");
245 if (my $s = $self->{offset}) {
246 $log->debug("skipping to MFN $s");
249 $self->{offset} = $from_rec;
252 if ($self->{limit}) {
253 $log->debug("limiting to ",$self->{limit}," records");
254 $to_rec = $from_rec + $self->{limit} - 1;
255 $to_rec = $size if ($to_rec > $size);
258 # store size for later
259 $self->{size} = ($to_rec - $from_rec) ? ($to_rec - $from_rec + 1) : 0;
261 $log->info("processing $self->{size}/$size records [$from_rec-$to_rec] convert $code_page -> $self->{code_page}", $self->{stats} ? ' [stats]' : '');
264 for (my $pos = $from_rec; $pos <= $to_rec; $pos++) {
266 $log->debug("position: $pos\n");
268 my $rec = $self->{fetch_rec}->($self, $db, $pos );
270 $log->debug(sub { Dumper($rec) });
273 $log->warn("record $pos empty? skipping...");
278 if ($self->{low_mem}) {
279 $self->{db}->put($pos, $rec);
281 $self->{data}->{$pos} = $rec;
285 $self->{'lookup'}->add( $rec ) if ($rec && $self->{'lookup'});
287 # update counters for statistics
288 if ($self->{stats}) {
291 $self->{_stats}->{fld}->{ $fld }++;
292 if (ref($rec->{ $fld }) eq 'ARRAY') {
294 if (ref($_) eq 'HASH') {
296 $self->{_stats}->{sf}->{ $fld }->{ $_ }++;
299 $self->{_stats}->{repeatable}->{ $fld }++;
306 $self->progress_bar($pos,$to_rec) unless ($self->{no_progress_bar});
311 $self->{last_pcnt} = 0;
313 # store max mfn and return it.
314 $self->{max_pos} = $to_rec;
315 $log->debug("max_pos: $to_rec");
322 Fetch next record from database. It will also displays progress bar.
324 my $rec = $isis->fetch;
326 Record from this function should probably go to C<data_structure> for
334 my $log = $self->_get_logger();
336 $log->logconfess("it seems that you didn't load database!") unless ($self->{pos});
338 if ($self->{pos} == -1) {
339 $self->{pos} = $self->{offset};
344 my $mfn = $self->{pos};
346 if ($mfn > $self->{max_pos}) {
347 $self->{pos} = $self->{max_pos};
348 $log->debug("at EOF");
352 $self->progress_bar($mfn,$self->{max_pos}) unless ($self->{no_progress_bar});
356 if ($self->{low_mem}) {
357 $rec = $self->{db}->get($mfn);
359 $rec = $self->{data}->{$mfn};
367 Returns current record number (MFN).
371 First record in database has position 1.
383 Returns number of records in database
387 Result from this function can be used to loop through all records
389 foreach my $mfn ( 1 ... $isis->size ) { ... }
391 because it takes into account C<offset> and C<limit>.
397 return $self->{size};
402 Seek to specified MFN in file.
406 First record in database has position 1.
412 my $pos = shift || return;
414 my $log = $self->_get_logger();
417 $log->warn("seek before first record");
419 } elsif ($pos > $self->{max_pos}) {
420 $log->warn("seek beyond last record");
421 $pos = $self->{max_pos};
424 return $self->{pos} = (($pos - 1) || -1);
429 Dump statistics about field and subfield usage
438 my $log = $self->_get_logger();
440 my $s = $self->{_stats};
442 $log->warn("called stats, but there is no statistics collected");
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);
454 my $o = sprintf("%4d %d ~", $f, $v);
456 if (defined($s->{sf}->{$f})) {
458 $o .= sprintf(" %s:%d", $_, $s->{sf}->{$f}->{$_});
459 } sort keys %{ $s->{sf}->{$f} };
462 if (my $v_r = $s->{repeatable}->{$f}) {
463 $o .= " ($v_r)" if ($v_r != $v);
467 } sort { $a <=> $b } keys %{ $s->{fld} }
470 $log->debug( sub { Dumper($s) } );
477 C<low_mem> options is double-edged sword. If enabled, WebPAC
478 will run on memory constraint machines (which doesn't have enough
479 physical RAM to create memory structure for whole source database).
481 If your machine has 512Mb or more of RAM and database is around 10000 records,
482 memory shouldn't be an issue. If you don't have enough physical RAM, you
483 might consider using virtual memory (if your operating system is handling it
484 well, like on FreeBSD or Linux) instead of dropping to L<DBM::Deep> to handle
485 parsed structure of ISIS database (this is what C<low_mem> option does).
487 Hitting swap at end of reading source database is probably o.k. However,
488 hitting swap before 90% will dramatically decrease performance and you will
489 be better off with C<low_mem> and using rest of availble memory for
490 operating system disk cache (Linux is particuallary good about this).
491 However, every access to database record will require disk access, so
492 generation phase will be slower 10-100 times.
494 Parsed structures are essential - you just have option to trade RAM memory
495 (which is fast) for disk space (which is slow). Be sure to have planty of
496 disk space if you are using C<low_mem> and thus L<DBM::Deep>.
498 However, when WebPAC is running on desktop machines (or laptops :-), it's
499 highly undesireable for system to start swapping. Using C<low_mem> option can
500 reduce WecPAC memory usage to around 64Mb for same database with lookup
501 fields and sorted indexes which stay in RAM. Performance will suffer, but
502 memory usage will really be minimal. It might be also more confortable to
503 run WebPAC reniced on those machines.
508 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
510 =head1 COPYRIGHT & LICENSE
512 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
514 This program is free software; you can redistribute it and/or modify it
515 under the same terms as Perl itself.
519 1; # End of WebPAC::Input