r890@llin: dpavlin | 2006-09-06 16:24:27 +0200
authorDobrica Pavlinusic <dpavlin@rot13.org>
Wed, 6 Sep 2006 14:25:16 +0000 (14:25 +0000)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Wed, 6 Sep 2006 14:25:16 +0000 (14:25 +0000)
 rec1 now unrolls subfields in correct order (as in source file)

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@631 07558da8-63fa-0310-ba24-9fe276d99e06

lib/WebPAC/Normalize.pm
t/3-normalize.t

index b067555..7f4939f 100644 (file)
@@ -36,11 +36,11 @@ WebPAC::Normalize - describe normalisaton rules using sets
 
 =head1 VERSION
 
-Version 0.16
+Version 0.17
 
 =cut
 
-our $VERSION = '0.16';
+our $VERSION = '0.17';
 
 =head1 SYNOPSIS
 
@@ -740,7 +740,26 @@ sub rec1 {
        if (ref($rec->{$f}) eq 'ARRAY') {
                return map { 
                        if (ref($_) eq 'HASH') {
-                               values %{$_};
+                               my $h = $_;
+                               if ( defined($h->{subfields}) ) {
+                                       my $sfs = delete $h->{subfields} || die "no subfields?";
+                                       my @out;
+                                       while (@$sfs) {
+                                               my $sf = shift @$sfs;
+                                               my $o = shift @$sfs;
+                                               if ($o == 0 && ref( $h->{$sf} ) ne 'ARRAY' ) {
+                                                       # single element subfields are not arrays
+                                                       push @out, $h->{$sf};
+                                               } else {
+warn "====> $f $sf $o $#$sfs ", dump( $sfs ), "\n";
+                                                       push @out, $h->{$sf}->[$o];
+                                               }
+                                       }
+                                       return @out;
+                               } else {
+                                       # FIXME this should probably be in alphabetical order instead of hash order
+                                       values %{$h};
+                               }
                        } else {
                                $_;
                        }
index da741bb..30421d9 100755 (executable)
@@ -2,7 +2,7 @@
 
 use strict;
 
-use Test::More tests => 153;
+use Test::More tests => 155;
 use Test::Exception;
 use Cwd qw/abs_path/;
 use blib;
@@ -664,5 +664,22 @@ sub test_s {
                        [ '900', ' ', ' ', 'a', 'a3', 'a', 'a4', 'b', 'b3', 'c', 'c3', 'a', 'a5', ],
                ],
        );
+
+       test_rule(
+               'rec1 skips subfields',
+               {
+                       '200' => [ {
+                               a => [ 'a1', 'a2' ], b => [ 'b1', 'b2' ], c => [ 'c1', 'c2' ],
+                               subfields => [ qw/a 0 b 0 a 1 b 1 c 0 c 1/ ],
+                       }, {
+                               a => [ 'a3', 'a4', 'a5' ], b => 'b3', c => 'c3',
+                               subfields => [ qw/a 0 a 1 b 0 c 0 a 2/ ],
+                       } ],
+               },
+               qq{
+                       rec1(200);
+               },
+               ["a1", "b1", "a2", "b2", "c1", "c2"],
+       );
 }