r637@llin: dpavlin | 2006-05-14 14:38:22 +0200

 added data_structure (which does most of magic), support for semi-valid data structures

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

diff --git a/lib/WebPAC/Normalize/Set.pm b/lib/WebPAC/Normalize/Set.pm
index 70a5652..d23a2a5 100644 (file)
--- a/lib/WebPAC/Normalize/Set.pm
+++ b/lib/WebPAC/Normalize/Set.pm
@@ -21,11 +21,11 @@ WebPAC::Normalize::Set - describe normalisaton rules using sets
 
 =head1 VERSION
 
-Version 0.03
+Version 0.04
 
 =cut
 
-our $VERSION = '0.03';
+our $VERSION = '0.04';
 
 =head1 SYNOPSIS
 
@@ -42,6 +42,35 @@ types (on the left side of definition) are: C<tag>, C<display> and C<search>.
 
 =head1 FUNCTIONS
 
+=head2 data_structure
+
+Return data structure
+
+  my $ds = WebPAC::Normalize::Set(
+       lookup => $lookup->lookup_hash,
+       row => $row,
+       rules => $normalize_pl_config,
+  );
+
+This function will B<die> if normalizastion can't be evaled.
+
+=cut
+
+sub data_structure {
+       my $arg = {@_};
+
+       die "need row argument" unless ($arg->{row});
+       die "need normalisation argument" unless ($arg->{rules});
+
+       no strict 'subs';
+       set_lookup( $arg->{lookup} );
+       set_rec( $arg->{row} );
+       clean_ds();
+       eval "$arg->{rules}";
+       die "error evaling $arg->{rules}: $@\n" if ($@);
+       return get_ds();
+}
+
 =head2 set_rec
 
 Set current record hash
@@ -158,13 +187,15 @@ TODO: order of values is probably same as in source data, need to investigate th
 
 sub rec1 {
        my $f = shift;
-       return unless (defined($rec && $rec->{$f}));
+       return unless (defined($rec) && defined($rec->{$f}));
        if (ref($rec->{$f}) eq 'ARRAY') {
-               if (ref($rec->{$f}->[0]) eq 'HASH') {
-                       return map { values %{$_} } @{ $rec->{$f} };
-               } else {
-                       return @{ $rec->{$f} };
-               }
+               return map { 
+                       if (ref($_) eq 'HASH') {
+                               values %{$_};
+                       } else {
+                               $_;
+                       }
+               } @{ $rec->{$f} };
        } elsif( defined($rec->{$f}) ) {
                return $rec->{$f};
        }
@@ -182,7 +213,7 @@ sub rec2 {
        my $f = shift;
        return unless (defined($rec && $rec->{$f}));
        my $sf = shift;
-       return map { $_->{$sf} } grep { $_->{$sf} } @{ $rec->{$f} };
+       return map { $_->{$sf} } grep { ref($_) eq 'HASH' && $_->{$sf} } @{ $rec->{$f} };
 }
 
 =head2 rec

diff --git a/t/3-normalize-set.t b/t/3-normalize-set.t
index fbf117b..8dfb599 100755 (executable)
--- a/t/3-normalize-set.t
+++ b/t/3-normalize-set.t
@@ -2,7 +2,7 @@
 
 use strict;
 
-use Test::More tests => 56;
+use Test::More tests => 64;
 use Test::Exception;
 use Cwd qw/abs_path/;
 use blib;
@@ -291,5 +291,49 @@ sub test_s {
 
        ok($ds = get_ds(), "get_ds");
        diag "ds = ", Dumper($ds) if ($debug);
+
+       my $rec = {
+               '200' => [{
+                       'a' => '200a',
+                       'b' => '200b',
+               }],
+       };
+       my $rules = qq{ search('mixed', rec('200') ) };
+       
+       clean_ds();
+       set_rec( $rec );
+       test_s( $rules );
+       ok($ds = get_ds(), "get_ds");
+       is_deeply( $ds, {
+               'mixed' => {
+                       'search' => [ '200a', '200b' ],
+                       'tag' => 'mixed'
+               }
+       }, 'correct get_ds');
+
+       ok(my $ds2 = WebPAC::Normalize::Set::data_structure(
+               row => $rec,
+               rules => $rules,
+       ), 'data_structure');
+       is_deeply( $ds, $ds2, 'data_structure(s) same');
+
+       # wird and non-valid structure which is supported anyway
+       clean_ds();
+       set_rec({
+               '200' => [{
+                       'a' => '200a',
+               },
+                       '200-solo'
+               ]
+       });
+       test_s(qq{ search('mixed', rec('200') ) });
+       ok($ds = get_ds(), "get_ds");
+       is_deeply( $ds, {
+               'mixed' => {
+                       'search' => [ '200a', '200-solo' ],
+                       'tag' => 'mixed'
+               }
+       }, 'correct get_ds');
+
 }