/[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 36 by dpavlin, Tue Jun 19 00:38:49 2007 UTC revision 103 by dpavlin, Sun Jun 24 19:36:31 2007 UTC
# Line 4  use warnings; Line 4  use warnings;
4  use strict;  use strict;
5    
6  use XML::Rules;  use XML::Rules;
7    use CWMP::Tree;
8  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
9  use Carp qw/confess cluck/;  use Carp qw/confess cluck/;
10    
# Line 44  sub _tag { Line 45  sub _tag {
45          }          }
46  }  }
47    
48  my $state;  our $state;     # FIXME check this!
49    
50    my $tree = CWMP::Tree->new({ debug => 0 });
51    
52  my $parser = XML::Rules->new(  my $parser = XML::Rules->new(
53  #       start_rules => [  #       start_rules => [
54  #               '^division_name,fax' => 'skip',  #               '^division_name,fax' => 'skip',
55  #       ],  #       ],
56          namespaces => {          namespaces => {
57  #               'http://schemas.xmlsoap.org/soap/envelope/' => 'soapenv',                  'http://schemas.xmlsoap.org/soap/envelope/' => 'soapenv',
58  #               'http://schemas.xmlsoap.org/soap/encoding/' => 'soap',                  'http://schemas.xmlsoap.org/soap/encoding/' => 'soap',
59                    'http://www.w3.org/2001/XMLSchema' => 'xsd',
60                    'http://www.w3.org/2001/XMLSchema-instance' => 'xsi',
61                  'urn:dslforum-org:cwmp-1-0' => '',                  'urn:dslforum-org:cwmp-1-0' => '',
62          },          },
63          rules => [          rules => [
# Line 69  my $parser = XML::Rules->new( Line 74  my $parser = XML::Rules->new(
74                  # Inform                  # Inform
75                  #                  #
76                  'Inform' => sub {                  'Inform' => sub {
77                          $state->{_dispatch} = 'Inform';         # what reponse to call                          $state->{_dispatch} = 'InformResponse';         # what reponse to call
78                  },                  },
79                  qr/DeviceId/ => sub {                  'DeviceId' => sub {
80                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
81                          foreach my $name ( keys %$tag_hash ) {                          foreach my $name ( keys %$tag_hash ) {
82                                  next if $name eq '_content';                                  next if $name eq '_content';
# Line 80  my $parser = XML::Rules->new( Line 85  my $parser = XML::Rules->new(
85                                  $state->{DeviceID}->{ $key } = _tag( $tag_hash, $name, '_content' );                                  $state->{DeviceID}->{ $key } = _tag( $tag_hash, $name, '_content' );
86                          }                          }
87                  },                  },
88                  qr/EventStruct/ => sub {                  'EventStruct' => sub {
89                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
90                          push @{ $state->{EventStruct} }, $tag_hash->{EventCode}->{_content};                          push @{ $state->{EventStruct} }, $tag_hash->{EventCode}->{_content};
91                  },                  },
# Line 88  my $parser = XML::Rules->new( Line 93  my $parser = XML::Rules->new(
93                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
94                          $state->{$tag_name} = $tag_hash->{_content};                          $state->{$tag_name} = $tag_hash->{_content};
95                  },                  },
96                  qr/ParameterValueStruct/ => sub {                  'ParameterValueStruct' => sub {
97                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
98                          # Name/Value tags must be case insnesitive                          # Name/Value tags must be case insnesitive
99                          my $value = (grep( /value/i, keys %$tag_hash ))[0];                          my $value = (grep( /value/i, keys %$tag_hash ))[0];
# Line 98  my $parser = XML::Rules->new( Line 103  my $parser = XML::Rules->new(
103                  # GetRPCMethodsResponse                  # GetRPCMethodsResponse
104                  #                  #
105                  qr/^(?:^\w+:)*string$/ => 'content array',                  qr/^(?:^\w+:)*string$/ => 'content array',
106                  qr/MethodList/ => sub {                  'MethodList' => sub {
107                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
108                          $state->{MethodList} = _tag( $tag_hash, 'string' );                          $state->{MethodList} = _tag( $tag_hash, 'string' );
109                  },                        },
110                    #
111                    # GetParameterNamesResponse
112                    #
113                    'ParameterInfoStruct' => sub {
114                            my ($tag_name, $tag_hash, $context, $parent_data) = @_;
115                            my $name = _tag($tag_hash, 'Name', '_content');
116                            my $writable = _tag($tag_hash, 'Writable', '_content' );
117    
118                            confess "need state" unless ( $state ); # don't remove!
119    
120                            # XXX dragons ahead: convert name to tree rewriting it into perl
121                            my $s = '$state->{ParameterInfo}->' . $tree->name2perl( $name ) . "->{writable} = $writable;";
122                            eval "$s";
123                            confess "can't eval $s : $@" if ($@);
124    
125                            #warn "## state = dump( $state ), "\n";
126                    },
127                    #
128                    # Fault
129                    #
130                    'Fault' => sub {
131                            my ($tag_name, $tag_hash, $context, $parent_data) = @_;
132                            $state->{Fault} = {
133                                    FaultCode => _tag( $tag_hash, 'FaultCode', '_content' ),
134                                    FaultString => _tag( $tag_hash, 'FaultString', '_content' ),
135                            };
136                            warn "FAULT: ", $state->{Fault}->{FaultCode}, " ", $state->{Fault}->{FaultString}, "\n";
137                    }
138          ]          ]
139  );  );
140    
Legend:
Removed from v.36  
changed lines
  Added in v.103
  ViewVC Help
Powered by ViewVC 1.1.26