cwmp/google/rules.pl

#!/usr/bin/perl

use warnings;
use strict;

use XML::Rules;
use File::Slurp;
use Data::Dump qw/dump/;

my $path = $ARGV[0] || 'protocol/inform.xml';

my $state;

my $parser = XML::Rules->new(
#       start_rules => [
#               '^division_name,fax' => 'skip',
#       ],
        namespaces => {
#               'http://schemas.xmlsoap.org/soap/envelope/' => 'soapenv',
#               'http://schemas.xmlsoap.org/soap/encoding/' => 'soap',
                'urn:dslforum-org:cwmp-1-0' => '',
        },
        rules => [
                #_default => 'content trim',
                x_default => sub {
                        my ($tag_name, $tag_hash, $context, $parent_data) = @_;
                        warn dump( $tag_name, $tag_hash, $context );
                },
                qr/DeviceId/ => sub {
                        my ($tag_name, $tag_hash, $context, $parent_data) = @_;
                        foreach my $name ( keys %$tag_hash ) {
                                next if $name eq '_content';
                                my $key = $name;
                                $key =~ s/^\w+://;      # stip namespace
                                $state->{DeviceID}->{ $key } = $tag_hash->{$name}->{_content};
                        }
                },
                qr/EventStruct/ => sub {
                        my ($tag_name, $tag_hash, $context, $parent_data) = @_;
                        push @{ $state->{EventStruct} }, $tag_hash->{EventCode}->{_content};
                },
                qr/(MaxEnvelopes|CurrentTime|RetryCount)/ => sub {
                        my ($tag_name, $tag_hash, $context, $parent_data) = @_;
                        $state->{$tag_name} = $tag_hash->{_content};
                },
                qr/ParameterValueStruct/ => sub {
                        my ($tag_name, $tag_hash, $context, $parent_data) = @_;
                        # Name/Value tags must be case insnesitive
                        my $name = (grep( /name/i, keys %$tag_hash ))[0];
                        my $value = (grep( /value/i, keys %$tag_hash ))[0];
                        $state->{Parameter}->{ $tag_hash->{$name}->{_content} } = $tag_hash->{$value}->{_content};
                },
        ]
);

my $xml = read_file( $path );
print "## $1 ##\n" if ( $xml =~ s/^Name:\s+(.*?)$//sm );
$xml =~ s/^.*Response:\s+//sm;
#warn $xml;
$parser->parsestring( $xml );

print "state = ", dump( $state );
1	dpavlin	23	#!/usr/bin/perl
2
3			use warnings;
4			use strict;
5
6			use XML::Rules;
7			use File::Slurp;
8			use Data::Dump qw/dump/;
9
10			my $path = $ARGV[0] \|\| 'protocol/inform.xml';
11
12			my $state;
13
14			my $parser = XML::Rules->new(
15			# start_rules => [
16			# '^division_name,fax' => 'skip',
17			# ],
18			namespaces => {
19	dpavlin	24	# 'http://schemas.xmlsoap.org/soap/envelope/' => 'soapenv',
20			# 'http://schemas.xmlsoap.org/soap/encoding/' => 'soap',
21			'urn:dslforum-org:cwmp-1-0' => '',
22	dpavlin	23	},
23			rules => [
24			#_default => 'content trim',
25			x_default => sub {
26			my ($tag_name, $tag_hash, $context, $parent_data) = @_;
27			warn dump( $tag_name, $tag_hash, $context );
28			},
29			qr/DeviceId/ => sub {
30			my ($tag_name, $tag_hash, $context, $parent_data) = @_;
31	dpavlin	24	foreach my $name ( keys %$tag_hash ) {
32			next if $name eq '_content';
33			my $key = $name;
34			$key =~ s/^\w+://; # stip namespace
35			$state->{DeviceID}->{ $key } = $tag_hash->{$name}->{_content};
36			}
37	dpavlin	23	},
38	dpavlin	24	qr/EventStruct/ => sub {
39	dpavlin	23	my ($tag_name, $tag_hash, $context, $parent_data) = @_;
40	dpavlin	24	push @{ $state->{EventStruct} }, $tag_hash->{EventCode}->{_content};
41	dpavlin	23	},
42	dpavlin	25	qr/(MaxEnvelopes\|CurrentTime\|RetryCount)/ => sub {
43	dpavlin	23	my ($tag_name, $tag_hash, $context, $parent_data) = @_;
44	dpavlin	25	$state->{$tag_name} = $tag_hash->{_content};
45			},
46			qr/ParameterValueStruct/ => sub {
47			my ($tag_name, $tag_hash, $context, $parent_data) = @_;
48			# Name/Value tags must be case insnesitive
49			my $name = (grep( /name/i, keys %$tag_hash ))[0];
50			my $value = (grep( /value/i, keys %$tag_hash ))[0];
51			$state->{Parameter}->{ $tag_hash->{$name}->{_content} } = $tag_hash->{$value}->{_content};
52			},
53	dpavlin	23	]
54			);
55
56			my $xml = read_file( $path );
57			print "## $1 ##\n" if ( $xml =~ s/^Name:\s+(.*?)$//sm );
58			$xml =~ s/^.*Response:\s+//sm;
59	dpavlin	24	#warn $xml;
60	dpavlin	23	$parser->parsestring( $xml );
61
62			print "state = ", dump( $state );