r1517@llin: dpavlin | 2007-11-04 14:26:05 +0100

 New rewamp of WebPAC::Input::XML with added mungle rules (perl code really)
 to modify xml hash returned from XML::Simple

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

diff --git a/lib/WebPAC/Input/XML.pm b/lib/WebPAC/Input/XML.pm
index ec64ab3..a309066 100644 (file)
--- a/lib/WebPAC/Input/XML.pm
+++ b/lib/WebPAC/Input/XML.pm
@@ -8,6 +8,7 @@ use base qw/WebPAC::Common/;
 
 use XML::Simple;
 use File::Find;
+use File::Slurp;
 
 use Data::Dump qw/dump/;
 
@@ -17,7 +18,7 @@ WebPAC::Input::XML - support for reading XML files
 
 =cut
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 =head1 FUNCTIONS
 
@@ -32,6 +33,7 @@ Returns new low-level input API object
                # do something with $l which is line of input file
                return $l;
        },
+       mungle => 'conf/mungle/xml-mungle.pl',
   }
 
 Options:
@@ -42,6 +44,15 @@ Options:
 
 path to directory with xml files ending in C<.xml>
 
+=item mungle
+
+path to perl data_structure mungler which will be called to pre-normalize
+hash produced by this module.
+
+It's ugly and souldn't be really here, but I didn't wanted to write separate
+input module for each possible XML in the face of the earth, and having perl
+power to transform hash is just... Best solution :-)
+
 =back
 
 =cut
@@ -53,6 +64,8 @@ sub new {
 
        my $arg = {@_};
 
+warn "#### arg = ",dump( $arg );
+
        my $log = $self->_get_logger();
 
        $log->logdie("can't find path ", $arg->{path}, ": $!\n") unless -d $arg->{path};
@@ -74,6 +87,13 @@ sub new {
 
        $self->{_files} = [ sort @files ];
 
+       if ( my $path = $arg->{mungle} ) {
+               $log->logdie("can't find $path: $!") unless -r $path;
+               $log->info("using $path as mungle rules");
+
+               $self->{mungle_rules} = read_file( $path ) || $log->logdie("can't open $path: $!");
+       }
+
        $self ? return $self : return undef;
 }
 
@@ -94,21 +114,48 @@ sub fetch_rec {
 
        my $log = $self->_get_logger();
 
-       my $xml = XMLin(
+       our $xml = XMLin(
                $path,
 #              ForceArray => 1,
 #              ForceContent => 1,
-#              KeepRoot => 1,
+               KeepRoot => 1,
 #              SuppressEmpty => 1, # '' undef
 
        ) || $log->logdie("can't open $path: $!");
 
        $log->debug("fetch_rec( $mfn ) => $path => xml is ",sub { dump($xml) });
 
+       our $ds;
+
+       if ( my $rules = $self->{mungle_rules} ) {
+
+               sub get_ds {
+                       warn "### get_ds xml = ",dump($xml);
+                       return $xml;
+               }
+               sub set_ds {
+                       my $hash = {@_};
+                       warn "### set_ds hash = ",dump($hash);
+                       foreach my $f ( keys %$hash ) {
+                               warn "+++ $f ", dump( $hash->{$f} ),"\n";
+                               $ds->{$f} = $hash->{$f};
+                       }
+                       warn "### set_ds mungle_ds = ",dump($ds);
+               }
+               eval "$rules";
+               $log->logdie("mungle rules $path error: $@") if $@;
+
+               warn "### set_ds after mungle_rules ds = ",dump($ds);
+       } else {
+
+               $ds = $xml;
+       
+       }
+
        # add mfn
-       $xml->{'000'} = [ $mfn ];
+       $ds->{'000'} = [ $mfn ];
 
-       return $xml;
+       return $ds;
 }
 
 

diff --git a/t/2-input-xml.t b/t/2-input-xml.t
index ff2f190..2dae39f 100755 (executable)
--- a/t/2-input-xml.t
+++ b/t/2-input-xml.t
@@ -3,7 +3,7 @@
 use strict;
 use blib;
 
-use Test::More tests => 12;
+use Test::More tests => 18;
 
 BEGIN {
 use_ok( 'WebPAC::Test' );
@@ -22,7 +22,8 @@ ok(my $input = new WebPAC::Input(
 throws_ok { $input->open( path => '/tmp/does_not_exit', %LOG ) } qr/can't find path/, 'open with non-existant path';
 
 ok(my $db = $input->open(
-       path => "$abs_path/data/xml/"
+       path => "$abs_path/data/xml/",
+       mungle => "$abs_path/conf/mungle/xml.pl",
 ), "open");
 ok(my $size = $input->size, "size");
 

diff --git a/t/data/xml/4.xml b/t/data/xml/4.xml
new file mode 100644 (file)
index 0000000..b0e28ea
--- /dev/null
+++ b/t/data/xml/4.xml
@@ -0,0 +1,3 @@
+<xml>
+       <number>0</number>
+</xml>

diff --git a/t/data/xml/5.xml b/t/data/xml/5.xml
new file mode 100644 (file)
index 0000000..70005f6
--- /dev/null
+++ b/t/data/xml/5.xml
@@ -0,0 +1,4 @@
+<xml>
+       <number>0</number>
+       <number>42</number>
+</xml>

diff --git a/t/data/xml/6.xml b/t/data/xml/6.xml
new file mode 100644 (file)
index 0000000..0750865
--- /dev/null
+++ b/t/data/xml/6.xml
@@ -0,0 +1,11 @@
+<xml>
+<array>element 1</array>
+<array>element 2</array>
+<array>element 3</array>
+<array>element 4</array>
+<array>element 5</array>
+<array>element 6</array>
+<array>element 7</array>
+<array>element 8</array>
+<array>element 9</array>
+</xml>