trunk/t/2-parse.t

#!/usr/bin/perl -w

use strict;
use blib;

use Test::More tests => 55;

use YAML qw/LoadFile/;

BEGIN {
use_ok( 'WebPAC::Test' );
use_ok( 'WebPAC::Parser' );
use_ok( 'WebPAC::Config' );
}

my $config_path = "$abs_path/conf/test.yml";

ok(-e $config_path, "$config_path exists");

throws_ok { new WebPAC::Parser( %LOG ) } qr/WebPAC::Config/, "new without config";

ok(
        my $parser = new WebPAC::Parser(
                config => new WebPAC::Config( path => $config_path ),
                base_path => $abs_path,
                %LOG
), "new");

my $inputs = {
        foo => [ qw/foo-input1 foo-input2/ ],
        bar => [ qw/bar-input/ ],
        baz => [ qw/baz-input/ ],
};

foreach my $db (keys %$inputs) {
        ok($parser->valid_database($db), "database $db");
        ok($inputs->{$db}, "has known inputs");
        diag "valid inputs = ", dump($inputs->{$db});
        foreach my $i (@{ $inputs->{$db} }) {
                ok($parser->valid_database_input($db,$i), "input $i");
        }
}
ok(! $parser->valid_database('non-existant'), "no database");
ok(! $parser->valid_database_input('foo','non-existant'), "no database input");

ok(my $l = $parser->{_lookup_create_key}, "_lookup_create_key");
ok($parser->{_lookup_create}, "_lookup_create");
diag "_lookup_create_key = ",dump($l) if ($debug);
foreach my $db (keys %$l) {
        foreach my $i (keys %{$l->{$db}}) {
                ok(defined($parser->lookup_create_rules($db,$i)), "lookup_create_rules($db/$i)");
                my @keys = sort keys %{$l->{$db}->{$i}};
                ok(@keys, 'have keys');
                my @have_keys = sort $parser->have_lookup_create($db,$i);
                ok(@have_keys, 'have_lookup_create');
                ok(eq_array(\@have_keys, \@keys), "found all lookups");
        }
}

ok(my $n = $parser->{_normalize_source}, "_normalize_source");
diag "_normalize_source = ",dump($n) if ($debug);
foreach my $db (keys %$n) {
        foreach my $i (keys %{$n->{$db}}) {
                ok(my $r = $parser->normalize_rules($db,$i), "normalize_source($db/$i)");
                diag "normalize_rules($db,$i) = $r" if ($debug);
                cmp_ok($n->{$db}->{$i}, 'eq', $r, "same");
        }
}

ok(my $d = $parser->{depends}, "depends");
diag "depends = ",dump($d) if ($debug);

my $expected_depend = {
   foo => {
            "foo-input1" => {
                              bar => { "bar-input" => { "210-a-210-e" => 1, "220-a-220-e" => 1, "230-a-230-e" => 1 } },
                              baz => { "baz-input" => { "200-a" => 1 } },
                              foo => { "foo-input1" => { 11 => 1 }, "foo-input2" => { 11 => 1 } },
                            },
            "foo-input2" => {
                              bar => { "bar-input" => { "900-x" => 1 } },
                              baz => { "baz-input" => { "900-x" => 1 } },
                              foo => { "foo-input1" => { "245-a" => 1 }, "foo-input2" => { "245-a" => 1 } },
                            },
          },
   bar => {
            "bar-input" => {
                  baz => { "baz-input" => { "900-x" => 1 } },
                  foo => { "foo-input1" => { "245-a" => 1 } },
                },
          },
   baz => {
            "baz-input" => {
                  bar => { "bar-input" => { "900-x" => 1 } },
                  foo => { "foo-input2" => { "245-a" => 1 } },
                },
          },
};


is_deeply($d, $expected_depend, "depends correct");

foreach my $db (keys %$d) {
        foreach my $i (keys %{$d->{$db}}) {
                is_deeply($d->{$db}->{$i}, $parser->depends($db,$i), "depend $db/$i");
        }
}

$config_path = "$abs_path/conf/marc.yml";

ok(-e $config_path, "$config_path exists");

ok(
        my $parser = new WebPAC::Parser(
                config => new WebPAC::Config( path => $config_path ),
                base_path => $abs_path,
                %LOG,
), "new");

ok(my $marc = $parser->have_rules('marc', 'marc', 'marc-input'), 'have_rules(marc,...)');

diag "marc: ",dump($marc) if ($debug);

is_deeply($marc, {
        marc                                            => 1,
        marc_compose                            => 1,
        marc_duplicate                          => 1,
        marc_indicators                         => 1,
        marc_leader                                     => 1,
        marc_original_order                     => 1,
        marc_remove                                     => 1,
        marc_repeatable_subfield        => 1,
}, 'catched all marc_*');

