7 use base qw/WebPAC::Common/;
13 WebPAC::Input - read different file formats into WebPAC
21 our $VERSION = '0.04';
25 This module implements input as database which have fixed and known
26 I<size> while indexing and single unique numeric identifier for database
27 position ranging from 1 to I<size>.
29 Simply, something that is indexed by unmber from 1 .. I<size>.
31 Examples of such databases are CDS/ISIS files, MARC files, lines in
34 Specific file formats are implemented using low-level interface modules,
35 located in C<WebPAC::Input::*> namespace which export C<open_db>,
36 C<fetch_rec> and optional C<init> functions.
38 Perhaps a little code snippet.
42 my $db = WebPAC::Input->new(
43 module => 'WebPAC::Input::ISIS',
45 lookup => $lookup_obj,
49 $db->open('/path/to/database');
50 print "database size: ",$db->size,"\n";
51 while (my $rec = $db->fetch) {
52 # do something with $rec
61 Create new input database object.
63 my $db = new WebPAC::Input(
64 module => 'WebPAC::Input::MARC',
65 code_page => 'ISO-8859-2',
67 recode => 'char pairs',
71 C<module> is low-level file format module. See L<WebPAC::Input::Isis> and
72 L<WebPAC::Input::MARC>.
74 Optional parametar C<code_page> specify application code page (which will be
75 used internally). This should probably be your terminal encoding, and by
76 default, it C<ISO-8859-2>.
78 Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).
80 C<recode> is optional string constisting of character or words pairs that
81 should be replaced in input stream.
83 C<no_progress_bar> disables progress bar output on C<STDOUT>
85 This function will also call low-level C<init> if it exists with same
95 my $log = $self->_get_logger;
97 $log->logconfess("specify low-level file format module") unless ($self->{module});
98 my $module = $self->{module};
101 $log->debug("require low-level module $self->{module} from $module");
104 #eval $self->{module} .'->import';
106 # check if required subclasses are implemented
107 foreach my $subclass (qw/open_db fetch_rec init/) {
108 my $n = $self->{module} . '::' . $subclass;
109 if (! defined &{ $n }) {
110 my $missing = "missing $subclass in $self->{module}";
111 $self->{$subclass} = sub { $log->logwarn($missing) };
113 $self->{$subclass} = \&{ $n };
118 $log->debug("calling init");
119 $self->{init}->($self, @_);
122 $self->{'code_page'} ||= 'ISO-8859-2';
124 # running with low_mem flag? well, use DBM::Deep then.
125 if ($self->{'low_mem'}) {
126 $log->info("running with low_mem which impacts performance (<32 Mb memory usage)");
128 my $db_file = "data.db";
131 unlink $db_file or $log->logdie("can't remove '$db_file' from last run");
132 $log->debug("removed '$db_file' from last run");
137 my $db = new DBM::Deep $db_file;
139 $log->logdie("DBM::Deep error: $!") unless ($db);
142 $log->logdie("can't open '$db_file' under low_mem: ",$db->error());
144 $log->debug("using file '$db_file' for DBM::Deep");
150 $self ? return $self : return undef;
155 This function will read whole database in memory and produce lookups.
158 path => '/path/to/database/file',
162 lookup => $lookup_obj,
165 By default, C<code_page> is assumed to be C<852>.
167 C<offset> is optional parametar to position at some offset before reading from database.
169 C<limit> is optional parametar to read just C<limit> records from database
171 Returns size of database, regardless of C<offset> and C<limit>
172 parametars, see also C<size>.
180 my $log = $self->_get_logger();
182 $log->logcroak("need path") if (! $arg->{'path'});
183 my $code_page = $arg->{'code_page'} || '852';
185 # store data in object
186 $self->{'input_code_page'} = $code_page;
187 foreach my $v (qw/path offset limit/) {
188 $self->{$v} = $arg->{$v} if ($arg->{$v});
191 # create Text::Iconv object
192 $self->{iconv} = Text::Iconv->new($code_page,$self->{'code_page'});
196 if ($self->{recode}) {
197 my @r = split(/\s/, $self->{recode});
199 $log->logwarn("recode needs even number of elements (some number of valid pairs)");
205 $recode->{$from} = $to;
208 my $regex = join '|' => keys %{ $recode };
210 $log->debug("using recode regex: $regex");
214 $t =~ s/($regex)/$recode->{$1}/g;
222 my ($db, $size) = $self->{open_db}->( $self,
223 path => $arg->{path},
224 filter => $filter_ref,
228 $log->logwarn("can't open database $arg->{path}, skipping...");
233 $log->logwarn("no records in database $arg->{path}, skipping...");
240 if (my $s = $self->{offset}) {
241 $log->info("skipping to MFN $s");
244 $self->{offset} = $from_rec;
247 if ($self->{limit}) {
248 $log->debug("limiting to ",$self->{limit}," records");
249 $to_rec = $from_rec + $self->{limit} - 1;
250 $to_rec = $size if ($to_rec > $size);
253 # store size for later
254 $self->{size} = ($to_rec - $from_rec) ? ($to_rec - $from_rec + 1) : 0;
256 $log->info("processing $self->{size}/$size records [$from_rec-$to_rec] convert $code_page -> $self->{code_page}");
259 for (my $pos = $from_rec; $pos <= $to_rec; $pos++) {
261 $log->debug("position: $pos\n");
263 my $rec = $self->{fetch_rec}->($self, $db, $pos );
265 $log->debug(sub { Dumper($rec) });
268 $log->warn("record $pos empty? skipping...");
273 if ($self->{low_mem}) {
274 $self->{db}->put($pos, $rec);
276 $self->{data}->{$pos} = $rec;
280 $self->{'lookup'}->add( $rec ) if ($rec && $self->{'lookup'});
282 $self->progress_bar($pos,$to_rec) unless ($self->{no_progress_bar});
287 $self->{last_pcnt} = 0;
289 # store max mfn and return it.
290 $self->{max_pos} = $to_rec;
291 $log->debug("max_pos: $to_rec");
298 Fetch next record from database. It will also displays progress bar.
300 my $rec = $isis->fetch;
302 Record from this function should probably go to C<data_structure> for
310 my $log = $self->_get_logger();
312 $log->logconfess("it seems that you didn't load database!") unless ($self->{pos});
314 if ($self->{pos} == -1) {
315 $self->{pos} = $self->{offset};
320 my $mfn = $self->{pos};
322 if ($mfn > $self->{max_pos}) {
323 $self->{pos} = $self->{max_pos};
324 $log->debug("at EOF");
328 $self->progress_bar($mfn,$self->{max_pos}) unless ($self->{no_progress_bar});
332 if ($self->{low_mem}) {
333 $rec = $self->{db}->get($mfn);
335 $rec = $self->{data}->{$mfn};
343 Returns current record number (MFN).
347 First record in database has position 1.
359 Returns number of records in database
363 Result from this function can be used to loop through all records
365 foreach my $mfn ( 1 ... $isis->size ) { ... }
367 because it takes into account C<offset> and C<limit>.
373 return $self->{size};
378 Seek to specified MFN in file.
382 First record in database has position 1.
388 my $pos = shift || return;
390 my $log = $self->_get_logger();
393 $log->warn("seek before first record");
395 } elsif ($pos > $self->{max_pos}) {
396 $log->warn("seek beyond last record");
397 $pos = $self->{max_pos};
400 return $self->{pos} = (($pos - 1) || -1);
406 C<low_mem> options is double-edged sword. If enabled, WebPAC
407 will run on memory constraint machines (which doesn't have enough
408 physical RAM to create memory structure for whole source database).
410 If your machine has 512Mb or more of RAM and database is around 10000 records,
411 memory shouldn't be an issue. If you don't have enough physical RAM, you
412 might consider using virtual memory (if your operating system is handling it
413 well, like on FreeBSD or Linux) instead of dropping to L<DBM::Deep> to handle
414 parsed structure of ISIS database (this is what C<low_mem> option does).
416 Hitting swap at end of reading source database is probably o.k. However,
417 hitting swap before 90% will dramatically decrease performance and you will
418 be better off with C<low_mem> and using rest of availble memory for
419 operating system disk cache (Linux is particuallary good about this).
420 However, every access to database record will require disk access, so
421 generation phase will be slower 10-100 times.
423 Parsed structures are essential - you just have option to trade RAM memory
424 (which is fast) for disk space (which is slow). Be sure to have planty of
425 disk space if you are using C<low_mem> and thus L<DBM::Deep>.
427 However, when WebPAC is running on desktop machines (or laptops :-), it's
428 highly undesireable for system to start swapping. Using C<low_mem> option can
429 reduce WecPAC memory usage to around 64Mb for same database with lookup
430 fields and sorted indexes which stay in RAM. Performance will suffer, but
431 memory usage will really be minimal. It might be also more confortable to
432 run WebPAC reniced on those machines.
437 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
439 =head1 COPYRIGHT & LICENSE
441 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
443 This program is free software; you can redistribute it and/or modify it
444 under the same terms as Perl itself.
448 1; # End of WebPAC::Input