trunk/t/2-input.t

#!/usr/bin/perl -w

use Test::More tests => 104;
use Test::Exception;
use Cwd qw/abs_path/;
use blib;
use strict;

use Data::Dump qw/dump/;

BEGIN {
use_ok( 'WebPAC::Input::ISIS' );
use_ok( 'WebPAC::Input::MARC' );
use_ok( 'WebPAC::Input::Test' );
}

my $debug = shift @ARGV;
my $no_log = $debug ? 0 : 1;

ok(my $abs_path = abs_path($0), "abs_path");
$abs_path =~ s#/[^/]*$#/#;

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 $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",
        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;

        cmp_ok($input->pos, '==', -1, "mfn");
        ok(my $size = $input->size, "size");
        return $size;
}

test_after_open($input);
my $size = test_after_open($input_lm);

sub test_fetch($$) {
        my ($input, $size) = @_;

        my @db;

        foreach my $mfn ( 1 ... $size ) {
                ok(my $rec = $input->fetch, "fetch $mfn");
                cmp_ok($input->pos, '==', $mfn, "pos $mfn");
                push @db, $rec;
                ok(my $dump = $input->dump_ascii, "dump_ascii $mfn");
                diag $dump if ($debug);
        }

        return @db;
}

my @db1 = test_fetch($input, $size);
my @db2 = test_fetch($input_lm, $size);

is_deeply(\@db1, \@db2, "seek working");

sub test_start_limit($$$$) {
        my ($input, $s,$l,$e) = @_;

        diag "offset $s, limit: $l, expected: $e";

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

test_start_limit($input, 1, 3, 3);
test_start_limit($input, $size, 3, 0);
test_start_limit($input, 3, $size, $size - 2);
test_start_limit($input, 1, $size + 2, $size);

ok(my $s = $input->stats, 'stats');
diag "stats:\n$s" if ($debug);

$module = 'WebPAC::Input::MARC';
diag "testing with $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");

test_after_open($input);

test_fetch($input, $input->size);

# test modify_record
$module = 'WebPAC::Input::Test';
ok($input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1, debug => $debug ), "new $module");

ok($input->open( path => "$abs_path/modify_isis/LIBRI", ), "open modify_isis (plain)");

$WebPAC::Input::Test::rec = {
        '200' => [ {
                'a' => 'foo',
                'b' => 'bar',
                }, {
                'a' => 'baz',
                } ],
        '900' => [
                'foobar',
                ],
};

ok($input->size, 'size');

ok(my $rec_p = $input->fetch, 'fetch');

# modify_records

ok($input->open(
        path => "$abs_path/modify_isis/LIBRI",
        modify_records => {
                200 => {
                        '*' => { '^c' => '. ' },
                        '^f' => { ' : ' => ' / ' },
                }
        },
), "open modify_isis (with modify_records)");

ok(my $rec = $input->fetch, 'fetch');
diag "fetched rec field 200 = ", dump($rec->{200}) if ($debug);

cmp_ok($rec_p->{200}->[0]->{f} . '. ' . $rec_p->{200}->[0]->{c}, 'eq' ,$rec->{200}->[0]->{f}, 'modify_records working');

diag "input = ",dump($input->{data}) if ($debug);

# break encapsulation, bad! bad!
$input->{ll_db}->{_isis_db}->{record} = {
        900 => 'foo ; bar ; baz',
};

$input->{modify_record} = {
        900 => {
                '*' => [
                        { ' ; ' => 'a' },
                        { ' ; ' => 'b' },
                        { ' ; ' => 'c' },
                ],
        }
};

diag "hacked: ",dump($input, $input->fetch) if ($debug);

# seek
throws_ok { $input->seek } qw/without/, 'seek without position';
cmp_ok($input->seek(0), '==', -1, 'seek');

