trunk/t/2-input.t

#!/usr/bin/perl -w

use Test::More tests => 123;
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#/[^/]*$#/#;      #vim

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

throws_ok { my $input = new WebPAC::Input( no_log => $no_log ) } 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");
                # 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, '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");

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