refactored _pack_subfields_hash in separate function

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

diff --git a/lib/WebPAC/Normalize.pm b/lib/WebPAC/Normalize.pm
index 7f4939f..0996d54 100644 (file)
--- a/lib/WebPAC/Normalize.pm
+++ b/lib/WebPAC/Normalize.pm
@@ -4,6 +4,7 @@ use Exporter 'import';
        _set_rec _set_lookup
        _get_ds _clean_ds
        _debug
+       _pack_subfields_hash
 
        tag search display
        marc marc_indicators marc_repeatable_subfield
@@ -722,6 +723,41 @@ sub marc_original_order {
 This function should be used inside functions to create C<data_structure> described
 above.
 
+=head2 _pack_subfields_hash
+
+ @values = _pack_subfields_hash( $h, $include_subfields )
+
+=cut
+
+sub _pack_subfields_hash {
+
+       warn "## _pack_subfields_hash( ",dump(@_), " )\n";
+
+       my ($h,$include_subfields) = @_;
+
+
+       if ( defined($h->{subfields}) ) {
+               my $sfs = delete $h->{subfields} || die "no subfields?";
+               my @out;
+               while (@$sfs) {
+                       my $sf = shift @$sfs;
+                       push @out, '^' . $sf if ($include_subfields);
+                       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};
+       }
+}
+
 =head2 rec1
 
 Return all values in some field
@@ -738,32 +774,16 @@ sub rec1 {
        return unless (defined($rec) && defined($rec->{$f}));
        warn "rec1($f) = ", dump( $rec->{$f} ), $/ if ($debug > 1);
        if (ref($rec->{$f}) eq 'ARRAY') {
-               return map { 
-                       if (ref($_) eq 'HASH') {
-                               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};
-                               }
+               my @out;
+               foreach my $h ( @{ $rec->{$f} } ) {
+                       if (ref($h) eq 'HASH') {
+warn "rec1 hash: ",dump($h),"\n";
+                               push @out, ( _pack_subfields_hash( $h ) );
                        } else {
-                               $_;
+                               push @out, $h;
                        }
-               } @{ $rec->{$f} };
+               }
+               return @out;
        } elsif( defined($rec->{$f}) ) {
                return $rec->{$f};
        }

diff --git a/t/3-normalize.t b/t/3-normalize.t
index 30421d9..a576c73 100755 (executable)
--- a/t/3-normalize.t
+++ b/t/3-normalize.t
@@ -2,7 +2,7 @@
 
 use strict;
 
-use Test::More tests => 155;
+use Test::More tests => 157;
 use Test::Exception;
 use Cwd qw/abs_path/;
 use blib;
@@ -679,7 +679,25 @@ sub test_s {
                qq{
                        rec1(200);
                },
-               ["a1", "b1", "a2", "b2", "c1", "c2"],
+               ['a1', 'b1', 'a2', 'b2', 'c1', 'c2', 'a3', 'a4', 'b3', 'c3', 'a5' ],
+       );
+
+       is_deeply(
+               [ _pack_subfields_hash({
+                       a => [ 'a1', 'a2' ], b => [ 'b1', 'b2' ], c => [ 'c1', 'c2' ],
+                       subfields => [ qw/a 0 b 0 a 1 b 1 c 0 c 1/ ],
+               }) ],
+               ['a1', 'b1', 'a2', 'b2', 'c1', 'c2'],
+               '_pack_subfields_hash( $h )'
+       );
+
+       is_deeply(
+               [ _pack_subfields_hash({
+                       a => [ 'a1', 'a2' ], b => [ 'b1', 'b2' ], c => [ 'c1', 'c2' ],
+                       subfields => [ qw/a 0 b 0 a 1 b 1 c 0 c 1/ ],
+               }, 1) ],
+               ['^a','a1', '^b','b1', '^a','a2', '^b','b2', '^c','c1', '^c','c2'],
+               '_pack_subfields_hash( $h, 1 )'
        );
 }