trunk/t/2-input.t

#!/usr/bin/perl -w

use strict;
use lib 'lib';

use Test::More tests => 124;

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

$LOG{no_progress_bar} = 1;

warn "# LOG = ",dump( %LOG );

my $module = 'WebPAC::Input::ISIS';
diag "testing with $module";

throws_ok { my $input = new WebPAC::Input( %LOG ) } qr/module/, "need module";
ok(my $input = new WebPAC::Input( module => $module, stats => 1, \%LOG ), "new $module");
ok(my $input_lm = new WebPAC::Input( module => $module, \%LOG ), "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");
                # XXX test count will help us keep this test in-line :-)
                ok($rec->{leader}, "leader $mfn") if $rec->{leader};
                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");
        cmp_ok($input->size, '==', $e, "input->size = $e");
}

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

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

$module = 'WebPAC::Input::MARC';
diag "testing with $module";

ok($input = new WebPAC::Input( module => $module, stats => 1, %LOG ), "new $module");

ok($input->open( path => "$abs_path/data/marc.iso" ), "open marc.iso");

test_after_open($input);

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

ok(my $s = $input->stats, "$module stats");

diag "stats:\n$s" if ($debug);
# test modify_record
$module = 'WebPAC::Input::Test';
ok($input = new WebPAC::Input( module => $module, %LOG ), "new $module");

$WebPAC::Input::Test::rec = {
        '200' => [
                { 'a' => '[200 a]', 'b' => '[200 b]', 'c' => '[200 c]', 'f' => '[200 f] test : test' },
        ],
        '900' => [
                { 'x' => 'foobar', },
        ],
};

$WebPAC::Input::Test::size = 42;

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

cmp_ok($input->size, '==', 42, 'size');

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

# modify_records

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

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

sub test_filter {

        my $f = $WebPAC::Input::Test::filter_coderef;
        ok(ref($f) eq 'CODE', 'filter_coderef');

        my ($field, $from, $to) = @_;
        cmp_ok( $f->( $from, $field, 1 ), 'eq', $to, "filter $field |$from| -> |$to|" );
}

test_filter(200,
        '^afoo^cbar^fbing : bong',
        '^afoo. bar^fbing / bong',
);

# modify_file

my $modify_file = "$abs_path/conf/modify/test.pl";

ok($input->open(
        path => "/and/another/fake/path",
        modify_file => $modify_file,
), "open (with modify_file $modify_file)");

diag "regexps = ", dump($input->modify_file_regexps( $modify_file )) if ($debug);

test_filter(200,
        '^a foo ; bar = baz : zzz',
        '^a foo^kbar^dbaz : zzz',
);

# empty subfield removal

ok($input->open(
        path => "/another/fake/path",
        modify_records => {
                900 => {
                        '^a' => { '^e' => ' : ^e' },
                },
                901 => {
                        '^a' => { 'foo' => 'baz' },
                },
        },
), "open (with modify_records for empty subfields)");

test_filter(900,
        '^a^ebar',
        '^a^ebar',
);

test_filter(900,
        '^afoo^ebar',
        '^afoo : ^ebar',
);

