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