r1505@llin: dpavlin | 2007-11-04 12:12:20 +0100

 renamed _set_rec to _set_ds (because it's a data_structure actually)
 and added symetric public get_ds to get whole data_structure as
 hash to manually traverse in normalization

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

diff --git a/lib/WebPAC/Normalize.pm b/lib/WebPAC/Normalize.pm
index 6569fc1..63a4d7c 100644 (file)
--- a/lib/WebPAC/Normalize.pm
+++ b/lib/WebPAC/Normalize.pm
@@ -1,7 +1,8 @@
 package WebPAC::Normalize;
 use Exporter 'import';
 our @EXPORT = qw/
 package WebPAC::Normalize;
 use Exporter 'import';
 our @EXPORT = qw/

-       _set_rec _set_lookup
+       _set_ds _set_lookup
+       get_ds

        _set_load_row
        _get_ds _clean_ds
        _debug
        _set_load_row
        _get_ds _clean_ds
        _debug


@@ -47,7 +48,7 @@ WebPAC::Normalize - describe normalisaton rules using sets
 
 =cut
 
 
 =cut
 

-our $VERSION = '0.31';
+our $VERSION = '0.32';

 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 


@@ -107,7 +108,7 @@ sub data_structure {
 
        no strict 'subs';
        _set_lookup( $arg->{lookup} ) if defined($arg->{lookup});
 
        no strict 'subs';
        _set_lookup( $arg->{lookup} ) if defined($arg->{lookup});

-       _set_rec( $arg->{row} );
+       _set_ds( $arg->{row} );

        _set_config( $arg->{config} ) if defined($arg->{config});
        _clean_ds( %{ $arg } );
        $load_row_coderef = $arg->{load_row_coderef};
        _set_config( $arg->{config} ) if defined($arg->{config});
        _clean_ds( %{ $arg } );
        $load_row_coderef = $arg->{load_row_coderef};


@@ -118,20 +119,32 @@ sub data_structure {
        return _get_ds();
 }
 
        return _get_ds();
 }
 

-=head2 _set_rec
+=head2 _set_ds

 
 Set current record hash
 
 
 Set current record hash
 

-  _set_rec( $rec );
+  _set_ds( $rec );

 
 =cut
 
 my $rec;
 
 
 =cut
 
 my $rec;
 

-sub _set_rec {
+sub _set_ds {

        $rec = shift or die "no record hash";
 }
 
        $rec = shift or die "no record hash";
 }
 

+=head2 get_ds
+
+Access to original record from input module
+
+  my $ds = get_rec;
+
+=cut
+
+sub get_ds {
+       return $rec;
+}
+

 =head2 _set_config
 
 Set current config hash
 =head2 _set_config
 
 Set current config hash

diff --git a/t/3-normalize.t b/t/3-normalize.t
index 10806cd..152be5b 100755 (executable)
--- a/t/3-normalize.t
+++ b/t/3-normalize.t
@@ -3,7 +3,7 @@
 use strict;
 use blib;
 
 use strict;
 use blib;
 

-use Test::More tests => 351;
+use Test::More tests => 352;

 
 BEGIN {
        use_ok( 'WebPAC::Test' );
 
 BEGIN {
        use_ok( 'WebPAC::Test' );


@@ -162,7 +162,9 @@ sub test_s {
 
        ok(! _set_lookup( undef ), "set_lookup(undef)");
 
 
        ok(! _set_lookup( undef ), "set_lookup(undef)");
 

-       _set_rec( $rec1 );
+       _set_ds( $rec1 );
+
+       is_deeply( get_ds, $rec1, 'get_ds' );

 
        cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2', 'join rec2' );
        cmp_ok( join(",", rec2('200','a'), rec2('200','b') ), 'eq', '200a,200a*2,200b', 'join rec2 rec2' );
 
        cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2', 'join rec2' );
        cmp_ok( join(",", rec2('200','a'), rec2('200','b') ), 'eq', '200a,200a*2,200b', 'join rec2 rec2' );


@@ -358,7 +360,7 @@ sub test_s {
 
        #ok(! lookup('non-existent'), 'lookup non-existant' );
 
 
        #ok(! lookup('non-existent'), 'lookup non-existant' );
 

-       _set_rec( $rec2 );
+       _set_ds( $rec2 );

 
        test_s(qq{
                search_display('Title',
 
        test_s(qq{
                search_display('Title',


@@ -445,7 +447,7 @@ sub test_s {
        my $rules = qq{ search('mixed', rec('200') ) };
        
        _clean_ds();
        my $rules = qq{ search('mixed', rec('200') ) };
        
        _clean_ds();

-       _set_rec( $rec );
+       _set_ds( $rec );

        test_s( $rules );
        ok($ds = _get_ds(), "get_ds");
        is_deeply( $ds, {
        test_s( $rules );
        ok($ds = _get_ds(), "get_ds");
        is_deeply( $ds, {


@@ -462,7 +464,7 @@ sub test_s {
 
        # wird and non-valid structure which is supported anyway
        _clean_ds();
 
        # wird and non-valid structure which is supported anyway
        _clean_ds();

-       _set_rec({
+       _set_ds({

                '200' => [{
                        'a' => '200a',
                },
                '200' => [{
                        'a' => '200a',
                },


@@ -512,7 +514,7 @@ sub test_s {
                my ($msg, $rec, $rules, $struct) = @_;
 
                _clean_ds();
                my ($msg, $rec, $rules, $struct) = @_;
 
                _clean_ds();

-               _set_rec($rec);
+               _set_ds($rec);

 
                foreach my $r (split(/;/, $rules)) {
                        $r =~ s/[\s\n\r]+/ /gs;
 
                foreach my $r (split(/;/, $rules)) {
                        $r =~ s/[\s\n\r]+/ /gs;


@@ -621,7 +623,7 @@ sub test_s {
        sub test_rule {
                my ($msg, $rec, $rule, $struct) = @_;
                _clean_ds();
        sub test_rule {
                my ($msg, $rec, $rule, $struct) = @_;
                _clean_ds();

-               _set_rec( $rec );
+               _set_ds( $rec );

                $rule =~ s/\\/\\/gs;
                my $r = test_s( $rule );
                diag "for ", dump($rec), " got:\n", dump($r), "\nexpect:\n" if ($debug > 1);
                $rule =~ s/\\/\\/gs;
                my $r = test_s( $rule );
                diag "for ", dump($rec), " got:\n", dump($r), "\nexpect:\n" if ($debug > 1);