test_filter(901,
        '^afoo^ebar',
        '^abaz^ebar',
);
1	dpavlin	286	#!/usr/bin/perl -w
2
3	dpavlin	949	use strict;
4	dpavlin	1256	use lib 'lib';
5	dpavlin	286
6	dpavlin	949	use Test::More tests => 124;
7	dpavlin	506
8	dpavlin	286	BEGIN {
9	dpavlin	949	use_ok( 'WebPAC::Test' );
10	dpavlin	286	use_ok( 'WebPAC::Input::ISIS' );
11	dpavlin	290	use_ok( 'WebPAC::Input::MARC' );
12	dpavlin	796	use_ok( 'WebPAC::Input::Test' );
13	dpavlin	286	}
14
15	dpavlin	949	$LOG{no_progress_bar} = 1;
16	dpavlin	506
17	dpavlin	949	warn "# LOG = ",dump( %LOG );
18	dpavlin	286
19			my $module = 'WebPAC::Input::ISIS';
20	dpavlin	290	diag "testing with $module";
21	dpavlin	286
22	dpavlin	949	throws_ok { my $input = new WebPAC::Input( %LOG ) } qr/module/, "need module";
23			ok(my $input = new WebPAC::Input( module => $module, stats => 1, \%LOG ), "new $module");
24			ok(my $input_lm = new WebPAC::Input( module => $module, \%LOG ), "new $module");
25	dpavlin	286
26			throws_ok { $input->open( ) } qr/path/, "need path";
27
28			throws_ok { $input->open( path => '/dev/null', ) } qr/can't find database/ , "open";
29
30	dpavlin	761	my $store;
31
32	dpavlin	599	ok($input->open( path => "$abs_path/winisis/BIBL" ), "open winisis");
33	dpavlin	761	ok($input_lm->open(
34			path => "$abs_path/winisis/BIBL",
35			save_row => sub {
36			my $a = shift;
37			$store->{ $a->{id} } = $a->{row};
38			},
39			load_row => sub {
40			my $a = shift;
41			return defined($store->{ $a->{id} }) &&
42			$store->{ $a->{id} };
43			},
44			), "open winisis");
45	dpavlin	286
46	dpavlin	761	cmp_ok( keys %$store, '==', 5, 'have 5 rows');
47
48			foreach my $i ( 1 .. 5 ) {
49			ok(my $r = $store->{$i}, "row $i");
50			ok($r->{'000'}, "have 000");
51			isa_ok($r->{'000'}, 'ARRAY', "is ARRAY");
52			cmp_ok($r->{'000'}->[0], '==', $i, 'sane value');
53			}
54
55			diag "store = ",dump( $store ) if ($debug);
56
57	dpavlin	290	sub test_after_open($) {
58			my $input = shift;
59	dpavlin	286
60	dpavlin	290	cmp_ok($input->pos, '==', -1, "mfn");
61			ok(my $size = $input->size, "size");
62			return $size;
63			}
64	dpavlin	286
65	dpavlin	290	test_after_open($input);
66			my $size = test_after_open($input_lm);
67	dpavlin	286
68	dpavlin	290	sub test_fetch($$) {
69			my ($input, $size) = @_;
70	dpavlin	286
71	dpavlin	290	my @db;
72	dpavlin	286
73	dpavlin	290	foreach my $mfn ( 1 ... $size ) {
74			ok(my $rec = $input->fetch, "fetch $mfn");
75			cmp_ok($input->pos, '==', $mfn, "pos $mfn");
76			push @db, $rec;
77	dpavlin	774	ok(my $dump = $input->dump_ascii, "dump_ascii $mfn");
78	dpavlin	908	# XXX test count will help us keep this test in-line :-)
79			ok($rec->{leader}, "leader $mfn") if $rec->{leader};
80	dpavlin	771	diag $dump if ($debug);
81	dpavlin	290	}
82
83			return @db;
84	dpavlin	286	}
85
86	dpavlin	290	my @db1 = test_fetch($input, $size);
87			my @db2 = test_fetch($input_lm, $size);
88
89	dpavlin	286	is_deeply(\@db1, \@db2, "seek working");
90
91	dpavlin	290	sub test_start_limit($$$$) {
92			my ($input, $s,$l,$e) = @_;
93	dpavlin	286
94			diag "offset $s, limit: $l, expected: $e";
95
96	dpavlin	761	ok($s = $input->open( path => "$abs_path/winisis/BIBL", offset => $s, limit => $l, debug => $debug ), "open winisis");
97	dpavlin	1304	cmp_ok($s, '==', $size, "db size");
98	dpavlin	286	cmp_ok($input->size, '==', $e, "input->size = $e");
99			}
100
101	dpavlin	1307	test_start_limit($input, 1, 0, $size - 1);
102			test_start_limit($input, $size, 0, 0);
103	dpavlin	1304	test_start_limit($input, 3, $size, $size - 3);
104			test_start_limit($input, 1, $size, $size - 1);
105	dpavlin	286
106	dpavlin	909	ok(my $s = $input->stats, "$module stats");
107	dpavlin	794	diag "stats:\n$s" if ($debug);
108	dpavlin	506
109	dpavlin	290	$module = 'WebPAC::Input::MARC';
110			diag "testing with $module";
111
112	dpavlin	949	ok($input = new WebPAC::Input( module => $module, stats => 1, %LOG ), "new $module");
113	dpavlin	290
114	dpavlin	599	ok($input->open( path => "$abs_path/data/marc.iso" ), "open marc.iso");
115	dpavlin	290
116			test_after_open($input);
117
118			test_fetch($input, $input->size);
119
120	dpavlin	909	ok(my $s = $input->stats, "$module stats");
121
122			diag "stats:\n$s" if ($debug);
123	dpavlin	599	# test modify_record
124	dpavlin	796	$module = 'WebPAC::Input::Test';
125	dpavlin	949	ok($input = new WebPAC::Input( module => $module, %LOG ), "new $module");
126	dpavlin	599
127	dpavlin	796	$WebPAC::Input::Test::rec = {
128	dpavlin	797	'200' => [
129			{ 'a' => '[200 a]', 'b' => '[200 b]', 'c' => '[200 c]', 'f' => '[200 f] test : test' },
130			],
131	dpavlin	796	'900' => [
132	dpavlin	797	{ 'x' => 'foobar', },
133			],
134	dpavlin	796	};
135
136	dpavlin	797	$WebPAC::Input::Test::size = 42;
137	dpavlin	796
138	dpavlin	820	ok($input->open( path => "/fake/path", ), "open modify_isis (plain)");
139	dpavlin	797
140			cmp_ok($input->size, '==', 42, '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	dpavlin	820	path => "/another/fake/path",
148	dpavlin	599	modify_records => {
149			200 => {
150			'*' => { '^c' => '. ' },
151	dpavlin	794	'^f' => { ' : ' => ' / ' },
152	dpavlin	599	}
153			},
154	dpavlin	799	), "open (with modify_records)");
155	dpavlin	599
156	dpavlin	797	# seek
157			throws_ok { $input->seek } qr/without/, 'seek without position';
158			cmp_ok($input->seek(0), '==', -1, 'seek');
159	dpavlin	599
160	dpavlin	821	sub test_filter {
161	dpavlin	761
162	dpavlin	821	my $f = $WebPAC::Input::Test::filter_coderef;
163			ok(ref($f) eq 'CODE', 'filter_coderef');
164
165			my ($field, $from, $to) = @_;
166			cmp_ok( $f->( $from, $field, 1 ), 'eq', $to, "filter $field \|$from\| -> \|$to\|" );
167			}
168
169			test_filter(200,
170			'^afoo^cbar^fbing : bong',
171			'^afoo. bar^fbing / bong',
172	dpavlin	797	);
173	dpavlin	784
174	dpavlin	799	# modify_file
175
176			my $modify_file = "$abs_path/conf/modify/test.pl";
177
178			ok($input->open(
179	dpavlin	820	path => "/and/another/fake/path",
180	dpavlin	799	modify_file => $modify_file,
181			), "open (with modify_file $modify_file)");
182
183	dpavlin	800	diag "regexps = ", dump($input->modify_file_regexps( $modify_file )) if ($debug);
184	dpavlin	799
185			test_filter(200,
186			'^a foo ; bar = baz : zzz',
187	dpavlin	800	'^a foo^kbar^dbaz : zzz',
188	dpavlin	799	);
189
190	dpavlin	820	# empty subfield removal
191	dpavlin	821
192			ok($input->open(
193			path => "/another/fake/path",
194			modify_records => {
195			900 => {
196			'^a' => { '^e' => ' : ^e' },
197	dpavlin	823	},
198			901 => {
199			'^a' => { 'foo' => 'baz' },
200			},
201	dpavlin	821	},
202			), "open (with modify_records for empty subfields)");
203
204			test_filter(900,
205			'^a^ebar',
206			'^a^ebar',
207	dpavlin	820	);
208	dpavlin	821
209			test_filter(900,
210			'^afoo^ebar',
211			'^afoo : ^ebar',
212			);
213	dpavlin	823
214			test_filter(901,
215			'^afoo^ebar',
216			'^abaz^ebar',
217			);