/[cwmp]/google/rules.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /google/rules.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 23 by dpavlin, Sun Jun 17 21:58:57 2007 UTC revision 27 by dpavlin, Sun Jun 17 23:05:52 2007 UTC
# Line 6  use strict; Line 6  use strict;
6  use XML::Rules;  use XML::Rules;
7  use File::Slurp;  use File::Slurp;
8  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
9    use Carp qw/confess cluck/;
10    
11  my $path = $ARGV[0] || 'protocol/inform.xml';  my $path = $ARGV[0] || 'protocol/inform.xml';
12    
13  my $state;  my $state;
14    
15    # get tag name, case insensitive, namespace ignoring
16    sub _tag {
17            my ( $tag_hash, $name, $sub_key ) = @_;
18            confess "need hash as first argument" unless ( ref $tag_hash eq 'HASH' );
19            $name = (grep { m/^(?:\w+:)*$name$/i } keys %$tag_hash )[0];
20    #       $name =~ s/^\w+://;
21            if ( defined $tag_hash->{$name} ) {
22                    if ( ! defined $sub_key ) {
23                            return $tag_hash->{$name};
24                    } elsif ( defined $tag_hash->{$name}->{$sub_key} ) {
25                            return $tag_hash->{$name}->{$sub_key};
26                    } else {
27                            return if ( $name =~ m/^value$/i );
28                            warn "can't find '$name/$sub_key' in ", dump( $tag_hash );
29                            return;
30                    }
31            } else {
32                    warn "can't find '$name' in ", dump( $tag_hash );
33                    return;
34            }
35    }
36    
37  my $parser = XML::Rules->new(  my $parser = XML::Rules->new(
38  #       start_rules => [  #       start_rules => [
39  #               '^division_name,fax' => 'skip',  #               '^division_name,fax' => 'skip',
40  #       ],  #       ],
41          namespaces => {          namespaces => {
42                  'http://schemas.xmlsoap.org/soap/envelope/' => 'soapenv',  #               'http://schemas.xmlsoap.org/soap/envelope/' => 'soapenv',
43                  'http://schemas.xmlsoap.org/soap/encoding/' => 'soap',  #               'http://schemas.xmlsoap.org/soap/encoding/' => 'soap',
44                  'urn:dslforum-org:cwmp-1-0' => 'cwmp',                  'urn:dslforum-org:cwmp-1-0' => '',
45          },          },
46          rules => [          rules => [
47                  #_default => 'content trim',                  #_default => 'content trim',
# Line 26  my $parser = XML::Rules->new( Line 49  my $parser = XML::Rules->new(
49                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
50                          warn dump( $tag_name, $tag_hash, $context );                          warn dump( $tag_name, $tag_hash, $context );
51                  },                  },
52                    'ID' => sub {
53                            my ($tag_name, $tag_hash, $context, $parent_data) = @_;
54                            $state->{ID} = $tag_hash->{_content};
55                    },
56                    #
57                    # Inform
58                    #
59                  qr/DeviceId/ => sub {                  qr/DeviceId/ => sub {
60                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
61                          $state->{ $tag_name } = $tag_hash;                          foreach my $name ( keys %$tag_hash ) {
62                                    next if $name eq '_content';
63                                    my $key = $name;
64                                    $key =~ s/^\w+://;      # stip namespace
65                                    $state->{DeviceID}->{ $key } = _tag( $tag_hash, $name, '_content' );
66                            }
67                  },                  },
68                  EventStruct => sub {                  qr/EventStruct/ => sub {
69                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
70                          push @{ $state->{ $tag_name } }, $tag_hash->{EventCode}->{_content};                          push @{ $state->{EventStruct} }, $tag_hash->{EventCode}->{_content};
71                  },                  },
72                  MaxEnvelopes => sub {                  qr/(MaxEnvelopes|CurrentTime|RetryCount)/ => sub {
73                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
74                          $state->{ $tag_name } = $tag_hash->{_content};                          $state->{$tag_name} = $tag_hash->{_content};
75                  }                  },
76                    qr/ParameterValueStruct/ => sub {
77                            my ($tag_name, $tag_hash, $context, $parent_data) = @_;
78                            # Name/Value tags must be case insnesitive
79                            my $value = (grep( /value/i, keys %$tag_hash ))[0];
80                            $state->{Parameter}->{ _tag($tag_hash, 'Name', '_content') } = _tag($tag_hash, 'Value', '_content' );
81                    },
82                    #
83                    # GetRPCMethodsResponse
84                    #
85                    qr/^(?:^\w+:)*string$/ => 'content array',
86                    qr/MethodList/ => sub {
87                            my ($tag_name, $tag_hash, $context, $parent_data) = @_;
88                            $state->{MethodList} = _tag( $tag_hash, 'string' );
89                    },      
90          ]          ]
91  );  );
92    
93  my $xml = read_file( $path );  my $xml = read_file( $path );
94  print "## $1 ##\n" if ( $xml =~ s/^Name:\s+(.*?)$//sm );  print "## $1 ##\n" if ( $xml =~ s/^Name:\s+(.*?)$//sm );
95  $xml =~ s/^.*Response:\s+//sm;  $xml =~ s/^.*Response:\s+//sm;
96  warn $xml;  #warn $xml;
97  $parser->parsestring( $xml );  $parser->parsestring( $xml );
98    
99  print "state = ", dump( $state );  print "state = ", dump( $state );
Legend:
Removed from v.23  
changed lines
  Added in v.27
  ViewVC Help
Powered by ViewVC 1.1.26