ok(my $rec = $input->fetch, 'fetch');
diag "fetched rec = ", dump($rec) if ($debug);
1	dpavlin	286	#!/usr/bin/perl -w
2
3	dpavlin	771	use Test::More tests => 104;
4	dpavlin	286	use Test::Exception;
5			use Cwd qw/abs_path/;
6			use blib;
7			use strict;
8
9	dpavlin	761	use Data::Dump qw/dump/;
10	dpavlin	506
11	dpavlin	286	BEGIN {
12			use_ok( 'WebPAC::Input::ISIS' );
13	dpavlin	290	use_ok( 'WebPAC::Input::MARC' );
14	dpavlin	796	use_ok( 'WebPAC::Input::Test' );
15	dpavlin	286	}
16
17	dpavlin	761	my $debug = shift @ARGV;
18	dpavlin	506	my $no_log = $debug ? 0 : 1;
19
20	dpavlin	286	ok(my $abs_path = abs_path($0), "abs_path");
21			$abs_path =~ s#/[^/]*$#/#;
22
23			my $module = 'WebPAC::Input::ISIS';
24	dpavlin	290	diag "testing with $module";
25	dpavlin	286
26			throws_ok { my $input = new WebPAC::Input( ) } qr/module/, "need module";
27	dpavlin	761	ok(my $input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1, stats => 1 ), "new $module");
28			ok(my $input_lm = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1 ), "new $module");
29	dpavlin	286
30			throws_ok { $input->open( ) } qr/path/, "need path";
31
32			throws_ok { $input->open( path => '/dev/null', ) } qr/can't find database/ , "open";
33
34	dpavlin	761	my $store;
35
36	dpavlin	599	ok($input->open( path => "$abs_path/winisis/BIBL" ), "open winisis");
37	dpavlin	761	ok($input_lm->open(
38			path => "$abs_path/winisis/BIBL",
39			save_row => sub {
40			my $a = shift;
41			$store->{ $a->{id} } = $a->{row};
42			},
43			load_row => sub {
44			my $a = shift;
45			return defined($store->{ $a->{id} }) &&
46			$store->{ $a->{id} };
47			},
48			), "open winisis");
49	dpavlin	286
50	dpavlin	761	cmp_ok( keys %$store, '==', 5, 'have 5 rows');
51
52			foreach my $i ( 1 .. 5 ) {
53			ok(my $r = $store->{$i}, "row $i");
54			ok($r->{'000'}, "have 000");
55			isa_ok($r->{'000'}, 'ARRAY', "is ARRAY");
56			cmp_ok($r->{'000'}->[0], '==', $i, 'sane value');
57			}
58
59			diag "store = ",dump( $store ) if ($debug);
60
61	dpavlin	290	sub test_after_open($) {
62			my $input = shift;
63	dpavlin	286
64	dpavlin	290	cmp_ok($input->pos, '==', -1, "mfn");
65			ok(my $size = $input->size, "size");
66			return $size;
67			}
68	dpavlin	286
69	dpavlin	290	test_after_open($input);
70			my $size = test_after_open($input_lm);
71	dpavlin	286
72	dpavlin	290	sub test_fetch($$) {
73			my ($input, $size) = @_;
74	dpavlin	286
75	dpavlin	290	my @db;
76	dpavlin	286
77	dpavlin	290	foreach my $mfn ( 1 ... $size ) {
78			ok(my $rec = $input->fetch, "fetch $mfn");
79			cmp_ok($input->pos, '==', $mfn, "pos $mfn");
80			push @db, $rec;
81	dpavlin	774	ok(my $dump = $input->dump_ascii, "dump_ascii $mfn");
82	dpavlin	771	diag $dump if ($debug);
83	dpavlin	290	}
84
85			return @db;
86	dpavlin	286	}
87
88	dpavlin	290	my @db1 = test_fetch($input, $size);
89			my @db2 = test_fetch($input_lm, $size);
90
91	dpavlin	286	is_deeply(\@db1, \@db2, "seek working");
92
93	dpavlin	290	sub test_start_limit($$$$) {
94			my ($input, $s,$l,$e) = @_;
95	dpavlin	286
96			diag "offset $s, limit: $l, expected: $e";
97
98	dpavlin	761	ok($s = $input->open( path => "$abs_path/winisis/BIBL", offset => $s, limit => $l, debug => $debug ), "open winisis");
99	dpavlin	286	cmp_ok($s, '==', $size, "db size from open = $size");
100			cmp_ok($input->size, '==', $e, "input->size = $e");
101			}
102
103	dpavlin	290	test_start_limit($input, 1, 3, 3);
104			test_start_limit($input, $size, 3, 0);
105			test_start_limit($input, 3, $size, $size - 2);
106			test_start_limit($input, 1, $size + 2, $size);
107	dpavlin	286
108	dpavlin	506	ok(my $s = $input->stats, 'stats');
109	dpavlin	794	diag "stats:\n$s" if ($debug);
110	dpavlin	506
111	dpavlin	290	$module = 'WebPAC::Input::MARC';
112			diag "testing with $module";
113
114	dpavlin	761	ok($input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1 ), "new $module");
115	dpavlin	290
116	dpavlin	599	ok($input->open( path => "$abs_path/data/marc.iso" ), "open marc.iso");
117	dpavlin	290
118			test_after_open($input);
119
120			test_fetch($input, $input->size);
121
122	dpavlin	599	# test modify_record
123	dpavlin	796	$module = 'WebPAC::Input::Test';
124			ok($input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1, debug => $debug ), "new $module");
125	dpavlin	599
126	dpavlin	761	ok($input->open( path => "$abs_path/modify_isis/LIBRI", ), "open modify_isis (plain)");
127	dpavlin	796
128			$WebPAC::Input::Test::rec = {
129			'200' => [ {
130			'a' => 'foo',
131			'b' => 'bar',
132			}, {
133			'a' => 'baz',
134			} ],
135			'900' => [
136			'foobar',
137			],
138			};
139
140			ok($input->size, 'size');
141
142	dpavlin	599	ok(my $rec_p = $input->fetch, 'fetch');
143
144	dpavlin	784	# modify_records
145
146	dpavlin	599	ok($input->open(
147			path => "$abs_path/modify_isis/LIBRI",
148			modify_records => {
149			200 => {
150			'*' => { '^c' => '. ' },
151	dpavlin	794	'^f' => { ' : ' => ' / ' },
152	dpavlin	599	}
153			},
154			), "open modify_isis (with modify_records)");
155
156			ok(my $rec = $input->fetch, 'fetch');
157	dpavlin	794	diag "fetched rec field 200 = ", dump($rec->{200}) if ($debug);
158	dpavlin	599
159			cmp_ok($rec_p->{200}->[0]->{f} . '. ' . $rec_p->{200}->[0]->{c}, 'eq' ,$rec->{200}->[0]->{f}, 'modify_records working');
160	dpavlin	761
161	dpavlin	794	diag "input = ",dump($input->{data}) if ($debug);
162	dpavlin	784
163			# break encapsulation, bad! bad!
164	dpavlin	794	$input->{ll_db}->{_isis_db}->{record} = {
165	dpavlin	784	900 => 'foo ; bar ; baz',
166			};
167
168			$input->{modify_record} = {
169			900 => {
170	dpavlin	794	'*' => [
171			{ ' ; ' => 'a' },
172			{ ' ; ' => 'b' },
173			{ ' ; ' => 'c' },
174			],
175	dpavlin	784	}
176			};
177
178	dpavlin	794	diag "hacked: ",dump($input, $input->fetch) if ($debug);
179
180			# seek
181			throws_ok { $input->seek } qw/without/, 'seek without position';
182			cmp_ok($input->seek(0), '==', -1, 'seek');
183
184			ok(my $rec = $input->fetch, 'fetch');
185			diag "fetched rec = ", dump($rec) if ($debug);