/[cwmp]/google/trunk/lib/CWMP/Request.pm
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/trunk/lib/CWMP/Request.pm

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

revision 32 by dpavlin, Mon Jun 18 23:52:41 2007 UTC revision 90 by dpavlin, Sat Jun 23 08:14:45 2007 UTC
# Line 44  sub _tag { Line 44  sub _tag {
44          }          }
45  }  }
46    
47  my $state;  our $state;     # FIXME check this!
48    
49  my $parser = XML::Rules->new(  my $parser = XML::Rules->new(
50  #       start_rules => [  #       start_rules => [
51  #               '^division_name,fax' => 'skip',  #               '^division_name,fax' => 'skip',
52  #       ],  #       ],
53          namespaces => {          namespaces => {
54  #               'http://schemas.xmlsoap.org/soap/envelope/' => 'soapenv',                  'http://schemas.xmlsoap.org/soap/envelope/' => 'soapenv',
55  #               'http://schemas.xmlsoap.org/soap/encoding/' => 'soap',                  'http://schemas.xmlsoap.org/soap/encoding/' => 'soap',
56                    'http://www.w3.org/2001/XMLSchema' => 'xsd',
57                    'http://www.w3.org/2001/XMLSchema-instance' => 'xsi',
58                  'urn:dslforum-org:cwmp-1-0' => '',                  'urn:dslforum-org:cwmp-1-0' => '',
59          },          },
60          rules => [          rules => [
# Line 68  my $parser = XML::Rules->new( Line 70  my $parser = XML::Rules->new(
70                  #                  #
71                  # Inform                  # Inform
72                  #                  #
73                  qr/DeviceId/ => sub {                  'Inform' => sub {
74                            $state->{_dispatch} = 'InformResponse';         # what reponse to call
75                    },
76                    'DeviceId' => sub {
77                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
78                          foreach my $name ( keys %$tag_hash ) {                          foreach my $name ( keys %$tag_hash ) {
79                                  next if $name eq '_content';                                  next if $name eq '_content';
# Line 77  my $parser = XML::Rules->new( Line 82  my $parser = XML::Rules->new(
82                                  $state->{DeviceID}->{ $key } = _tag( $tag_hash, $name, '_content' );                                  $state->{DeviceID}->{ $key } = _tag( $tag_hash, $name, '_content' );
83                          }                          }
84                  },                  },
85                  qr/EventStruct/ => sub {                  'EventStruct' => sub {
86                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
87                          push @{ $state->{EventStruct} }, $tag_hash->{EventCode}->{_content};                          push @{ $state->{EventStruct} }, $tag_hash->{EventCode}->{_content};
88                  },                  },
# Line 85  my $parser = XML::Rules->new( Line 90  my $parser = XML::Rules->new(
90                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
91                          $state->{$tag_name} = $tag_hash->{_content};                          $state->{$tag_name} = $tag_hash->{_content};
92                  },                  },
93                  qr/ParameterValueStruct/ => sub {                  'ParameterValueStruct' => sub {
94                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
95                          # Name/Value tags must be case insnesitive                          # Name/Value tags must be case insnesitive
96                          my $value = (grep( /value/i, keys %$tag_hash ))[0];                          my $value = (grep( /value/i, keys %$tag_hash ))[0];
# Line 95  my $parser = XML::Rules->new( Line 100  my $parser = XML::Rules->new(
100                  # GetRPCMethodsResponse                  # GetRPCMethodsResponse
101                  #                  #
102                  qr/^(?:^\w+:)*string$/ => 'content array',                  qr/^(?:^\w+:)*string$/ => 'content array',
103                  qr/MethodList/ => sub {                  'MethodList' => sub {
104                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
105                          $state->{MethodList} = _tag( $tag_hash, 'string' );                          $state->{MethodList} = _tag( $tag_hash, 'string' );
106                  },                        },
107                    #
108                    # GetParameterNamesResponse
109                    #
110                    'ParameterInfoStruct' => sub {
111                            my ($tag_name, $tag_hash, $context, $parent_data) = @_;
112                            my $name = _tag($tag_hash, 'Name', '_content');
113                            my $writable = _tag($tag_hash, 'Writable', '_content' );
114    
115                            confess "need state" unless ( $state ); # don't remove!
116    
117                            # XXX dragons ahead: convert name to tree rewriting it into perl
118    
119                            my $s = $name;
120                            $s =~ s#^#\$state->{ParameterInfo}->{'$name'}->{'#;
121                            $s =~ s#(\w+)\.(\d+)\.(\w+)#$1'}->[$2]->{'$3#ig;
122                            $s =~ s#(\w+)\.(\w+)#$1'}->{'$2#g;
123                            $s =~ s#(\w+)$#$1'}->{'writable'} = $writable;#;        #fix-vim
124                            eval "$s";
125                            confess "can't eval $s : $@" if ($@);
126    
127                            #warn "## tree: $s ", dump( $state ), "\n";
128                    },
129                    #
130                    # Fault
131                    #
132                    'Fault' => sub {
133                            my ($tag_name, $tag_hash, $context, $parent_data) = @_;
134                            $state->{Fault} = {
135                                    FaultCode => _tag( $tag_hash, 'FaultCode', '_content' ),
136                                    FaultString => _tag( $tag_hash, 'FaultString', '_content' ),
137                            };
138                            warn "FAULT: ", $state->{Fault}->{FaultCode}, " ", $state->{Fault}->{FaultString}, "\n";
139                    }
140          ]          ]
141  );  );
142    
Legend:
Removed from v.32  
changed lines
  Added in v.90
  ViewVC Help
Powered by ViewVC 1.1.26