lib/WebPAC/Input.pm

package WebPAC::Input;

use warnings;
use strict;

use blib;

use WebPAC::Common;
use base qw/WebPAC::Common/;
use Text::Iconv;

=head1 NAME

WebPAC::Input - read different file formats into WebPAC

=head1 VERSION

Version 0.03

=cut

our $VERSION = '0.03';

=head1 SYNOPSIS

This module implements input as database which have fixed and known
I<size> while indexing and single unique numeric identifier for database
position ranging from 1 to I<size>.

Simply, something that is indexed by unmber from 1 .. I<size>.

Examples of such databases are CDS/ISIS files, MARC files, lines in
text file, and so on.

Specific file formats are implemented using low-level interface modules,
located in C<WebPAC::Input::*> namespace which export C<open_db>,
C<fetch_rec> and optional C<init> functions.

Perhaps a little code snippet.

    use WebPAC::Input;

    my $db = WebPAC::Input->new(
        module => 'WebPAC::Input::ISIS',
                config => $config,
                lookup => $lookup_obj,
                low_mem => 1,
    );

    $db->open('/path/to/database');
    print "database size: ",$db->size,"\n";
    while (my $rec = $db->fetch) {
    }


=head1 FUNCTIONS

=head2 new

Create new input database object.

  my $db = new WebPAC::Input(
        module => 'WebPAC::Input::MARC',
        code_page => 'ISO-8859-2',
        low_mem => 1,
  );

C<module> is low-level file format module. See L<WebPAC::Input::Isis> and
L<WebPAC::Input::MARC>.

Optional parametar C<code_page> specify application code page (which will be
used internally). This should probably be your terminal encoding, and by
default, it C<ISO-8859-2>.

Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).

This function will also call low-level C<init> if it exists with same
parametars.

=cut

sub new {
        my $class = shift;
        my $self = {@_};
        bless($self, $class);

        my $log = $self->_get_logger;

        $log->logconfess("specify low-level file format module") unless ($self->{module});
        my $module = $self->{module};
        $module =~ s#::#/#g;
        $module .= '.pm';
        $log->debug("require low-level module $self->{module} from $module");

        require $module;
        #eval $self->{module} .'->import';

        # check if required subclasses are implemented
        foreach my $subclass (qw/open_db fetch_rec init/) {
                my $n = $self->{module} . '::' . $subclass;
                if (! defined &{ $n }) {
                        my $missing = "missing $subclass in $self->{module}";
                        $self->{$subclass} = sub { $log->logwarn($missing) };
                } else {
                        $self->{$subclass} = \&{ $n };
                }
        }

        if ($self->{init}) {
                $log->debug("calling init");
                $self->{init}->($self, @_);
        }

        $self->{'code_page'} ||= 'ISO-8859-2';

        # running with low_mem flag? well, use DBM::Deep then.
        if ($self->{'low_mem'}) {
                $log->info("running with low_mem which impacts performance (<32 Mb memory usage)");

                my $db_file = "data.db";

                if (-e $db_file) {
                        unlink $db_file or $log->logdie("can't remove '$db_file' from last run");
                        $log->debug("removed '$db_file' from last run");
                }

                require DBM::Deep;

                my $db = new DBM::Deep $db_file;

                $log->logdie("DBM::Deep error: $!") unless ($db);

                if ($db->error()) {
                        $log->logdie("can't open '$db_file' under low_mem: ",$db->error());
                } else {
                        $log->debug("using file '$db_file' for DBM::Deep");
                }

                $self->{'db'} = $db;
        }

        $self ? return $self : return undef;
}

=head2 open

This function will read whole database in memory and produce lookups.

 $input->open(
        path => '/path/to/database/file',
        code_page => '852',
        limit => 500,
        offset => 6000,
        lookup => $lookup_obj,
 );

By default, C<code_page> is assumed to be C<852>.

C<offset> is optional parametar to position at some offset before reading from database.

C<limit> is optional parametar to read just C<limit> records from database

Returns size of database, regardless of C<offset> and C<limit>
parametars, see also C<size>.

=cut

