lib/CWMP/Response.pm

   1 package CWMP::Response;
   2
   3 use strict;
   4 use warnings;
   5
   6
   7 use base qw/Class::Accessor/;
   8 __PACKAGE__->mk_accessors( qw/debug/ );
   9
  10 use XML::Generator;
  11 use Carp qw/confess/;
  12 use Data::Dump qw/dump/;
  13
  14 =head1 NAME
  15
  16 CWMP::Response - generate SOAP meesage for response
  17
  18 =head2 METHODS
  19
  20 =head2 new
  21
  22   my $response = CWMP::Response->new({ debug => 1 });
  23
  24 =cut
  25
  26 sub new {
  27         my $class = shift;
  28         my $self = $class->SUPER::new( @_ );
  29
  30         warn "created XML::Generator object\n" if $self->debug;
  31
  32         return $self;
  33 }
  34
  35
  36 my $cwmp = [ cwmp => 'urn:dslforum-org:cwmp-1-0' ];
  37 my $soap = [ soap => "http://schemas.xmlsoap.org/soap/envelope/" ];
  38
  39 =head2 InformResponse
  40
  41   $response->InformResponse( $state );
  42
  43 =cut
  44
  45 sub InformResponse {
  46         my ( $self, $state ) = @_;
  47         $self->xml( $state, sub {
  48                 my ( $X, $state ) = @_;
  49                 $X->InformResponse( $cwmp,
  50                         $X->MaxEnvelopes( $cwmp, 1 )
  51                 );
  52         });
  53 }
  54
  55 =head2 GetRPCMethods
  56
  57   $response->GetRPCMethods( $state );
  58
  59 =cut
  60
  61 sub GetRPCMethods {
  62         my ( $self, $state ) = @_;
  63         $self->xml( $state, sub {
  64                 my ( $X, $state ) = @_;
  65                 $X->GetRPCMethods();
  66         });
  67 };
  68
  69 =head2 Reboot
  70
  71   $response->Reboot( $state );
  72
  73 =cut
  74
  75 sub Reboot {
  76         my ( $self, $state ) = @_;
  77         $self->xml( $state, sub {
  78                 my ( $X, $state ) = @_;
  79                 $X->Reboot();
  80         });
  81 }
  82
  83 =head2 GetParameterNames
  84
  85   $response->GetParameterNames( $state, $ParameterPath, $NextLevel );
  86
  87 =cut
  88
  89 sub GetParameterNames {
  90         my ( $self, $state, $ParameterPath, $NextLevel ) = @_;
  91         $ParameterPath ||= '';  # all
  92         $NextLevel ||= 0;               # all
  93         warn "# GetParameterNames( '$ParameterPath', $NextLevel )\n" if $self->debug;
  94         $self->xml( $state, sub {
  95                 my ( $X, $state ) = @_;
  96
  97                 $X->GetParameterNames( $cwmp,
  98                         $X->ParameterPath( $cwmp, $ParameterPath ),
  99                         $X->NextLevel( $cwmp, $NextLevel ),
 100                 );
 101         });
 102 }
 103
 104 =head2 GetParameterValues
 105
 106   $response->GetParameterValues( $state, $ParameterPath, $NextLevel );
 107
 108 =cut
 109
 110 sub GetParameterValues {
 111         my ( $self, $state, $ParameterPath, $NextLevel ) = @_;
 112         $ParameterPath ||= '';  # all
 113         $NextLevel ||= 0;               # all
 114         warn "# GetParameterValues( '$ParameterPath', $NextLevel )\n" if $self->debug;
 115         $self->xml( $state, sub {
 116                 my ( $X, $state ) = @_;
 117
 118                 $X->GetParameterValues( $cwmp,
 119                         $X->ParameterPath( $cwmp, $ParameterPath ),
 120                         $X->NextLevel( $cwmp, $NextLevel ),
 121                 );
 122         });
 123 }
 124
 125 =head2 xml
 126
 127 Used to implement methods which modify just body of soap message.
 128 For examples, see source of this module.
 129
 130 =cut
 131
 132 sub xml {
 133         my $self = shift;
 134
 135         my ( $state, $closure ) = @_;
 136
 137         confess "no state?" unless ($state);
 138         confess "no body closure" unless ( $closure );
 139
 140         confess "no ID in state ", dump( $state ) unless ( $state->{ID} );
 141
 142         #warn "state used to generate xml = ", dump( $state ) if $self->debug;
 143
 144         my $X = XML::Generator->new(':pretty');
 145
 146         return $X->Envelope( $soap, { 'soap:encodingStyle' => "http://schemas.xmlsoap.org/soap/encoding/" },
 147                 $X->Header( $soap,
 148                         $X->ID( $cwmp, { mustUnderstand => 1 }, $state->{ID} ),
 149                         $X->NoMoreRequests( $cwmp, $state->{NoMoreRequests} || 0 ),
 150                 ),
 151                 $X->Body( $soap, $closure->( $X, $state ) ),
 152         );
 153 }
 154
 155 1;