/[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 26 by dpavlin, Sun Jun 17 23:02:08 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/$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                    #
53                    # Inform
54                    #
55                  qr/DeviceId/ => sub {                  qr/DeviceId/ => sub {
56                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
57                          $state->{ $tag_name } = $tag_hash;                          foreach my $name ( keys %$tag_hash ) {
58                                    next if $name eq '_content';
59                                    my $key = $name;
60                                    $key =~ s/^\w+://;      # stip namespace
61                                    $state->{DeviceID}->{ $key } = _tag( $tag_hash, $name, '_content' );
62                            }
63                  },                  },
64                  EventStruct => sub {                  qr/EventStruct/ => sub {
65                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
66                          push @{ $state->{ $tag_name } }, $tag_hash->{EventCode}->{_content};                          push @{ $state->{EventStruct} }, $tag_hash->{EventCode}->{_content};
67                  },                  },
68                  MaxEnvelopes => sub {                  qr/(MaxEnvelopes|CurrentTime|RetryCount)/ => sub {
69                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
70                          $state->{ $tag_name } = $tag_hash->{_content};                          $state->{$tag_name} = $tag_hash->{_content};
71                  }                  },
72                    qr/ParameterValueStruct/ => sub {
73                            my ($tag_name, $tag_hash, $context, $parent_data) = @_;
74                            # Name/Value tags must be case insnesitive
75                            my $value = (grep( /value/i, keys %$tag_hash ))[0];
76                            $state->{Parameter}->{ _tag($tag_hash, 'Name', '_content') } = _tag($tag_hash, 'Value', '_content' );
77                    },
78                    #
79                    # GetRPCMethodsResponse
80                    #
81                    qr/^(?:^\w+:)*string$/ => 'content array',
82                    qr/MethodList/ => sub {
83                            my ($tag_name, $tag_hash, $context, $parent_data) = @_;
84                            $state->{MethodList} = _tag( $tag_hash, 'string' );
85                    },      
86          ]          ]
87  );  );
88    
89  my $xml = read_file( $path );  my $xml = read_file( $path );
90  print "## $1 ##\n" if ( $xml =~ s/^Name:\s+(.*?)$//sm );  print "## $1 ##\n" if ( $xml =~ s/^Name:\s+(.*?)$//sm );
91  $xml =~ s/^.*Response:\s+//sm;  $xml =~ s/^.*Response:\s+//sm;
92  warn $xml;  #warn $xml;
93  $parser->parsestring( $xml );  $parser->parsestring( $xml );
94    
95  print "state = ", dump( $state );  print "state = ", dump( $state );
Legend:
Removed from v.23  
changed lines
  Added in v.26
  ViewVC Help
Powered by ViewVC 1.1.26