sub open {
        my $self = shift;
        my $arg = {@_};

        my $log = $self->_get_logger();

        $log->logcroak("need path") if (! $arg->{'path'});
        my $code_page = $arg->{'code_page'} || '852';

        # store data in object
        $self->{'input_code_page'} = $code_page;
        foreach my $v (qw/path offset limit/) {
                $self->{$v} = $arg->{$v} if ($arg->{$v});
        }

        # create Text::Iconv object
        $self->{iconv} = Text::Iconv->new($code_page,$self->{'code_page'});

        my ($db, $size) = $self->{open_db}->( $self, 
                path => $arg->{path},
        );

        unless ($db) {
                $log->logwarn("can't open database $arg->{path}, skipping...");
                return;
        }

        unless ($size) {
                $log->logwarn("no records in database $arg->{path}, skipping...");
                return;
        }

        my $offset = 1;
        my $limit = $size;

        if (my $s = $self->{offset}) {
                $log->info("skipping to MFN $s");
                $offset = $s;
        } else {
                $self->{offset} = $offset;
        }

        if ($self->{limit}) {
                $log->debug("limiting to ",$self->{limit}," records");
                $limit = $offset + $self->{limit} - 1;
                $limit = $size if ($limit > $size);
        }

        # store size for later
        $self->{size} = ($limit - $offset) ? ($limit - $offset + 1) : 0;

        $log->info("processing $self->{size} records in $code_page, convert to $self->{code_page}");

        # read database
        for (my $pos = $offset; $pos <= $limit; $pos++) {

                $log->debug("position: $pos\n");

                my $rec = $self->{fetch_rec}->($self, $db, $pos );

                if (! $rec) {
                        $log->warn("record $pos empty? skipping...");
                        next;
                }

                # store
                if ($self->{low_mem}) {
                        $self->{db}->put($pos, $rec);
                } else {
                        $self->{data}->{$pos} = $rec;
                }

                # create lookup
                $self->{'lookup'}->add( $rec ) if ($rec && $self->{'lookup'});

                $self->progress_bar($pos,$limit);

        }

        $self->{pos} = -1;
        $self->{last_pcnt} = 0;

        # store max mfn and return it.
        $self->{max_pos} = $limit;
        $log->debug("max_pos: $limit");

        return $size;
}

=head2 fetch

Fetch next record from database. It will also displays progress bar.

 my $rec = $isis->fetch;

Record from this function should probably go to C<data_structure> for
normalisation.

=cut

sub fetch {
        my $self = shift;

        my $log = $self->_get_logger();

        $log->logconfess("it seems that you didn't load database!") unless ($self->{pos});

        if ($self->{pos} == -1) {
                $self->{pos} = $self->{offset};
        } else {
                $self->{pos}++;
        }

        my $mfn = $self->{pos};

        if ($mfn > $self->{max_pos}) {
                $self->{pos} = $self->{max_pos};
                $log->debug("at EOF");
                return;
        }

        $self->progress_bar($mfn,$self->{max_pos});

        my $rec;

        if ($self->{low_mem}) {
                $rec = $self->{db}->get($mfn);
        } else {
                $rec = $self->{data}->{$mfn};
        }

        $rec ||= 0E0;
}

=head2 pos

Returns current record number (MFN).

 print $isis->pos;

First record in database has position 1.

=cut

sub pos {
        my $self = shift;
        return $self->{pos};
}


=head2 size

Returns number of records in database

 print $isis->size;

Result from this function can be used to loop through all records

 foreach my $mfn ( 1 ... $isis->size ) { ... }

because it takes into account C<offset> and C<limit>.

=cut

sub size {
        my $self = shift;
        return $self->{size};
}

=head2 seek

Seek to specified MFN in file.

 $isis->seek(42);

First record in database has position 1.

=cut

sub seek {
        my $self = shift;
        my $pos = shift || return;

        my $log = $self->_get_logger();

        if ($pos < 1) {
                $log->warn("seek before first record");
                $pos = 1;
        } elsif ($pos > $self->{max_pos}) {
                $log->warn("seek beyond last record");
                $pos = $self->{max_pos};
        }

        return $self->{pos} = (($pos - 1) || -1);
}


=head1 MEMORY USAGE

C<low_mem> options is double-edged sword. If enabled, WebPAC
will run on memory constraint machines (which doesn't have enough
physical RAM to create memory structure for whole source database).

