lib/CWMP/Methods.pm

   1 package CWMP::Methods;
   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::Methods - generate SOAP meesages for CPE
  17
  18 =head2 METHODS
  19
  20 =head2 new
  21
  22   my $response = CWMP::Methods->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 my $xsd  = [ xsd  => 'http://www.w3.org/2001/XMLSchema-instance' ];
  39
  40 =head2 InformResponse
  41
  42   $response->InformResponse( $state );
  43
  44 =cut
  45
  46 sub InformResponse {
  47         my ( $self, $state ) = @_;
  48         $self->xml( $state, sub {
  49                 my ( $X, $state ) = @_;
  50                 $X->InformResponse( $cwmp,
  51                         $X->MaxEnvelopes( $cwmp, 1 )
  52                 );
  53         });
  54 }
  55
  56 =head2 GetRPCMethods
  57
  58   $response->GetRPCMethods( $state );
  59
  60 =cut
  61
  62 sub GetRPCMethods {
  63         my ( $self, $state ) = @_;
  64         $self->xml( $state, sub {
  65                 my ( $X, $state ) = @_;
  66                 $X->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 {
 139         my $self = shift;
 140
 141         my ( $state, $closure ) = @_;
 142
 143         confess "no state?" unless ($state);
 144         confess "no body closure" unless ( $closure );
 145
 146         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');
 151
 152         return $X->Envelope( $soap, { 'soap:encodingStyle' => "http://schemas.xmlsoap.org/soap/encoding/" },
 153                 $X->Header( $soap,
 154                         $X->ID( $cwmp, { mustUnderstand => 1 }, $state->{ID} ),
 155                         $X->NoMoreRequests( $cwmp, $state->{NoMoreRequests} || 0 ),
 156                 ),
 157                 $X->Body( $soap, $closure->( $X, $state ) ),
 158         );
 159 }
 160
 161 1;