r1747@llin: dpavlin | 2008-10-26 16:55:31 +0100

 bug fix: don't destroy subfields values in data hash

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

diff --git a/lib/WebPAC/Normalize.pm b/lib/WebPAC/Normalize.pm
index 45e3e64..17e1832 100644 (file)
--- a/lib/WebPAC/Normalize.pm
+++ b/lib/WebPAC/Normalize.pm
@@ -47,6 +47,8 @@ push @EXPORT, ( qw/
        marc_template
 /);
 
+use Storable qw/dclone/;
+
 =head1 NAME
 
 WebPAC::Normalize - describe normalisaton rules using sets
@@ -364,10 +366,12 @@ sub _pack_subfields_hash {
 
        warn "## _pack_subfields_hash( ",dump(@_), " )\n" if ($debug > 1);
 
-       my ($h,$include_subfields) = @_;
+       my ($hash,$include_subfields) = @_;
 
        # sanity and ease of use
-       return $h if (ref($h) ne 'HASH');
+       return $hash if (ref($hash) ne 'HASH');
+
+       my $h = dclone( $hash );
 
        if ( defined($h->{subfields}) ) {
                my $sfs = delete $h->{subfields} || die "no subfields?";

diff --git a/t/3-normalize.t b/t/3-normalize.t
index 5c59052..603f170 100755 (executable)
--- a/t/3-normalize.t
+++ b/t/3-normalize.t
@@ -3,7 +3,7 @@
 use strict;
 use blib;
 
-use Test::More tests => 344;
+use Test::More tests => 348;
 
 BEGIN {
        use_ok( 'WebPAC::Test' );
@@ -896,5 +896,11 @@ sub test_s {
        test_rule( 'rec(200,i1)', $rec, qq{ rec(200,'i1') }, [ '0' ] );
        test_rule( 'rec(200,i2)', $rec, qq{ rec(200,'i2') }, [ '1' ] );
 
+       my $hash = { a => '[a]', 'b' => '[b]', subfields => [ 'a', 0, 'b', 0 ] };
+       is_deeply([ _pack_subfields_hash( $hash ) ], [ '[a]', '[b]' ], '_pack_subfields_hash' );
+       ok( $hash->{subfields}, 'subfields exist' );
+       cmp_ok( _pack_subfields_hash( $hash, 1 ), 'eq', '^a[a]^b[b]', '_pack_subfields_hash' );
+       ok( $hash->{subfields}, 'subfields exist' );
+
 }