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

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

google/lib/CWMP/Response.pm revision 46 by dpavlin, Tue Jun 19 19:50:29 2007 UTC google/trunk/lib/CWMP/Response.pm revision 172 by dpavlin, Sun Oct 28 15:43:07 2007 UTC
# Line 3  package CWMP::Response; Line 3  package CWMP::Response;
3  use strict;  use strict;
4  use warnings;  use warnings;
5    
6    
7  use base qw/Class::Accessor/;  use base qw/Class::Accessor/;
8  __PACKAGE__->add_accessor( qw/  __PACKAGE__->mk_accessors( qw/debug/ );
 debug  
 /);  
9    
10  use XML::Generator;  use XML::Generator;
11  use Carp qw/confess/;  use Carp qw/confess/;
# Line 28  sub new { Line 27  sub new {
27          my $class = shift;          my $class = shift;
28          my $self = $class->SUPER::new( @_ );          my $self = $class->SUPER::new( @_ );
29    
30          warn "created XML::Generator object" if $self->debug;          warn "created XML::Generator object\n" if $self->debug;
31    
32          return $self;          return $self;
33  }  }
34    
35    
36  my $cwmp = [ cwmp => 'urn:dslforum-org:cwmp-1-0' ];  my $cwmp = [ cwmp => 'urn:dslforum-org:cwmp-1-0' ];
37  my $soap = [ soap => "http://schemas.xmlsoap.org/soap/envelope/" ];  my $soap = [ soap => 'http://schemas.xmlsoap.org/soap/envelope/' ];
38    my $xsd  = [ xsd  => 'http://www.w3.org/2001/XMLSchema-instance' ];
39    
40  =head2 Inform  =head2 InformResponse
41    
42    $response->Inform( $state );    $response->InformResponse( $state );
43    
44  =cut  =cut
45    
46  sub Inform {  sub InformResponse {
47          my ( $self, $state ) = @_;          my ( $self, $state ) = @_;
48          $self->xml( $state, sub {          $self->xml( $state, sub {
49                  my ( $X, $state ) = @_;                  my ( $X, $state ) = @_;
# Line 67  sub GetRPCMethods { Line 67  sub GetRPCMethods {
67          });          });
68  };  };
69    
70    =head2 Reboot
71    
72      $response->Reboot( $state );
73    
74    =cut
75    
76    sub Reboot {
77            my ( $self, $state ) = @_;
78            $self->xml( $state, sub {
79                    my ( $X, $state ) = @_;
80                    $X->Reboot();
81            });
82    }
83    
84    =head2 GetParameterNames
85    
86      $response->GetParameterNames( $state, $ParameterPath, $NextLevel );
87    
88    =cut
89    
90    sub GetParameterNames {
91            my ( $self, $state, $ParameterPath, $NextLevel ) = @_;
92            $ParameterPath ||= '';  # all
93            $NextLevel ||= 0;               # all
94            warn "# GetParameterNames( '$ParameterPath', $NextLevel )\n" if $self->debug;
95            $self->xml( $state, sub {
96                    my ( $X, $state ) = @_;
97    
98                    $X->GetParameterNames( $cwmp,
99                            $X->ParameterPath( $cwmp, $ParameterPath ),
100                            $X->NextLevel( $cwmp, $NextLevel ),
101                    );
102            });
103    }
104    
105    =head2 GetParameterValues
106    
107      $response->GetParameterValues( $state, $ParameterNames );
108    
109    =cut
110    
111    sub GetParameterValues {
112            my $self = shift;
113            my $state = shift;
114            my @ParameterNames = @_;
115            confess "need ParameterNames" unless @ParameterNames;
116            warn "# GetParameterValues", dump( @ParameterNames ), "\n" if $self->debug;
117    
118            $self->xml( $state, sub {
119                    my ( $X, $state ) = @_;
120    
121                    $X->GetParameterValues( $cwmp,
122                            $X->ParameterNames( $cwmp,
123                                    map {
124                                            $X->string( $xsd, $_ )
125                                    } @ParameterNames
126                            )
127                    );
128            });
129    }
130    
131    =head2 xml
132    
133    Used to implement methods which modify just body of soap message.
134    For examples, see source of this module.
135    
136    =cut
137    
138  sub xml {  sub xml {
139          my $self = shift;          my $self = shift;
140    
# Line 77  sub xml { Line 145  sub xml {
145    
146          confess "no ID in state ", dump( $state ) unless ( $state->{ID} );          confess "no ID in state ", dump( $state ) unless ( $state->{ID} );
147    
148            #warn "state used to generate xml = ", dump( $state ) if $self->debug;
149    
150          my $X = XML::Generator->new(':pretty');          my $X = XML::Generator->new(':pretty');
151    
152          return $X->Envelope( $soap, { 'soap:encodingStyle' => "http://schemas.xmlsoap.org/soap/encoding/" },          return $X->Envelope( $soap, { 'soap:encodingStyle' => "http://schemas.xmlsoap.org/soap/encoding/" },
153                  $X->Header( $soap,                  $X->Header( $soap,
154                          $X->ID( $cwmp, { mustUnderstand => 1 }, $state->{ID} ),                          $X->ID( $cwmp, { mustUnderstand => 1 }, $state->{ID} ),
155                            $X->NoMoreRequests( $cwmp, $state->{NoMoreRequests} || 0 ),
156                  ),                  ),
157                  $X->Body( $soap, $closure->( $X, $state ) ),                  $X->Body( $soap, $closure->( $X, $state ) ),
158          );          );
Legend:
Removed from v.46  
changed lines
  Added in v.172
  ViewVC Help
Powered by ViewVC 1.1.26