trunk/t/2-input.t

#!/usr/bin/perl -w

use strict;
use blib;

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 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, "$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	#!/usr/bin/perl -w
2
3	use strict;
4	use blib;
5
6	use Test::More tests => 124;
7
8	BEGIN {
9	use_ok( 'WebPAC::Test' );
10	use_ok( 'WebPAC::Input::ISIS' );
11	use_ok( 'WebPAC::Input::MARC' );
12	use_ok( 'WebPAC::Input::Test' );
13	}
14
15	$LOG{no_progress_bar} = 1;
16
17	warn "# LOG = ",dump( %LOG );
18
19	my $module = 'WebPAC::Input::ISIS';
20	diag "testing with $module";
21
22	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
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	my $store;
31
32	ok($input->open( path => "$abs_path/winisis/BIBL" ), "open winisis");
33	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
46	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	sub test_after_open($) {
58	my $input = shift;
59
60	cmp_ok($input->pos, '==', -1, "mfn");
61	ok(my $size = $input->size, "size");
62	return $size;
63	}
64
65	test_after_open($input);
66	my $size = test_after_open($input_lm);
67
68	sub test_fetch($$) {
69	my ($input, $size) = @_;
70
71	my @db;
72
73	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	ok(my $dump = $input->dump_ascii, "dump_ascii $mfn");
78	# XXX test count will help us keep this test in-line :-)
79	ok($rec->{leader}, "leader $mfn") if $rec->{leader};
80	diag $dump if ($debug);
81	}
82
83	return @db;
84	}
85
86	my @db1 = test_fetch($input, $size);
87	my @db2 = test_fetch($input_lm, $size);
88
89	is_deeply(\@db1, \@db2, "seek working");
90
91	sub test_start_limit($$$$) {
92	my ($input, $s,$l,$e) = @_;
93
94	diag "offset $s, limit: $l, expected: $e";
95
96	ok($s = $input->open( path => "$abs_path/winisis/BIBL", offset => $s, limit => $l, debug => $debug ), "open winisis");
97	cmp_ok($s, '==', $size, "db size from open = $size");
98	cmp_ok($input->size, '==', $e, "input->size = $e");
99	}
100
101	test_start_limit($input, 1, 3, 3);
102	test_start_limit($input, $size, 3, 0);
103	test_start_limit($input, 3, $size, $size - 2);
104	test_start_limit($input, 1, $size + 2, $size);
105
106	ok(my $s = $input->stats, "$module stats");
107	diag "stats:\n$s" if ($debug);
108
109	$module = 'WebPAC::Input::MARC';
110	diag "testing with $module";
111
112	ok($input = new WebPAC::Input( module => $module, stats => 1, %LOG ), "new $module");
113
114	ok($input->open( path => "$abs_path/data/marc.iso" ), "open marc.iso");
115
116	test_after_open($input);
117
118	test_fetch($input, $input->size);
119
120	ok(my $s = $input->stats, "$module stats");
121
122	diag "stats:\n$s" if ($debug);
123	# test modify_record
124	$module = 'WebPAC::Input::Test';
125	ok($input = new WebPAC::Input( module => $module, %LOG ), "new $module");
126
127	$WebPAC::Input::Test::rec = {
128	'200' => [
129	{ 'a' => '[200 a]', 'b' => '[200 b]', 'c' => '[200 c]', 'f' => '[200 f] test : test' },
130	],
131	'900' => [
132	{ 'x' => 'foobar', },
133	],
134	};
135
136	$WebPAC::Input::Test::size = 42;
137
138	ok($input->open( path => "/fake/path", ), "open modify_isis (plain)");
139
140	cmp_ok($input->size, '==', 42, 'size');
141
142	ok(my $rec_p = $input->fetch, 'fetch');
143
144	# modify_records
145
146	ok($input->open(
147	path => "/another/fake/path",
148	modify_records => {
149	200 => {
150	'*' => { '^c' => '. ' },
151	'^f' => { ' : ' => ' / ' },
152	}
153	},
154	), "open (with modify_records)");
155
156	# seek
157	throws_ok { $input->seek } qr/without/, 'seek without position';
158	cmp_ok($input->seek(0), '==', -1, 'seek');
159
160	sub test_filter {
161
162	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	);
173
174	# modify_file
175
176	my $modify_file = "$abs_path/conf/modify/test.pl";
177
178	ok($input->open(
179	path => "/and/another/fake/path",
180	modify_file => $modify_file,
181	), "open (with modify_file $modify_file)");
182
183	diag "regexps = ", dump($input->modify_file_regexps( $modify_file )) if ($debug);
184
185	test_filter(200,
186	'^a foo ; bar = baz : zzz',
187	'^a foo^kbar^dbaz : zzz',
188	);
189
190	# empty subfield removal
191
192	ok($input->open(
193	path => "/another/fake/path",
194	modify_records => {
195	900 => {
196	'^a' => { '^e' => ' : ^e' },
197	},
198	901 => {
199	'^a' => { 'foo' => 'baz' },
200	},
201	},
202	), "open (with modify_records for empty subfields)");
203
204	test_filter(900,
205	'^a^ebar',
206	'^a^ebar',
207	);
208
209	test_filter(900,
210	'^afoo^ebar',
211	'^afoo : ^ebar',
212	);
213
214	test_filter(901,
215	'^afoo^ebar',
216	'^abaz^ebar',
217	);