If your machine has 512Mb or more of RAM and database is around 10000 records,
memory shouldn't be an issue. If you don't have enough physical RAM, you
might consider using virtual memory (if your operating system is handling it
well, like on FreeBSD or Linux) instead of dropping to L<DBM::Deep> to handle
parsed structure of ISIS database (this is what C<low_mem> option does).

Hitting swap at end of reading source database is probably o.k. However,
hitting swap before 90% will dramatically decrease performance and you will
be better off with C<low_mem> and using rest of availble memory for
operating system disk cache (Linux is particuallary good about this).
However, every access to database record will require disk access, so
generation phase will be slower 10-100 times.

Parsed structures are essential - you just have option to trade RAM memory
(which is fast) for disk space (which is slow). Be sure to have planty of
disk space if you are using C<low_mem> and thus L<DBM::Deep>.

However, when WebPAC is running on desktop machines (or laptops :-), it's
highly undesireable for system to start swapping. Using C<low_mem> option can
reduce WecPAC memory usage to around 64Mb for same database with lookup
fields and sorted indexes which stay in RAM. Performance will suffer, but
memory usage will really be minimal. It might be also more confortable to
run WebPAC reniced on those machines.


=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of WebPAC::Input
1	package WebPAC::Input;
2
3	use warnings;
4	use strict;
5
6	use blib;
7
8	use WebPAC::Common;
9	use base qw/WebPAC::Common/;
10	use Text::Iconv;
11
12	=head1 NAME
13
14	WebPAC::Input - read different file formats into WebPAC
15
16	=head1 VERSION
17
18	Version 0.03
19
20	=cut
21
22	our $VERSION = '0.03';
23
24	=head1 SYNOPSIS
25
26	This module implements input as database which have fixed and known
27	I<size> while indexing and single unique numeric identifier for database
28	position ranging from 1 to I<size>.
29
30	Simply, something that is indexed by unmber from 1 .. I<size>.
31
32	Examples of such databases are CDS/ISIS files, MARC files, lines in
33	text file, and so on.
34
35	Specific file formats are implemented using low-level interface modules,
36	located in C<WebPAC::Input::*> namespace which export C<open_db>,
37	C<fetch_rec> and optional C<init> functions.
38
39	Perhaps a little code snippet.
40
41	use WebPAC::Input;
42
43	my $db = WebPAC::Input->new(
44	module => 'WebPAC::Input::ISIS',
45	config => $config,
46	lookup => $lookup_obj,
47	low_mem => 1,
48	);
49
50	$db->open('/path/to/database');
51	print "database size: ",$db->size,"\n";
52	while (my $rec = $db->fetch) {
53	}
54
55
56
57	=head1 FUNCTIONS
58
59	=head2 new
60
61	Create new input database object.
62
63	my $db = new WebPAC::Input(
64	module => 'WebPAC::Input::MARC',
65	code_page => 'ISO-8859-2',
66	low_mem => 1,
67	);
68
69	C<module> is low-level file format module. See L<WebPAC::Input::Isis> and
70	L<WebPAC::Input::MARC>.
71
72	Optional parametar C<code_page> specify application code page (which will be
73	used internally). This should probably be your terminal encoding, and by
74	default, it C<ISO-8859-2>.
75
76	Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).
77
78	This function will also call low-level C<init> if it exists with same
79	parametars.
80
81	=cut
82
83	sub new {
84	my $class = shift;
85	my $self = {@_};
86	bless($self, $class);
87
88	my $log = $self->_get_logger;
89
90	$log->logconfess("specify low-level file format module") unless ($self->{module});
91	my $module = $self->{module};
92	$module =~ s#::#/#g;
93	$module .= '.pm';
94	$log->debug("require low-level module $self->{module} from $module");
95
96	require $module;
97	#eval $self->{module} .'->import';
98
99	# check if required subclasses are implemented
100	foreach my $subclass (qw/open_db fetch_rec init/) {
101	my $n = $self->{module} . '::' . $subclass;
102	if (! defined &{ $n }) {
103	my $missing = "missing $subclass in $self->{module}";
104	$self->{$subclass} = sub { $log->logwarn($missing) };
105	} else {
106	$self->{$subclass} = \&{ $n };
107	}
108	}
109
110	if ($self->{init}) {
111	$log->debug("calling init");
112	$self->{init}->($self, @_);
113	}
114
115	$self->{'code_page'} \|\|= 'ISO-8859-2';
116
117	# running with low_mem flag? well, use DBM::Deep then.
118	if ($self->{'low_mem'}) {
119	$log->info("running with low_mem which impacts performance (<32 Mb memory usage)");
120
121	my $db_file = "data.db";
122
123	if (-e $db_file) {
124	unlink $db_file or $log->logdie("can't remove '$db_file' from last run");
125	$log->debug("removed '$db_file' from last run");
126	}
127
128	require DBM::Deep;
129
130	my $db = new DBM::Deep $db_file;
131
132	$log->logdie("DBM::Deep error: $!") unless ($db);
133
134	if ($db->error()) {
135	$log->logdie("can't open '$db_file' under low_mem: ",$db->error());
136	} else {
137	$log->debug("using file '$db_file' for DBM::Deep");
138	}
139
140	$self->{'db'} = $db;
141	}
142
143	$self ? return $self : return undef;
144	}
145
146	=head2 open
147
148	This function will read whole database in memory and produce lookups.
149
150	$input->open(
151	path => '/path/to/database/file',
152	code_page => '852',
153	limit => 500,
154	offset => 6000,
155	lookup => $lookup_obj,
156	);
157
158	By default, C<code_page> is assumed to be C<852>.
159
160	C<offset> is optional parametar to position at some offset before reading from database.
161
162	C<limit> is optional parametar to read just C<limit> records from database
163
164	Returns size of database, regardless of C<offset> and C<limit>
165	parametars, see also C<size>.
166
167	=cut
168
169	sub open {
170	my $self = shift;
171	my $arg = {@_};
172
173	my $log = $self->_get_logger();
174
175	$log->logcroak("need path") if (! $arg->{'path'});
176	my $code_page = $arg->{'code_page'} \|\| '852';
177
178	# store data in object
179	$self->{'input_code_page'} = $code_page;
180	foreach my $v (qw/path offset limit/) {
181	$self->{$v} = $arg->{$v} if ($arg->{$v});
182	}
183
184	# create Text::Iconv object
185	$self->{iconv} = Text::Iconv->new($code_page,$self->{'code_page'});
186
187	my ($db, $size) = $self->{open_db}->( $self,
188	path => $arg->{path},
189	);
190
191	unless ($db) {
192	$log->logwarn("can't open database $arg->{path}, skipping...");
193	return;
194	}
195
196	unless ($size) {
197	$log->logwarn("no records in database $arg->{path}, skipping...");
198	return;
199	}
200
201	my $offset = 1;
202	my $limit = $size;
203
204	if (my $s = $self->{offset}) {
205	$log->info("skipping to MFN $s");
206	$offset = $s;
207	} else {
208	$self->{offset} = $offset;
209	}
210
211	if ($self->{limit}) {
212	$log->debug("limiting to ",$self->{limit}," records");
213	$limit = $offset + $self->{limit} - 1;
214	$limit = $size if ($limit > $size);
215	}
216
217	# store size for later
218	$self->{size} = ($limit - $offset) ? ($limit - $offset + 1) : 0;
219
220	$log->info("processing $self->{size} records in $code_page, convert to $self->{code_page}");
221
222	# read database
223	for (my $pos = $offset; $pos <= $limit; $pos++) {
224
225	$log->debug("position: $pos\n");
226
227	my $rec = $self->{fetch_rec}->($self, $db, $pos );
228
229	if (! $rec) {
230	$log->warn("record $pos empty? skipping...");
231	next;
232	}
233
234	# store
235	if ($self->{low_mem}) {
236	$self->{db}->put($pos, $rec);
237	} else {
238	$self->{data}->{$pos} = $rec;
239	}
240
241	# create lookup
242	$self->{'lookup'}->add( $rec ) if ($rec && $self->{'lookup'});
243
244	$self->progress_bar($pos,$limit);
245
246	}
247
248	$self->{pos} = -1;
249	$self->{last_pcnt} = 0;
250
251	# store max mfn and return it.
252	$self->{max_pos} = $limit;
253	$log->debug("max_pos: $limit");
254
255	return $size;
256	}
257
258	=head2 fetch
259
260	Fetch next record from database. It will also displays progress bar.
261
262	my $rec = $isis->fetch;
263
264	Record from this function should probably go to C<data_structure> for
265	normalisation.
266
267	=cut
268
269	sub fetch {
270	my $self = shift;
271
272	my $log = $self->_get_logger();
273
274	$log->logconfess("it seems that you didn't load database!") unless ($self->{pos});
275
276	if ($self->{pos} == -1) {
277	$self->{pos} = $self->{offset};
278	} else {
279	$self->{pos}++;
280	}
281
282	my $mfn = $self->{pos};
283
284	if ($mfn > $self->{max_pos}) {
285	$self->{pos} = $self->{max_pos};
286	$log->debug("at EOF");
287	return;
288	}
289
290	$self->progress_bar($mfn,$self->{max_pos});
291
292	my $rec;
293
294	if ($self->{low_mem}) {
295	$rec = $self->{db}->get($mfn);
296	} else {
297	$rec = $self->{data}->{$mfn};
298	}
299
300	$rec \|\|= 0E0;
301	}
302
303	=head2 pos
304
305	Returns current record number (MFN).
306
307	print $isis->pos;
308
309	First record in database has position 1.
310
311	=cut
312
313	sub pos {
314	my $self = shift;
315	return $self->{pos};
316	}
317
318
319	=head2 size
320
321	Returns number of records in database
322
323	print $isis->size;
324
325	Result from this function can be used to loop through all records
326
327	foreach my $mfn ( 1 ... $isis->size ) { ... }
328
329	because it takes into account C<offset> and C<limit>.
330
331	=cut
332
333	sub size {
334	my $self = shift;
335	return $self->{size};
336	}
337
338	=head2 seek
339
340	Seek to specified MFN in file.
341
342	$isis->seek(42);
343
344	First record in database has position 1.
345
346	=cut
347
348	sub seek {
349	my $self = shift;
350	my $pos = shift \|\| return;
351
352	my $log = $self->_get_logger();
353
354	if ($pos < 1) {
355	$log->warn("seek before first record");
356	$pos = 1;
357	} elsif ($pos > $self->{max_pos}) {
358	$log->warn("seek beyond last record");
359	$pos = $self->{max_pos};
360	}
361
362	return $self->{pos} = (($pos - 1) \|\| -1);
363	}
364
365
366	=head1 MEMORY USAGE
367
368	C<low_mem> options is double-edged sword. If enabled, WebPAC
369	will run on memory constraint machines (which doesn't have enough
370	physical RAM to create memory structure for whole source database).
371
372	If your machine has 512Mb or more of RAM and database is around 10000 records,
373	memory shouldn't be an issue. If you don't have enough physical RAM, you
374	might consider using virtual memory (if your operating system is handling it
375	well, like on FreeBSD or Linux) instead of dropping to L<DBM::Deep> to handle
376	parsed structure of ISIS database (this is what C<low_mem> option does).
377
378	Hitting swap at end of reading source database is probably o.k. However,
379	hitting swap before 90% will dramatically decrease performance and you will
380	be better off with C<low_mem> and using rest of availble memory for
381	operating system disk cache (Linux is particuallary good about this).
382	However, every access to database record will require disk access, so
383	generation phase will be slower 10-100 times.
384
385	Parsed structures are essential - you just have option to trade RAM memory
386	(which is fast) for disk space (which is slow). Be sure to have planty of
387	disk space if you are using C<low_mem> and thus L<DBM::Deep>.
388
389	However, when WebPAC is running on desktop machines (or laptops :-), it's
390	highly undesireable for system to start swapping. Using C<low_mem> option can
391	reduce WecPAC memory usage to around 64Mb for same database with lookup
392	fields and sorted indexes which stay in RAM. Performance will suffer, but
393	memory usage will really be minimal. It might be also more confortable to
394	run WebPAC reniced on those machines.
395
396
397	=head1 AUTHOR
398
399	Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
400
401	=head1 COPYRIGHT & LICENSE
402
403	Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
404
405	This program is free software; you can redistribute it and/or modify it
406	under the same terms as Perl itself.
407
408	=cut
409
410	1; # End of WebPAC::Input