/[webpac2]/trunk/t/3-normalize-xml.t
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/t/3-normalize-xml.t

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 70 by dpavlin, Sat Nov 19 23:48:24 2005 UTC revision 315 by dpavlin, Fri Dec 23 21:17:37 2005 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl -w  #!/usr/bin/perl -w
2    
3  use Test::More tests => 74;  use Test::More tests => 76;
4  use Test::Exception;  use Test::Exception;
5  use Cwd qw/abs_path/;  use Cwd qw/abs_path/;
6  use blib;  use blib;
# Line 18  diag "abs_path: $abs_path"; Line 18  diag "abs_path: $abs_path";
18  throws_ok { new WebPAC::Normalize::XML( lookup_regex => 'foo' ) } qr/pair/, "lookup_regex without lookup";  throws_ok { new WebPAC::Normalize::XML( lookup_regex => 'foo' ) } qr/pair/, "lookup_regex without lookup";
19  throws_ok { new WebPAC::Normalize::XML( lookup => 'bar' ) } qr/pair/, "lookup without lookup_regex";  throws_ok { new WebPAC::Normalize::XML( lookup => 'bar' ) } qr/pair/, "lookup without lookup_regex";
20    
21  ok(my $n = new WebPAC::Normalize::XML( debug => 0 ), "new");  ok(my $n = new WebPAC::Normalize::XML(
22            debug => 1,
23            filter => {
24                    regex => sub {
25                            my ($val, $regex) = @_;
26                            eval "\$val =~ $regex";
27                            return $val;
28                    },
29            },
30    ), "new");
31    
32  throws_ok { $n->open() } qr/tag/, "open without tag";  throws_ok { $n->open() } qr/tag/, "open without tag";
33  throws_ok { $n->open( tag => 'isis' ) } qr/xml_file/, "open without xml_file";  throws_ok { $n->open( tag => 'isis' ) } qr/xml_file/, "open without xml_file";
# Line 131  foreach my $fld (keys %$rec) { Line 140  foreach my $fld (keys %$rec) {
140    
141  ok(my $ds = $n->data_structure( $rec ), "data_structure");  ok(my $ds = $n->data_structure( $rec ), "data_structure");
142    
143  diag Dumper($rec, $ds);  #diag Dumper($rec, $ds);
144    
145    # fake load of our test normalisation data
146    $n->{tag} = 'isis';
147    
148    #diag Dumper($n->{import_xml}->{indexer});
149    
150    
151    $rec = {
152            '900' => [ {
153                    'a' => '1',
154                    'b' => '2',
155                    'c' => '3',
156                    'txt' => 'yap',
157            } ],
158    };
159    
160    my $import = {
161            'Tag' => { 'isis' => [
162                            { content => 'v900^a + v900^b = v900^c [txt]' },
163            ] },
164    };
165    
166    sub parse_test($$$) {
167            my ($import,$rec,$r) = @_;
168            $n->{import_xml}->{indexer} = $import;
169            # erase internal cache (yak!)
170            delete($n->{tags_by_order});
171            push @{$rec->{'000'}}, 42 unless ($rec->{'000'});
172            diag "test normalisation of: ",Dumper($n->{import_xml}->{indexer}, $rec);
173            ok(my $ds = $n->data_structure( $rec ), "data_structure");
174            diag Dumper($ds);
175            cmp_ok($ds->{Tag}->{display}->[0], 'eq', $r, "parse $r");
176    }
177    
178    parse_test($import, $rec, '1 + 2 = 3 [yap]');
179    
180    delete($rec->{'900'}->[0]->{'b'});
181    parse_test($import, $rec, '1 = 3 [yap]');
182    
183    $rec->{'900'}->[0]->{'b'} = 5;
184    $rec->{'900'}->[0]->{'c'} = 6;
185    parse_test($import, $rec, '1 + 5 = 6 [yap]');
186    
187    delete($rec->{'900'}->[0]->{'c'});
188    parse_test($import, $rec, '1 + 5');
189    
190    $rec->{'900'}->[0]->{'txt'} = 'nope!';
191    delete($rec->{'900'}->[0]->{'a'});
192    parse_test($import, $rec, '5 [nope!]');
193    
Legend:
Removed from v.70  
changed lines
  Added in v.315
  ViewVC Help
Powered by ViewVC 1.1.26