fix CWMP::Vendor->vendor_config
[perl-cwmp.git] / lib / CWMP / Parser.pm
index 72b96f9..7be91c3 100644 (file)
@@ -14,11 +14,13 @@ CWMP::Parser - parse SOAP request XML
 =head1 DESCRIPTION
 
 Design is based on my expirience with L<XML::Rules>, but show-stopper
-was it's inability to parse invalid XML returned by some devices.
+was it's inability to parse invalid XML returned by some devices, so
+in this version we depend on L<XML::Bare>
 
 =cut
 
 our $state;    # FIXME check this!
+my $debug = 0;
 
 sub _get_array {
        my ( $tree ) = @_;
@@ -82,11 +84,18 @@ sub _walk {
                        $name =~ s/Struct//;
                        $name =~ s/Value//;
 
+                       my @struct;
+
                        if ( ref $tree->{$node} eq 'HASH' ) {
-                               push @{ $state->{$name} }, _hash_value $tree->{$node};
+                               @struct = ( $tree->{$node} );
                        } elsif ( ref $tree->{$node} eq 'ARRAY' ) {
+                               @struct = @{ $tree->{$node} };
+                       } else {
+                               die "don't know how to handle $node in ",dump($tree);
+                       }
 
-                               my $hash = _hash_value $tree->{$node}->[$_];
+                       foreach my $e ( @struct ) {
+                               my $hash = _hash_value $e;
 
                                if ( my $n = delete $hash->{Name} ) {
                                        my @keys = keys %$hash;
@@ -94,29 +103,27 @@ sub _walk {
                                                $state->{$name}->{$n} = $hash;
                                        } else {
                                                $state->{$name}->{$n} = $hash->{ $keys[0] };
-                                               warn "using $keys[0] as value for $name.$n\n";
+#                                                      warn "using $keys[0] as value for $name.$n\n";
                                        }
                                } else {
-                                       push @{ $state->{$name} }, _hash_value $tree->{$node}->[$_]
-                                               foreach 0 .. $#{ $tree->{$node} };
+                                       push @{ $state->{$name} }, $hash;
                                }
                        }
-                       $dump = 1;
-
-               } elsif ( $node =~ m/Inform/ ) {
 
-                       $state->{_dispatch} = 'InformResponse';
+                       $dump = 1;
 
                } elsif ( ref($tree->{$node}) eq 'HASH' ) {
 
-                       warn "## recurse $node\n";
+                       $state->{_dispatch} = 'InformResponse' if $node =~ m/Inform/;
+
+                       warn "## recurse $node\n" if $debug;
                        _walk( $tree->{$node} );
 
                }
        
                if ( $dump ) {
 #                      warn "XXX tree ",dump( $tree->{$node} );
-                       warn "## state ",dump( $state );
+                       warn "## state ",dump( $state ) if $debug;
                }
        }
 }
@@ -127,6 +134,7 @@ sub parse {
        my $xml = shift || confess "no xml?";
 
        $state = {};
+
        my $bare = XML::Bare->new( text => $xml );
        my $hash = $bare->parse();