trunk/t/1-lookup.t

#!/usr/bin/perl -w

use strict;
use Test::More tests => 18;
use Test::Exception;
use blib;

use Data::Dumper;

BEGIN {
use_ok( 'WebPAC::Lookup' );
}

my $debug = shift @ARGV;

throws_ok { new WebPAC::Lookup( no_log => 1 ) } qr/lookup_file/, "new without lookup_file";

ok(my $lookup = new WebPAC::Lookup(
        lookup_file => 'conf/lookup/example.pm',
        filter => {
                'upper' => sub { return uc(shift); },
        },
), "new");

ok(my $regex = $lookup->regex, "regex");
diag "regex: $regex";

my $rec = {
        '000' => [ '001' ],
        '800' => [ 'foo' ],
        '900' => [ 'bar' ],
};

diag "testing WebPAC::Lookup own methods";

ok($lookup->add( $rec ), "add");

ok(my $l1 = $lookup->{_lookup_data}, "{_lookup_data}");
diag "lookup->{_lookup_data} = ",Dumper($lookup->{_lookup_data}) if ($debug);
ok(my $l2 = $lookup->lookup_hash, "lookup_hash");
diag "lookup->lookup_hash = ",Dumper($lookup->lookup_hash) if ($debug);

is_deeply( $l1, $l2, 'lookups same');

my $lookup_res = { 
        '800:foo' => [ 'bar' ],
        '000:001' => [ '001' ],
        '900:bar' => [ 'FOO', 'foo' ]
};

is_deeply($lookup_res, $lookup->{'_lookup_data'}, "lookup data");

foreach my $k (keys %{ $lookup_res }) {
        ok(my @l = $lookup->lookup("lookup{$k}"), "lookup{$k}");

        cmp_ok($#l, '==', $#{$lookup_res->{$k}}, "result size");

        is_deeply($lookup_res->{$k}, \@l, "result values");
}

diag "testing WebPAC::Lookup inherited methods";
1	#!/usr/bin/perl -w
2
3	use strict;
4	use Test::More tests => 18;
5	use Test::Exception;
6	use blib;
7
8	use Data::Dumper;
9
10	BEGIN {
11	use_ok( 'WebPAC::Lookup' );
12	}
13
14	my $debug = shift @ARGV;
15
16	throws_ok { new WebPAC::Lookup( no_log => 1 ) } qr/lookup_file/, "new without lookup_file";
17
18	ok(my $lookup = new WebPAC::Lookup(
19	lookup_file => 'conf/lookup/example.pm',
20	filter => {
21	'upper' => sub { return uc(shift); },
22	},
23	), "new");
24
25	ok(my $regex = $lookup->regex, "regex");
26	diag "regex: $regex";
27
28	my $rec = {
29	'000' => [ '001' ],
30	'800' => [ 'foo' ],
31	'900' => [ 'bar' ],
32	};
33
34	diag "testing WebPAC::Lookup own methods";
35
36	ok($lookup->add( $rec ), "add");
37
38	ok(my $l1 = $lookup->{_lookup_data}, "{_lookup_data}");
39	diag "lookup->{_lookup_data} = ",Dumper($lookup->{_lookup_data}) if ($debug);
40	ok(my $l2 = $lookup->lookup_hash, "lookup_hash");
41	diag "lookup->lookup_hash = ",Dumper($lookup->lookup_hash) if ($debug);
42
43	is_deeply( $l1, $l2, 'lookups same');
44
45	my $lookup_res = {
46	'800:foo' => [ 'bar' ],
47	'000:001' => [ '001' ],
48	'900:bar' => [ 'FOO', 'foo' ]
49	};
50
51	is_deeply($lookup_res, $lookup->{'_lookup_data'}, "lookup data");
52
53	foreach my $k (keys %{ $lookup_res }) {
54	ok(my @l = $lookup->lookup("lookup{$k}"), "lookup{$k}");
55
56	cmp_ok($#l, '==', $#{$lookup_res->{$k}}, "result size");
57
58	is_deeply($lookup_res->{$k}, \@l, "result values");
59	}
60
61	diag "testing WebPAC::Lookup inherited methods";