lib/WebPAC/Input.pm

package WebPAC::Input;

use warnings;
use strict;

use blib;

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

=head1 NAME

WebPAC::Input - read different file formats into WebPAC

=head1 VERSION

Version 0.07

=cut

our $VERSION = '0.07';

=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,
                low_mem => 1,
    );

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


=head1 FUNCTIONS

=head2 new

Create new input database object.

  my $db = new WebPAC::Input(
        module => 'WebPAC::Input::MARC',
        encoding => 'ISO-8859-2',
        low_mem => 1,
        recode => 'char pairs',
        no_progress_bar => 1,
  );

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

Optional parametar C<encoding> 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).

C<recode> is optional string constisting of character or words pairs that
should be replaced in input stream.

C<no_progress_bar> disables progress bar output on C<STDOUT>

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("code_page argument is not suppored any more. change it to encoding") if ($self->{lookup});
        $log->logconfess("lookup argument is not suppored any more. rewrite call to lookup_ref") if ($self->{lookup});

        $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->{'encoding'} ||= '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,
        stats => 1,
        lookup_ref => sub {
                my ($k,$v) = @_;
                # store lookup $k => $v
        },
 );

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

C<stats> create optional report about usage of fields and subfields

C<lookup_coderef> is closure to call when adding key => $value combinations to
lookup.

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->logconfess("lookup argument is not suppored any more. rewrite call to lookup_coderef") if ($arg->{lookup});
        $log->logconfess("lookup_coderef must be CODE, not ",ref($arg->{lookup_coderef}))
                if ($arg->{lookup_coderef} && ref($arg->{lookup_coderef}) ne 'CODE');

        $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->{'encoding'});      ## FIXME remove!

        my $filter_ref;

        if ($self->{recode}) {
                my @r = split(/\s/, $self->{recode});
                if ($#r % 2 != 1) {
                        $log->logwarn("recode needs even number of elements (some number of valid pairs)");
                } else {
                        my $recode;
                        while (@r) {
                                my $from = shift @r;
                                my $to = shift @r;
                                $recode->{$from} = $to;
                        }

                        my $regex = join '|' => keys %{ $recode };

                        $log->debug("using recode regex: $regex");
                        
                        $filter_ref = sub {
                                my $t = shift;
                                $t =~ s/($regex)/$recode->{$1}/g;
                                return $t;
                        };

                }

        }

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

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

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

        my $from_rec = 1;
        my $to_rec = $size;

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

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

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

        $log->info("processing $self->{size}/$size records [$from_rec-$to_rec] convert $code_page -> $self->{encoding}", $self->{stats} ? ' [stats]' : '');

        # read database
        for (my $pos = $from_rec; $pos <= $to_rec; $pos++) {

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

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

                $log->debug(sub { Dumper($rec) });

                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
                $arg->{'lookup_coderef'}->( $rec ) if ($rec && $arg->{'lookup_coderef'});

                # update counters for statistics
                if ($self->{stats}) {
                        map {
                                my $fld = $_;
                                $self->{_stats}->{fld}->{ $fld }++;
                                if (ref($rec->{ $fld }) eq 'ARRAY') {
                                        map {
                                                if (ref($_) eq 'HASH') {
                                                        map {
                                                                $self->{_stats}->{sf}->{ $fld }->{ $_ }++;
                                                        } keys %{ $_ };
                                                } else {
                                                        $self->{_stats}->{repeatable}->{ $fld }++;
                                                }
                                        } @{ $rec->{$fld} };
                                }
                        } keys %{ $rec };
                }

                $self->progress_bar($pos,$to_rec) unless ($self->{no_progress_bar});

        }

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

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

        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}) unless ($self->{no_progress_bar});

        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);
}

=head2 stats

Dump statistics about field and subfield usage

  print $input->stats;

=cut

sub stats {
        my $self = shift;

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

        my $s = $self->{_stats};
        if (! $s) {
                $log->warn("called stats, but there is no statistics collected");
                return;
        }

        my $max_fld = 0;

        my $out = join("\n",
                map {
                        my $f = $_ || die "no field";
                        my $v = $s->{fld}->{$f} || die "no s->{fld}->{$f}";
                        $max_fld = $v if ($v > $max_fld);

                        my $o = sprintf("%4s %d ~", $f, $v);

                        if (defined($s->{sf}->{$f})) {
                                map {
                                        $o .= sprintf(" %s:%d", $_, $s->{sf}->{$f}->{$_});
                                } sort keys %{ $s->{sf}->{$f} };
                        }

                        if (my $v_r = $s->{repeatable}->{$f}) {
                                $o .= " ($v_r)" if ($v_r != $v);
                        }

                        $o;
                } sort { $a cmp $b } keys %{ $s->{fld} }
        );

        $log->debug( sub { Dumper($s) } );

        return $out;
}