1	dpavlin	686	#!/usr/bin/perl -w
2
3			use strict;
4			use blib;
5
6	dpavlin	949	use Test::More tests => 55;
7
8	dpavlin	686	use YAML qw/LoadFile/;
9
10			BEGIN {
11	dpavlin	949	use_ok( 'WebPAC::Test' );
12	dpavlin	686	use_ok( 'WebPAC::Parser' );
13			use_ok( 'WebPAC::Config' );
14			}
15
16			my $config_path = "$abs_path/conf/test.yml";
17
18			ok(-e $config_path, "$config_path exists");
19
20	dpavlin	949	throws_ok { new WebPAC::Parser( %LOG ) } qr/WebPAC::Config/, "new without config";
21	dpavlin	686
22			ok(
23			my $parser = new WebPAC::Parser(
24			config => new WebPAC::Config( path => $config_path ),
25			base_path => $abs_path,
26	dpavlin	949	%LOG
27	dpavlin	686	), "new");
28
29	dpavlin	689	my $inputs = {
30			foo => [ qw/foo-input1 foo-input2/ ],
31			bar => [ qw/bar-input/ ],
32			baz => [ qw/baz-input/ ],
33			};
34
35	dpavlin	692	foreach my $db (keys %$inputs) {
36	dpavlin	689	ok($parser->valid_database($db), "database $db");
37			ok($inputs->{$db}, "has known inputs");
38			diag "valid inputs = ", dump($inputs->{$db});
39			foreach my $i (@{ $inputs->{$db} }) {
40			ok($parser->valid_database_input($db,$i), "input $i");
41			}
42			}
43			ok(! $parser->valid_database('non-existant'), "no database");
44	dpavlin	691	ok(! $parser->valid_database_input('foo','non-existant'), "no database input");
45	dpavlin	689
46	dpavlin	706	ok(my $l = $parser->{_lookup_create_key}, "_lookup_create_key");
47			ok($parser->{_lookup_create}, "_lookup_create");
48			diag "_lookup_create_key = ",dump($l) if ($debug);
49	dpavlin	705	foreach my $db (keys %$l) {
50			foreach my $i (keys %{$l->{$db}}) {
51	dpavlin	717	ok(defined($parser->lookup_create_rules($db,$i)), "lookup_create_rules($db/$i)");
52	dpavlin	706	my @keys = sort keys %{$l->{$db}->{$i}};
53			ok(@keys, 'have keys');
54			my @have_keys = sort $parser->have_lookup_create($db,$i);
55			ok(@have_keys, 'have_lookup_create');
56			ok(eq_array(\@have_keys, \@keys), "found all lookups");
57	dpavlin	705	}
58			}
59	dpavlin	686
60	dpavlin	692	ok(my $n = $parser->{_normalize_source}, "_normalize_source");
61	dpavlin	705	diag "_normalize_source = ",dump($n) if ($debug);
62	dpavlin	717	foreach my $db (keys %$n) {
63			foreach my $i (keys %{$n->{$db}}) {
64			ok(my $r = $parser->normalize_rules($db,$i), "normalize_source($db/$i)");
65	dpavlin	719	diag "normalize_rules($db,$i) = $r" if ($debug);
66	dpavlin	717	cmp_ok($n->{$db}->{$i}, 'eq', $r, "same");
67			}
68			}
69	dpavlin	692
70	dpavlin	698	ok(my $d = $parser->{depends}, "depends");
71	dpavlin	705	diag "depends = ",dump($d) if ($debug);
72	dpavlin	698
73			my $expected_depend = {
74			foo => {
75			"foo-input1" => {
76	dpavlin	704	bar => { "bar-input" => { "210-a-210-e" => 1, "220-a-220-e" => 1, "230-a-230-e" => 1 } },
77	dpavlin	703	baz => { "baz-input" => { "200-a" => 1 } },
78			foo => { "foo-input1" => { 11 => 1 }, "foo-input2" => { 11 => 1 } },
79	dpavlin	698	},
80			"foo-input2" => {
81	dpavlin	703	bar => { "bar-input" => { "900-x" => 1 } },
82			baz => { "baz-input" => { "900-x" => 1 } },
83			foo => { "foo-input1" => { "245-a" => 1 }, "foo-input2" => { "245-a" => 1 } },
84	dpavlin	698	},
85			},
86	dpavlin	701	bar => {
87			"bar-input" => {
88	dpavlin	703	baz => { "baz-input" => { "900-x" => 1 } },
89			foo => { "foo-input1" => { "245-a" => 1 } },
90	dpavlin	701	},
91			},
92			baz => {
93			"baz-input" => {
94	dpavlin	703	bar => { "bar-input" => { "900-x" => 1 } },
95			foo => { "foo-input2" => { "245-a" => 1 } },
96	dpavlin	701	},
97			},
98	dpavlin	698	};
99
100
101			is_deeply($d, $expected_depend, "depends correct");
102
103			foreach my $db (keys %$d) {
104			foreach my $i (keys %{$d->{$db}}) {
105			is_deeply($d->{$db}->{$i}, $parser->depends($db,$i), "depend $db/$i");
106			}
107			}
108	dpavlin	705
109	dpavlin	737	$config_path = "$abs_path/conf/marc.yml";
110
111			ok(-e $config_path, "$config_path exists");
112
113			ok(
114			my $parser = new WebPAC::Parser(
115			config => new WebPAC::Config( path => $config_path ),
116			base_path => $abs_path,
117	dpavlin	949	%LOG,
118	dpavlin	737	), "new");
119
120	dpavlin	755	ok(my $marc = $parser->have_rules('marc', 'marc', 'marc-input'), 'have_rules(marc,...)');
121	dpavlin	737
122			diag "marc: ",dump($marc) if ($debug);
123
124			is_deeply($marc, {
125			marc => 1,
126			marc_compose => 1,
127			marc_duplicate => 1,
128			marc_indicators => 1,
129			marc_leader => 1,
130			marc_original_order => 1,
131			marc_remove => 1,
132			marc_repeatable_subfield => 1,
133			}, 'catched all marc_*');
134