/[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 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',
# 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                          foreach my $name ( keys %$tag_hash ) {                          foreach my $name ( keys %$tag_hash ) {
62                                  next if $name eq '_content';                                  next if $name eq '_content';
63                                  my $key = $name;                                  my $key = $name;
64                                  $key =~ s/^\w+://;      # stip namespace                                  $key =~ s/^\w+://;      # stip namespace
65                                  $state->{DeviceID}->{ $key } = $tag_hash->{$name}->{_content};                                  $state->{DeviceID}->{ $key } = _tag( $tag_hash, $name, '_content' );
66                          }                          }
67                  },                  },
68                  qr/EventStruct/ => sub {                  qr/EventStruct/ => sub {
# Line 46  my $parser = XML::Rules->new( Line 76  my $parser = XML::Rules->new(
76                  qr/ParameterValueStruct/ => sub {                  qr/ParameterValueStruct/ => sub {
77                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
78                          # Name/Value tags must be case insnesitive                          # Name/Value tags must be case insnesitive
                         my $name = (grep( /name/i, keys %$tag_hash ))[0];  
79                          my $value = (grep( /value/i, keys %$tag_hash ))[0];                          my $value = (grep( /value/i, keys %$tag_hash ))[0];
80                          $state->{Parameter}->{ $tag_hash->{$name}->{_content} } = $tag_hash->{$value}->{_content};                          $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    
Legend:
Removed from v.25  
changed lines
  Added in v.27
  ViewVC Help
Powered by ViewVC 1.1.26