=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	use Data::Dumper;
12
13	=head1 NAME
14
15	WebPAC::Input - read different file formats into WebPAC
16
17	=head1 VERSION
18
19	Version 0.07
20
21	=cut
22
23	our $VERSION = '0.07';
24
25	=head1 SYNOPSIS
26
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>.
30
31	Simply, something that is indexed by unmber from 1 .. I<size>.
32
33	Examples of such databases are CDS/ISIS files, MARC files, lines in
34	text file, and so on.
35
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.
39
40	Perhaps a little code snippet.
41
42	use WebPAC::Input;
43
44	my $db = WebPAC::Input->new(
45	module => 'WebPAC::Input::ISIS',
46	config => $config,
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	# do something with $rec
54	}
55
56
57
58	=head1 FUNCTIONS
59
60	=head2 new
61
62	Create new input database object.
63
64	my $db = new WebPAC::Input(
65	module => 'WebPAC::Input::MARC',
66	encoding => 'ISO-8859-2',
67	low_mem => 1,
68	recode => 'char pairs',
69	no_progress_bar => 1,
70	);
71
72	C<module> is low-level file format module. See L<WebPAC::Input::Isis> and
73	L<WebPAC::Input::MARC>.
74
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>.
78
79	Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).
80
81	C<recode> is optional string constisting of character or words pairs that
82	should be replaced in input stream.
83
84	C<no_progress_bar> disables progress bar output on C<STDOUT>
85
86	This function will also call low-level C<init> if it exists with same
87	parametars.
88
89	=cut
90
91	sub new {
92	my $class = shift;
93	my $self = {@_};
94	bless($self, $class);
95
96	my $log = $self->_get_logger;
97
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});
100
101	$log->logconfess("specify low-level file format module") unless ($self->{module});
102	my $module = $self->{module};
103	$module =~ s#::#/#g;
104	$module .= '.pm';
105	$log->debug("require low-level module $self->{module} from $module");
106
107	require $module;
108	#eval $self->{module} .'->import';
109
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) };
116	} else {
117	$self->{$subclass} = \&{ $n };
118	}
119	}
120
121	if ($self->{init}) {
122	$log->debug("calling init");
123	$self->{init}->($self, @_);
124	}
125
126	$self->{'encoding'} \|\|= 'ISO-8859-2';
127
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)");
131
132	my $db_file = "data.db";
133
134	if (-e $db_file) {
135	unlink $db_file or $log->logdie("can't remove '$db_file' from last run");
136	$log->debug("removed '$db_file' from last run");
137	}
138
139	require DBM::Deep;
140
141	my $db = new DBM::Deep $db_file;
142
143	$log->logdie("DBM::Deep error: $!") unless ($db);
144
145	if ($db->error()) {
146	$log->logdie("can't open '$db_file' under low_mem: ",$db->error());
147	} else {
148	$log->debug("using file '$db_file' for DBM::Deep");
149	}
150
151	$self->{'db'} = $db;
152	}
153
154	$self ? return $self : return undef;
155	}
156
157	=head2 open
158
159	This function will read whole database in memory and produce lookups.
160
161	$input->open(
162	path => '/path/to/database/file',
163	code_page => '852',
164	limit => 500,
165	offset => 6000,
166	lookup => $lookup_obj,
167	stats => 1,
168	lookup_ref => sub {
169	my ($k,$v) = @_;
170	# store lookup $k => $v
171	},
172	);
173
174	By default, C<code_page> is assumed to be C<852>.
175
176	C<offset> is optional parametar to position at some offset before reading from database.
177
178	C<limit> is optional parametar to read just C<limit> records from database
179
180	C<stats> create optional report about usage of fields and subfields
181
182	C<lookup_coderef> is closure to call when adding key => $value combinations to
183	lookup.
184
185	Returns size of database, regardless of C<offset> and C<limit>
186	parametars, see also C<size>.
187
188	=cut
189
190	sub open {
191	my $self = shift;
192	my $arg = {@_};
193
194	my $log = $self->_get_logger();
195
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');
199
200	$log->logcroak("need path") if (! $arg->{'path'});
201	my $code_page = $arg->{'code_page'} \|\| '852';
202
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});
207	}
208
209	# create Text::Iconv object
210	$self->{iconv} = Text::Iconv->new($code_page,$self->{'encoding'}); ## FIXME remove!
211
212	my $filter_ref;
213
214	if ($self->{recode}) {
215	my @r = split(/\s/, $self->{recode});
216	if ($#r % 2 != 1) {
217	$log->logwarn("recode needs even number of elements (some number of valid pairs)");
218	} else {
219	my $recode;
220	while (@r) {
221	my $from = shift @r;
222	my $to = shift @r;
223	$recode->{$from} = $to;
224	}
225
226	my $regex = join '\|' => keys %{ $recode };
227
228	$log->debug("using recode regex: $regex");
229
230	$filter_ref = sub {
231	my $t = shift;
232	$t =~ s/($regex)/$recode->{$1}/g;
233	return $t;
234	};
235
236	}
237
238	}
239
240	my ($db, $size) = $self->{open_db}->( $self,
241	path => $arg->{path},
242	filter => $filter_ref,
243	%{ $arg },
244	);
245
246	unless (defined($db)) {
247	$log->logwarn("can't open database $arg->{path}, skipping...");
248	return;
249	}
250
251	unless ($size) {
252	$log->logwarn("no records in database $arg->{path}, skipping...");
253	return;
254	}
255
256	my $from_rec = 1;
257	my $to_rec = $size;
258
259	if (my $s = $self->{offset}) {
260	$log->debug("skipping to MFN $s");
261	$from_rec = $s;
262	} else {
263	$self->{offset} = $from_rec;
264	}
265
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);
270	}
271
272	# store size for later
273	$self->{size} = ($to_rec - $from_rec) ? ($to_rec - $from_rec + 1) : 0;
274
275	$log->info("processing $self->{size}/$size records [$from_rec-$to_rec] convert $code_page -> $self->{encoding}", $self->{stats} ? ' [stats]' : '');
276
277	# read database
278	for (my $pos = $from_rec; $pos <= $to_rec; $pos++) {
279
280	$log->debug("position: $pos\n");
281
282	my $rec = $self->{fetch_rec}->($self, $db, $pos );
283
284	$log->debug(sub { Dumper($rec) });
285
286	if (! $rec) {
287	$log->warn("record $pos empty? skipping...");
288	next;
289	}
290
291	# store
292	if ($self->{low_mem}) {
293	$self->{db}->put($pos, $rec);
294	} else {
295	$self->{data}->{$pos} = $rec;
296	}
297
298	# create lookup
299	$arg->{'lookup_coderef'}->( $rec ) if ($rec && $arg->{'lookup_coderef'});
300
301	# update counters for statistics
302	if ($self->{stats}) {
303	map {
304	my $fld = $_;
305	$self->{_stats}->{fld}->{ $fld }++;
306	if (ref($rec->{ $fld }) eq 'ARRAY') {
307	map {
308	if (ref($_) eq 'HASH') {
309	map {
310	$self->{_stats}->{sf}->{ $fld }->{ $_ }++;
311	} keys %{ $_ };
312	} else {
313	$self->{_stats}->{repeatable}->{ $fld }++;
314	}
315	} @{ $rec->{$fld} };
316	}
317	} keys %{ $rec };
318	}
319
320	$self->progress_bar($pos,$to_rec) unless ($self->{no_progress_bar});
321
322	}
323
324	$self->{pos} = -1;
325	$self->{last_pcnt} = 0;
326
327	# store max mfn and return it.
328	$self->{max_pos} = $to_rec;
329	$log->debug("max_pos: $to_rec");
330
331	return $size;
332	}
333
334	=head2 fetch
335
336	Fetch next record from database. It will also displays progress bar.
337
338	my $rec = $isis->fetch;
339
340	Record from this function should probably go to C<data_structure> for
341	normalisation.
342
343	=cut
344
345	sub fetch {
346	my $self = shift;
347
348	my $log = $self->_get_logger();
349
350	$log->logconfess("it seems that you didn't load database!") unless ($self->{pos});
351
352	if ($self->{pos} == -1) {
353	$self->{pos} = $self->{offset};
354	} else {
355	$self->{pos}++;
356	}
357
358	my $mfn = $self->{pos};
359
360	if ($mfn > $self->{max_pos}) {
361	$self->{pos} = $self->{max_pos};
362	$log->debug("at EOF");
363	return;
364	}
365
366	$self->progress_bar($mfn,$self->{max_pos}) unless ($self->{no_progress_bar});
367
368	my $rec;
369
370	if ($self->{low_mem}) {
371	$rec = $self->{db}->get($mfn);
372	} else {
373	$rec = $self->{data}->{$mfn};
374	}
375
376	$rec \|\|= 0E0;
377	}
378
379	=head2 pos
380
381	Returns current record number (MFN).
382
383	print $isis->pos;
384
385	First record in database has position 1.
386
387	=cut
388
389	sub pos {
390	my $self = shift;
391	return $self->{pos};
392	}
393
394
395	=head2 size
396
397	Returns number of records in database
398
399	print $isis->size;
400
401	Result from this function can be used to loop through all records
402
403	foreach my $mfn ( 1 ... $isis->size ) { ... }
404
405	because it takes into account C<offset> and C<limit>.
406
407	=cut
408
409	sub size {
410	my $self = shift;
411	return $self->{size};
412	}
413
414	=head2 seek
415
416	Seek to specified MFN in file.
417
418	$isis->seek(42);
419
420	First record in database has position 1.
421
422	=cut
423
424	sub seek {
425	my $self = shift;
426	my $pos = shift \|\| return;
427
428	my $log = $self->_get_logger();
429
430	if ($pos < 1) {
431	$log->warn("seek before first record");
432	$pos = 1;
433	} elsif ($pos > $self->{max_pos}) {
434	$log->warn("seek beyond last record");
435	$pos = $self->{max_pos};
436	}
437
438	return $self->{pos} = (($pos - 1) \|\| -1);
439	}
440
441	=head2 stats
442
443	Dump statistics about field and subfield usage
444
445	print $input->stats;
446
447	=cut
448
449	sub stats {
450	my $self = shift;
451
452	my $log = $self->_get_logger();
453
454	my $s = $self->{_stats};
455	if (! $s) {
456	$log->warn("called stats, but there is no statistics collected");
457	return;
458	}
459
460	my $max_fld = 0;
461
462	my $out = join("\n",
463	map {
464	my $f = $_ \|\| die "no field";
465	my $v = $s->{fld}->{$f} \|\| die "no s->{fld}->{$f}";
466	$max_fld = $v if ($v > $max_fld);
467
468	my $o = sprintf("%4s %d ~", $f, $v);
469
470	if (defined($s->{sf}->{$f})) {
471	map {
472	$o .= sprintf(" %s:%d", $_, $s->{sf}->{$f}->{$_});
473	} sort keys %{ $s->{sf}->{$f} };
474	}
475
476	if (my $v_r = $s->{repeatable}->{$f}) {
477	$o .= " ($v_r)" if ($v_r != $v);
478	}
479
480	$o;
481	} sort { $a cmp $b } keys %{ $s->{fld} }
482	);
483
484	$log->debug( sub { Dumper($s) } );
485
486	return $out;
487	}
488
489	=head1 MEMORY USAGE
490
491	C<low_mem> options is double-edged sword. If enabled, WebPAC
492	will run on memory constraint machines (which doesn't have enough
493	physical RAM to create memory structure for whole source database).
494
495	If your machine has 512Mb or more of RAM and database is around 10000 records,
496	memory shouldn't be an issue. If you don't have enough physical RAM, you
497	might consider using virtual memory (if your operating system is handling it
498	well, like on FreeBSD or Linux) instead of dropping to L<DBM::Deep> to handle
499	parsed structure of ISIS database (this is what C<low_mem> option does).
500
501	Hitting swap at end of reading source database is probably o.k. However,
502	hitting swap before 90% will dramatically decrease performance and you will
503	be better off with C<low_mem> and using rest of availble memory for
504	operating system disk cache (Linux is particuallary good about this).
505	However, every access to database record will require disk access, so
506	generation phase will be slower 10-100 times.
507
508	Parsed structures are essential - you just have option to trade RAM memory
509	(which is fast) for disk space (which is slow). Be sure to have planty of
510	disk space if you are using C<low_mem> and thus L<DBM::Deep>.
511
512	However, when WebPAC is running on desktop machines (or laptops :-), it's
513	highly undesireable for system to start swapping. Using C<low_mem> option can
514	reduce WecPAC memory usage to around 64Mb for same database with lookup
515	fields and sorted indexes which stay in RAM. Performance will suffer, but
516	memory usage will really be minimal. It might be also more confortable to
517	run WebPAC reniced on those machines.
518
519
520	=head1 AUTHOR
521
522	Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
523
524	=head1 COPYRIGHT & LICENSE
525
526	Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
527
528	This program is free software; you can redistribute it and/or modify it
529	under the same terms as Perl itself.
530
531	=cut
532
533	1; # End of WebPAC::Input