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}";
                        $log->logwarn($missing);
                        $self->{$subclass} = sub { warn "$missing\n" };
                } 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->{'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->info("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	$log->logwarn($missing);
105	$self->{$subclass} = sub { warn "$missing\n" };
106	} else {
107	$self->{$subclass} = \&{ $n };
108	}
109	}
110
111	if ($self->{init}) {
112	$log->debug("calling init");
113	$self->{init}->($self, @_);
114	}
115
116	$self->{'code_page'} \|\|= 'ISO-8859-2';
117
118	# running with low_mem flag? well, use DBM::Deep then.
119	if ($self->{'low_mem'}) {
120	$log->info("running with low_mem which impacts performance (<32 Mb memory usage)");
121
122	my $db_file = "data.db";
123
124	if (-e $db_file) {
125	unlink $db_file or $log->logdie("can't remove '$db_file' from last run");
126	$log->debug("removed '$db_file' from last run");
127	}
128
129	require DBM::Deep;
130
131	my $db = new DBM::Deep $db_file;
132
133	$log->logdie("DBM::Deep error: $!") unless ($db);
134
135	if ($db->error()) {
136	$log->logdie("can't open '$db_file' under low_mem: ",$db->error());
137	} else {
138	$log->debug("using file '$db_file' for DBM::Deep");
139	}
140
141	$self->{'db'} = $db;
142	}
143
144	$self ? return $self : return undef;
145	}
146
147	=head2 open
148
149	This function will read whole database in memory and produce lookups.
150
151	$input->open(
152	path => '/path/to/database/file',
153	code_page => '852',
154	limit => 500,
155	offset => 6000,
156	lookup => $lookup_obj,
157	);
158
159	By default, C<code_page> is assumed to be C<852>.
160
161	C<offset> is optional parametar to position at some offset before reading from database.
162
163	C<limit> is optional parametar to read just C<limit> records from database
164
165	Returns size of database, regardless of C<offset> and C<limit>
166	parametars, see also C<size>.
167
168	=cut
169
170	sub open {
171	my $self = shift;
172	my $arg = {@_};
173
174	my $log = $self->_get_logger();
175
176	$log->logcroak("need path") if (! $arg->{'path'});
177	my $code_page = $arg->{'code_page'} \|\| '852';
178
179	# store data in object
180	$self->{'code_page'} = $code_page;
181	foreach my $v (qw/path offset limit/) {
182	$self->{$v} = $arg->{$v} if ($arg->{$v});
183	}
184
185	# create Text::Iconv object
186	$self->{iconv} = Text::Iconv->new($code_page,$self->{'code_page'});
187
188	my ($db, $size) = $self->{open_db}->( $self,
189	path => $arg->{path},
190	);
191
192	unless ($db) {
193	$log->logwarn("can't open database $arg->{path}, skipping...");
194	return;
195	}
196
197	unless ($size) {
198	$log->logwarn("no records in database $arg->{path}, skipping...");
199	return;
200	}
201
202	my $offset = 1;
203	my $limit = $size;
204
205	if (my $s = $self->{offset}) {
206	$log->info("skipping to MFN $s");
207	$offset = $s;
208	} else {
209	$self->{offset} = $offset;
210	}
211
212	if ($self->{limit}) {
213	$log->info("limiting to ",$self->{limit}," records");
214	$limit = $offset + $self->{limit} - 1;
215	$limit = $size if ($limit > $size);
216	}
217
218	# store size for later
219	$self->{size} = ($limit - $offset) ? ($limit - $offset + 1) : 0;
220
221	$log->info("processing $self->{size} records in $code_page, convert to $self->{code_page}");
222
223	# read database
224	for (my $pos = $offset; $pos <= $limit; $pos++) {
225
226	$log->debug("position: $pos\n");
227
228	my $rec = $self->{fetch_rec}->($self, $db, $pos );
229
230	if (! $rec) {
231	$log->warn("record $pos empty? skipping...");
232	next;
233	}
234
235	# store
236	if ($self->{low_mem}) {
237	$self->{db}->put($pos, $rec);
238	} else {
239	$self->{data}->{$pos} = $rec;
240	}
241
242	# create lookup
243	$self->{'lookup'}->add( $rec ) if ($rec && $self->{'lookup'});
244
245	$self->progress_bar($pos,$limit);
246
247	}
248
249	$self->{pos} = -1;
250	$self->{last_pcnt} = 0;
251
252	# store max mfn and return it.
253	$self->{max_pos} = $limit;
254	$log->debug("max_pos: $limit");
255
256	return $size;
257	}
258
259	=head2 fetch
260
261	Fetch next record from database. It will also displays progress bar.
262
263	my $rec = $isis->fetch;
264
265	Record from this function should probably go to C<data_structure> for
266	normalisation.
267
268	=cut
269
270	sub fetch {
271	my $self = shift;
272
273	my $log = $self->_get_logger();
274
275	$log->logconfess("it seems that you didn't load database!") unless ($self->{pos});
276
277	if ($self->{pos} == -1) {
278	$self->{pos} = $self->{offset};
279	} else {
280	$self->{pos}++;
281	}
282
283	my $mfn = $self->{pos};
284
285	if ($mfn > $self->{max_pos}) {
286	$self->{pos} = $self->{max_pos};
287	$log->debug("at EOF");
288	return;
289	}
290
291	$self->progress_bar($mfn,$self->{max_pos});
292
293	my $rec;
294
295	if ($self->{low_mem}) {
296	$rec = $self->{db}->get($mfn);
297	} else {
298	$rec = $self->{data}->{$mfn};
299	}
300
301	$rec \|\|= 0E0;
302	}
303
304	=head2 pos
305
306	Returns current record number (MFN).
307
308	print $isis->pos;
309
310	First record in database has position 1.
311
312	=cut
313
314	sub pos {
315	my $self = shift;
316	return $self->{pos};
317	}
318
319
320	=head2 size
321
322	Returns number of records in database
323
324	print $isis->size;
325
326	Result from this function can be used to loop through all records
327
328	foreach my $mfn ( 1 ... $isis->size ) { ... }
329
330	because it takes into account C<offset> and C<limit>.
331
332	=cut
333
334	sub size {
335	my $self = shift;
336	return $self->{size};
337	}
338
339	=head2 seek
340
341	Seek to specified MFN in file.
342
343	$isis->seek(42);
344
345	First record in database has position 1.
346
347	=cut
348
349	sub seek {
350	my $self = shift;
351	my $pos = shift \|\| return;
352
353	my $log = $self->_get_logger();
354
355	if ($pos < 1) {
356	$log->warn("seek before first record");
357	$pos = 1;
358	} elsif ($pos > $self->{max_pos}) {
359	$log->warn("seek beyond last record");
360	$pos = $self->{max_pos};
361	}
362
363	return $self->{pos} = (($pos - 1) \|\| -1);
364	}
365
366
367	=head1 MEMORY USAGE
368
369	C<low_mem> options is double-edged sword. If enabled, WebPAC
370	will run on memory constraint machines (which doesn't have enough
371	physical RAM to create memory structure for whole source database).
372
373	If your machine has 512Mb or more of RAM and database is around 10000 records,
374	memory shouldn't be an issue. If you don't have enough physical RAM, you
375	might consider using virtual memory (if your operating system is handling it
376	well, like on FreeBSD or Linux) instead of dropping to L<DBM::Deep> to handle
377	parsed structure of ISIS database (this is what C<low_mem> option does).
378
379	Hitting swap at end of reading source database is probably o.k. However,
380	hitting swap before 90% will dramatically decrease performance and you will
381	be better off with C<low_mem> and using rest of availble memory for
382	operating system disk cache (Linux is particuallary good about this).
383	However, every access to database record will require disk access, so
384	generation phase will be slower 10-100 times.
385
386	Parsed structures are essential - you just have option to trade RAM memory
387	(which is fast) for disk space (which is slow). Be sure to have planty of
388	disk space if you are using C<low_mem> and thus L<DBM::Deep>.
389
390	However, when WebPAC is running on desktop machines (or laptops :-), it's
391	highly undesireable for system to start swapping. Using C<low_mem> option can
392	reduce WecPAC memory usage to around 64Mb for same database with lookup
393	fields and sorted indexes which stay in RAM. Performance will suffer, but
394	memory usage will really be minimal. It might be also more confortable to
395	run WebPAC reniced on those machines.
396
397
398	=head1 AUTHOR
399
400	Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
401
402	=head1 COPYRIGHT & LICENSE
403
404	Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
405
406	This program is free software; you can redistribute it and/or modify it
407	under the same terms as Perl itself.
408
409	=cut
410
411	1; # End of WebPAC::Input