implemented load_row and save_row closures to serialize

input databases (using WebPAC::Store probably).
This will allow lookups to share on-disk storage with
low_mem option of WebPAC::Input, which is now gone
(under pressure of 600000+ record database which we
are now testing on)

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@761 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/lib/WebPAC/Input.pm b/lib/WebPAC/Input.pm
index cab03cc..8955cf5 100644 (file)
--- a/lib/WebPAC/Input.pm
+++ b/lib/WebPAC/Input.pm
@@ -16,11 +16,11 @@ WebPAC::Input - read different file formats into WebPAC
 
 =head1 VERSION
 
-Version 0.13
+Version 0.14
 
 =cut
 
-our $VERSION = '0.13';
+our $VERSION = '0.14';
 
 =head1 SYNOPSIS
 
@@ -43,7 +43,6 @@ Perhaps a little code snippet.
 
        my $db = WebPAC::Input->new(
                module => 'WebPAC::Input::ISIS',
-               low_mem => 1,
        );
 
        $db->open( path => '/path/to/database' );
@@ -63,7 +62,6 @@ 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,
   );
@@ -75,8 +73,6 @@ 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.
 
@@ -96,6 +92,7 @@ sub new {
 
        $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("low_mem argument is not suppored any more. rewrite it to load_row and save_row") if ($self->{low_mem});
 
        $log->logconfess("specify low-level file format module") unless ($self->{module});
        my $module_path = $self->{module};
@@ -119,6 +116,8 @@ sub new {
 
 This function will read whole database in memory and produce lookups.
 
+ my $store;    # simple in-memory hash
+
  $input->open(
        path => '/path/to/database/file',
        code_page => 'cp852',
@@ -134,6 +133,16 @@ This function will read whole database in memory and produce lookups.
                901 => { '*' => { '^b' => ' ; ' } },
        },
        modify_file => 'conf/modify/mapping.map',
+       save_row => sub {
+               my $a = shift;
+               $store->{ $a->{id} } = $a->{row};
+       },
+       load_row => sub {
+               my $a = shift;
+               return defined($store->{ $a->{id} }) &&
+                       $store->{ $a->{id} };
+       },
+
  );
 
 By default, C<code_page> is assumed to be C<cp852>.
@@ -154,6 +163,9 @@ C<modify_file> is alternative for C<modify_records> above which preserves order
 (hopefully) simplier sintax than YAML or perl (see L</modify_file_regex>). This option
 overrides C<modify_records> if both exists for same input.
 
+C<save_row> and C<load_row> are low-level implementation of store engine. Calling convention
+is documented in example above.
+
 Returns size of database, regardless of C<offset> and C<limit>
 parametars, see also C<size>.
 
@@ -180,6 +192,16 @@ sub open {
                $self->{$v} = $arg->{$v} if ($arg->{$v});
        }
 
+       if ($arg->{load_row} || $arg->{save_row}) {
+               $log->logconfess("save_row and load_row must be defined in pair and be CODE") unless (
+                       ref($arg->{load_row}) eq 'CODE' &&
+                       ref($arg->{save_row}) eq 'CODE'
+               );
+               $self->{load_row} = $arg->{load_row};
+               $self->{save_row} = $arg->{save_row};
+               $log->debug("using load_row and save_row instead of in-memory hash");
+       }
+
        my $filter_ref;
        my $recode_regex;
        my $recode_map;
@@ -259,38 +281,6 @@ sub open {
 
        $log->info("processing $self->{size}/$size records [$from_rec-$to_rec] convert $code_page -> $self->{encoding}", $self->{stats} ? ' [stats]' : '');
 
-       # turn on low_mem for databases with more than 100000 records!
-       if (! $self->{low_mem} && $size > 100000) {
-               $log->warn("Using on-disk storage instead of memory for input data. This will affect performance.");
-               $self->{low_mem}++;
-       }
-
-       # 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;
-       }
-
        # read database
        for (my $pos = $from_rec; $pos <= $to_rec; $pos++) {
 
@@ -333,8 +323,11 @@ sub open {
                }
 
                # store
-               if ($self->{low_mem}) {
-                       $self->{db}->put($pos, $rec);
+               if ($self->{save_row}) {
+                       $self->{save_row}->({
+                               id => $pos,
+                               row => $rec,
+                       });
                } else {
                        $self->{data}->{$pos} = $rec;
                }
@@ -425,8 +418,8 @@ sub fetch {
 
        my $rec;
 
-       if ($self->{low_mem}) {
-               $rec = $self->{db}->get($mfn);
+       if ($self->{load_row}) {
+               $rec = $self->{load_row}->({ id => $mfn });
        } else {
                $rec = $self->{data}->{$mfn};
        }
@@ -671,37 +664,6 @@ sub modify_file_regexps {
        return $regexpes;
 }
 
-=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> >>

diff --git a/t/2-input.t b/t/2-input.t
index c08efee..a228448 100755 (executable)
--- a/t/2-input.t
+++ b/t/2-input.t
@@ -1,19 +1,19 @@
 #!/usr/bin/perl -w
 
-use Test::More tests => 68;
+use Test::More tests => 89;
 use Test::Exception;
 use Cwd qw/abs_path/;
 use blib;
 use strict;
 
-use Data::Dumper;
+use Data::Dump qw/dump/;
 
 BEGIN {
 use_ok( 'WebPAC::Input::ISIS' );
 use_ok( 'WebPAC::Input::MARC' );
 }
 
-my $debug = 1;
+my $debug = shift @ARGV;
 my $no_log = $debug ? 0 : 1;
 
 ok(my $abs_path = abs_path($0), "abs_path");
@@ -23,15 +23,39 @@ my $module = 'WebPAC::Input::ISIS';
 diag "testing with $module";
 
 throws_ok { my $input = new WebPAC::Input( ) } qr/module/, "need module";
-ok(my $input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1, stats => 1 ), "new");
-ok(my $input_lm = new WebPAC::Input( module => $module, low_mem => 1, no_log => $no_log, no_progress_bar => 1 ), "new $module");
+ok(my $input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1, stats => 1 ), "new $module");
+ok(my $input_lm = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1 ), "new $module");
 
 throws_ok { $input->open( ) } qr/path/, "need path";
 
 throws_ok { $input->open( path => '/dev/null', ) } qr/can't find database/ , "open";
 
+my $store;
+
 ok($input->open( path => "$abs_path/winisis/BIBL" ), "open winisis");
-ok($input_lm->open( path => "$abs_path/winisis/BIBL", low_mem => 1 ), "open winisis");
+ok($input_lm->open(
+       path => "$abs_path/winisis/BIBL",
+       save_row => sub {
+               my $a = shift;
+               $store->{ $a->{id} } = $a->{row};
+       },
+       load_row => sub {
+               my $a = shift;
+               return defined($store->{ $a->{id} }) &&
+                       $store->{ $a->{id} };
+       },
+), "open winisis");
+
+cmp_ok( keys %$store, '==', 5, 'have 5 rows');
+
+foreach my $i ( 1 .. 5 ) {
+       ok(my $r = $store->{$i}, "row $i");
+       ok($r->{'000'}, "have 000");
+       isa_ok($r->{'000'}, 'ARRAY', "is ARRAY");
+       cmp_ok($r->{'000'}->[0], '==', $i, 'sane value');
+}
+
+diag "store = ",dump( $store ) if ($debug);
 
 sub test_after_open($) {
        my $input = shift;
@@ -68,7 +92,7 @@ sub test_start_limit($$$$) {
 
        diag "offset $s, limit: $l, expected: $e";
 
-       ok($s = $input->open( path => "$abs_path/winisis/BIBL", offset => $s, limit => $l, debug => 1 ), "open winisis");
+       ok($s = $input->open( path => "$abs_path/winisis/BIBL", offset => $s, limit => $l, debug => $debug ), "open winisis");
        cmp_ok($s, '==', $size, "db size from open = $size");
        cmp_ok($input->size, '==', $e, "input->size = $e");
 }
@@ -84,7 +108,7 @@ diag "stats:\n$s";
 $module = 'WebPAC::Input::MARC';
 diag "testing with $module";
 
-ok($input = new WebPAC::Input( module => $module, low_mem => 1, no_log => $no_log, no_progress_bar => 1 ), "new $module");
+ok($input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1 ), "new $module");
 
 ok($input->open( path => "$abs_path/data/marc.iso" ), "open marc.iso");
 
@@ -96,7 +120,7 @@ test_fetch($input, $input->size);
 $module = 'WebPAC::Input::ISIS';
 ok($input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1 ), "new $module");
 
-ok($input->open( path => "$abs_path/modify_isis/LIBRI",), "open modify_isis (plain)");
+ok($input->open( path => "$abs_path/modify_isis/LIBRI", ), "open modify_isis (plain)");
 ok(my $rec_p = $input->fetch, 'fetch');
 
 ok($input->open(
@@ -111,3 +135,4 @@ ok($input->open(
 ok(my $rec = $input->fetch, 'fetch');
 
 cmp_ok($rec_p->{200}->[0]->{f} . '. ' . $rec_p->{200}->[0]->{c}, 'eq' ,$rec->{200}->[0]->{f}, 'modify_records working');
+