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

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

$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::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(my $rec_p = $input->fetch, 'fetch');

# modify_records

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

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');

diag dump($input);

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

$input->{modify_record} = {
        900 => {
                '*' => {
                        ' ; ' => 'a',
                }
        }
};

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