/[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 186 by dpavlin, Tue Oct 30 15:26:41 2007 UTC revision 187 by dpavlin, Tue Oct 30 15:46:40 2007 UTC
# Line 12  use Carp qw/confess cluck/; Line 12  use Carp qw/confess cluck/;
12    
13  CWMP::Request - parse SOAP request metods  CWMP::Request - parse SOAP request metods
14    
 =head1 METHODS  
   
 =head2 _tag  
   
 Get value of tag. Tag name is case insensitive (don't ask why),  
 we ignore namespaces and can take optional C<sub_key>  
 (usually C<_content>).  
   
   _tag( $tag_hash, $name, $sub_key )  
   
 =cut  
   
 sub _tag {  
         my ( $tag_hash, $name, $sub_key ) = @_;  
         confess "need hash as first argument" unless ( ref $tag_hash eq 'HASH' );  
         $name = (grep { m/^(?:\w+:)*$name$/i } keys %$tag_hash )[0];  
 #       $name =~ s/^\w+://;  
         if ( defined $tag_hash->{$name} ) {  
                 if ( ! defined $sub_key ) {  
                         return $tag_hash->{$name};  
                 } elsif ( defined $tag_hash->{$name}->{$sub_key} ) {  
                         return $tag_hash->{$name}->{$sub_key};  
                 } else {  
                         return if ( $name =~ m/^value$/i );  
                         warn "can't find '$name/$sub_key' in ", dump( $tag_hash );  
                         return;  
                 }  
         } else {  
                 warn "can't find '$name' in ", dump( $tag_hash );  
                 return;  
         }  
 }  
   
 =head2 parse  
   
   my $state = CWMP::Request->parse( "<soap>request</soap>" );  
   
 =cut  
   
 sub parse {  
         my $self = shift;  
   
         my $xml = shift || confess "no xml?";  
   
         $state = {};  
         $parser->parsestring( $xml );  
         return $state;  
 }  
   
15  =head1 CPE metods  =head1 CPE metods
16    
17  =cut  =cut
18    
 our $state;     # FIXME check this!  
   
19  my $tree = CWMP::Tree->new({ debug => 0 });  my $tree = CWMP::Tree->new({ debug => 0 });
20    
21  my $parser = XML::Rules->new(  our $state;     # FIXME check this!
22  #       start_rules => [  
23  #               '^division_name,fax' => 'skip',  my $rules =  [
 #       ],  
         namespaces => {  
                 'http://schemas.xmlsoap.org/soap/envelope/' => 'soapenv',  
                 'http://schemas.xmlsoap.org/soap/encoding/' => 'soap',  
                 'http://www.w3.org/2001/XMLSchema' => 'xsd',  
                 'http://www.w3.org/2001/XMLSchema-instance' => 'xsi',  
                 'urn:dslforum-org:cwmp-1-0' => '',  
         },  
         rules => [  
24                  #_default => 'content trim',                  #_default => 'content trim',
25                  x_default => sub {                  x_default => sub {
26                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
# Line 91  my $parser = XML::Rules->new( Line 31  my $parser = XML::Rules->new(
31                          $state->{ID} = $tag_hash->{_content};                          $state->{ID} = $tag_hash->{_content};
32                  },                  },
33    
 =head2 Inform  
   
 Generate InformResponse to CPE  
   
 =cut  
   
                 'Inform' => sub {  
                         $state->{_dispatch} = 'InformResponse';         # what reponse to call  
                 },  
34                  'DeviceId' => sub {                  'DeviceId' => sub {
35                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
36                          foreach my $name ( keys %$tag_hash ) {                          foreach my $name ( keys %$tag_hash ) {
# Line 124  Generate InformResponse to CPE Line 55  Generate InformResponse to CPE
55                          $state->{Parameter}->{ _tag($tag_hash, 'Name', '_content') } = _tag($tag_hash, 'Value', '_content' );                          $state->{Parameter}->{ _tag($tag_hash, 'Name', '_content') } = _tag($tag_hash, 'Value', '_content' );
56                  },                  },
57    
58    ];
59    
60    =head2 Inform
61    
62    Generate InformResponse to CPE
63    
64    =cut
65    
66    push @$rules,
67            'Inform' => sub {
68                    $state->{_dispatch} = 'InformResponse';         # what reponse to call
69            };
70    
71  =head2 GetRPCMethodsResponse  =head2 GetRPCMethodsResponse
72    
73  =cut  =cut
74    
75    push @$rules,
76                  qr/^(?:^\w+:)*string$/ => 'content array',                  qr/^(?:^\w+:)*string$/ => 'content array',
77                  'MethodList' => sub {                  'MethodList' => sub {
78                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
79                          $state->{MethodList} = _tag( $tag_hash, 'string' );                          $state->{MethodList} = _tag( $tag_hash, 'string' );
80                  },                  };
81    
82  =head2 GetParameterNamesResponse  =head2 GetParameterNamesResponse
83    
84  =cut  =cut
85    
86    push @$rules,
87                  'ParameterInfoStruct' => sub {                  'ParameterInfoStruct' => sub {
88                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
89                          my $name = _tag($tag_hash, 'Name', '_content');                          my $name = _tag($tag_hash, 'Name', '_content');
# Line 150  Generate InformResponse to CPE Line 97  Generate InformResponse to CPE
97                          confess "can't eval $s : $@" if ($@);                          confess "can't eval $s : $@" if ($@);
98    
99                          #warn "## state = dump( $state ), "\n";                          #warn "## state = dump( $state ), "\n";
100                  },                  };
101                    
102  =head2 Fault  =head2 Fault
103    
104  =cut  =cut
105    
106    push @$rules,
107                  'Fault' => sub {                  'Fault' => sub {
108                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;                          my ($tag_name, $tag_hash, $context, $parent_data) = @_;
109                          $state->{Fault} = {                          $state->{Fault} = {
# Line 163  Generate InformResponse to CPE Line 111  Generate InformResponse to CPE
111                                  FaultString => _tag( $tag_hash, 'FaultString', '_content' ),                                  FaultString => _tag( $tag_hash, 'FaultString', '_content' ),
112                          };                          };
113                          warn "FAULT: ", $state->{Fault}->{FaultCode}, " ", $state->{Fault}->{FaultString}, "\n";                          warn "FAULT: ", $state->{Fault}->{FaultCode}, " ", $state->{Fault}->{FaultString}, "\n";
114                  }                  };
115          ]  
116    my $parser = XML::Rules->new(
117    #       start_rules => [
118    #               '^division_name,fax' => 'skip',
119    #       ],
120            namespaces => {
121                    'http://schemas.xmlsoap.org/soap/envelope/' => 'soapenv',
122                    'http://schemas.xmlsoap.org/soap/encoding/' => 'soap',
123                    'http://www.w3.org/2001/XMLSchema' => 'xsd',
124                    'http://www.w3.org/2001/XMLSchema-instance' => 'xsi',
125                    'urn:dslforum-org:cwmp-1-0' => '',
126            },
127            rules => $rules,
128  );  );
129    
130    =head1 METHODS
131    
132    =head2 parse
133    
134      my $state = CWMP::Request->parse( "<soap>request</soap>" );
135    
136    =cut
137    
138    sub parse {
139            my $self = shift;
140    
141            my $xml = shift || confess "no xml?";
142    
143            $state = {};
144            $parser->parsestring( $xml );
145            return $state;
146    }
147    
148    =head2 _tag
149    
150    Get value of tag. Tag name is case insensitive (don't ask why),
151    we ignore namespaces and can take optional C<sub_key>
152    (usually C<_content>).
153    
154      _tag( $tag_hash, $name, $sub_key )
155    
156    =cut
157    
158    sub _tag {
159            my ( $tag_hash, $name, $sub_key ) = @_;
160            confess "need hash as first argument" unless ( ref $tag_hash eq 'HASH' );
161            $name = (grep { m/^(?:\w+:)*$name$/i } keys %$tag_hash )[0];
162    #       $name =~ s/^\w+://;
163            if ( defined $tag_hash->{$name} ) {
164                    if ( ! defined $sub_key ) {
165                            return $tag_hash->{$name};
166                    } elsif ( defined $tag_hash->{$name}->{$sub_key} ) {
167                            return $tag_hash->{$name}->{$sub_key};
168                    } else {
169                            return if ( $name =~ m/^value$/i );
170                            warn "can't find '$name/$sub_key' in ", dump( $tag_hash );
171                            return;
172                    }
173            } else {
174                    warn "can't find '$name' in ", dump( $tag_hash );
175                    return;
176            }
177    }
178    
179  1;  1;
Legend:
Removed from v.186  
changed lines
  Added in v.187
  ViewVC Help
Powered by ViewVC 1.1.26