/[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 25 by dpavlin, Sun Jun 17 22:33:45 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',
# 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                          foreach my $name ( keys %$tag_hash ) {                          foreach my $name ( keys %$tag_hash ) {
58                                  next if $name eq '_content';                                  next if $name eq '_content';
59                                  my $key = $name;                                  my $key = $name;
60                                  $key =~ s/^\w+://;      # stip namespace                                  $key =~ s/^\w+://;      # stip namespace
61                                  $state->{DeviceID}->{ $key } = $tag_hash->{$name}->{_content};                                  $state->{DeviceID}->{ $key } = _tag( $tag_hash, $name, '_content' );
62                          }                          }
63                  },                  },
64                  qr/EventStruct/ => sub {                  qr/EventStruct/ => sub {
# Line 46  my $parser = XML::Rules->new( Line 72  my $parser = XML::Rules->new(
72                  qr/ParameterValueStruct/ => sub {                  qr/ParameterValueStruct/ => sub {
73                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
74                          # Name/Value tags must be case insnesitive                          # Name/Value tags must be case insnesitive
                         my $name = (grep( /name/i, keys %$tag_hash ))[0];  
75                          my $value = (grep( /value/i, keys %$tag_hash ))[0];                          my $value = (grep( /value/i, keys %$tag_hash ))[0];
76                          $state->{Parameter}->{ $tag_hash->{$name}->{_content} } = $tag_hash->{$value}->{_content};                          $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    
Legend:
Removed from v.25  
changed lines
  Added in v.26
  ViewVC Help
Powered by ViewVC 1.1.26