CWMP::Methods - generate SOAP meesages for CPE
-=head2 METHODS
+=head1 METHODS
=head2 new
- my $response = CWMP::Methods->new({ debug => 1 });
+ my $method = CWMP::Methods->new({ debug => 1 });
=cut
return $self;
}
+=head2 xml
+
+Used to implement methods which modify just body of soap message.
+For examples, see source of this module.
+
+=cut
my $cwmp = [ cwmp => 'urn:dslforum-org:cwmp-1-0' ];
my $soap = [ soap => 'http://schemas.xmlsoap.org/soap/envelope/' ];
my $xsd = [ xsd => 'http://www.w3.org/2001/XMLSchema-instance' ];
-=head2 InformResponse
+sub xml {
+ my $self = shift;
- $response->InformResponse( $state );
+ my ( $state, $closure ) = @_;
-=cut
+ confess "no state?" unless ($state);
+ confess "no body closure" unless ( $closure );
-sub InformResponse {
- my ( $self, $state ) = @_;
- $self->xml( $state, sub {
- my ( $X, $state ) = @_;
- $X->InformResponse( $cwmp,
- $X->MaxEnvelopes( $cwmp, 1 )
- );
- });
+ #warn "state used to generate xml = ", dump( $state ) if $self->debug;
+
+ my $X = XML::Generator->new(':pretty');
+
+ my @header;
+ push( @header, $X->ID( $cwmp, { mustUnderstand => 1 }, $state->{ID} )) if $state->{ID};
+ push( @header, $X->NoMoreRequests( $cwmp, $state->{NoMoreRequests} || 0 ));
+
+ return $X->Envelope( $soap, { 'soap:encodingStyle' => "http://schemas.xmlsoap.org/soap/encoding/" },
+ $X->Header( $soap, @header ),
+ $X->Body( $soap, $closure->( $X, $state ) ),
+ );
}
+=head1 CPE methods
+
=head2 GetRPCMethods
- $response->GetRPCMethods( $state );
+ $method->GetRPCMethods( $state );
=cut
my ( $self, $state ) = @_;
$self->xml( $state, sub {
my ( $X, $state ) = @_;
- $X->GetRPCMethods();
+ $X->GetRPCMethods( $cwmp, '' );
});
};
-=head2 Reboot
+=head2 SetParameterValues
- $response->Reboot( $state );
+ $method->SetParameterValues( $state, {
+ param1 => 'value1',
+ param2 => 'value2',
+ ...
+ });
+
+It doesn't support base64 encoding of values yet.
+
+To preserve data, it does support repeatable parametar names.
+Behaviour on this is not defined in protocol.
=cut
-sub Reboot {
- my ( $self, $state ) = @_;
+sub SetParameterValues {
+ my $self = shift;
+ my $state = shift;
+
+ confess "SetParameterValues needs parameters" unless @_;
+
+ my $params = shift || return;
+
+ warn "# SetParameterValues = ", dump( $params ), "\n" if $self->debug;
+
$self->xml( $state, sub {
my ( $X, $state ) = @_;
- $X->Reboot();
+
+ $X->SetParameterValues( $cwmp,
+ $X->ParameterList( [],
+ map {
+ $X->ParameterValueStruct( [],
+ $X->Name( [], $_ ),
+ $X->Value( [], $params->{$_} )
+ )
+ } sort keys %$params
+ ),
+ $X->ParameterKey( '' ),
+ );
+ });
+}
+
+
+=head2 GetParameterValues
+
+ $method->GetParameterValues( $state, [ 'ParameterName', ... ] );
+
+=cut
+
+sub _array_param {
+ my $v = shift;
+ confess "array_mandatory(",dump($v),") isn't ARRAY" unless ref($v) eq 'ARRAY';
+ return @$v;
+}
+
+sub GetParameterValues {
+ my $self = shift;
+ my $state = shift;
+ my @ParameterNames = _array_param(shift);
+ warn "# GetParameterValues", dump( @ParameterNames ), "\n" if $self->debug;
+
+ $self->xml( $state, sub {
+ my ( $X, $state ) = @_;
+
+ $X->GetParameterValues( $cwmp,
+ $X->ParameterNames( $cwmp,
+ map {
+ $X->string( $xsd, $_ )
+ } @ParameterNames
+ )
+ );
});
}
=head2 GetParameterNames
- $response->GetParameterNames( $state, $ParameterPath, $NextLevel );
+ $method->GetParameterNames( $state, [ $ParameterPath, $NextLevel ] );
=cut
sub GetParameterNames {
- my ( $self, $state, $ParameterPath, $NextLevel ) = @_;
- $ParameterPath ||= ''; # all
- $NextLevel ||= 0; # all
+ my ( $self, $state, $param ) = @_;
+ # default: all, all
+ my ( $ParameterPath, $NextLevel ) = _array_param( $param );
+ $ParameterPath ||= '';
+ $NextLevel ||= 0;
warn "# GetParameterNames( '$ParameterPath', $NextLevel )\n" if $self->debug;
$self->xml( $state, sub {
my ( $X, $state ) = @_;
});
}
-=head2 GetParameterValues
+=head2 GetParameterAttributes
- $response->GetParameterValues( $state, $ParameterNames );
+ $method->GetParameterAttributes( $state, [ $ParametarNames, ... ] );
=cut
-sub GetParameterValues {
- my $self = shift;
- my $state = shift;
- my @ParameterNames = @_;
- confess "need ParameterNames" unless @ParameterNames;
- warn "# GetParameterValues", dump( @ParameterNames ), "\n" if $self->debug;
+sub GetParameterAttributes {
+ my ( $self, $state, $param ) = @_;
+ my @ParameterNames = _array_param($param);
+
+ warn "# GetParameterAttributes", dump( @ParameterNames ), "\n" if $self->debug;
$self->xml( $state, sub {
my ( $X, $state ) = @_;
- $X->GetParameterValues( $cwmp,
+ $X->GetParameterAttributes( $cwmp,
$X->ParameterNames( $cwmp,
map {
$X->string( $xsd, $_ )
});
}
-=head2 xml
+=head2 Reboot
-Used to implement methods which modify just body of soap message.
-For examples, see source of this module.
+ $method->Reboot( $state );
=cut
-sub xml {
- my $self = shift;
+sub Reboot {
+ my ( $self, $state ) = @_;
+ $self->xml( $state, sub {
+ my ( $X, $state ) = @_;
+ $X->Reboot();
+ });
+}
- my ( $state, $closure ) = @_;
+=head2 FactoryReset
- confess "no state?" unless ($state);
- confess "no body closure" unless ( $closure );
+ $method->FactoryReset( $state );
- confess "no ID in state ", dump( $state ) unless ( $state->{ID} );
+=cut
- #warn "state used to generate xml = ", dump( $state ) if $self->debug;
+sub FactoryReset {
+ my ( $self, $state ) = @_;
+ $self->xml( $state, sub {
+ my ( $X, $state ) = @_;
+ $X->FactoryReset();
+ });
+}
- my $X = XML::Generator->new(':pretty');
- return $X->Envelope( $soap, { 'soap:encodingStyle' => "http://schemas.xmlsoap.org/soap/encoding/" },
- $X->Header( $soap,
- $X->ID( $cwmp, { mustUnderstand => 1 }, $state->{ID} ),
- $X->NoMoreRequests( $cwmp, $state->{NoMoreRequests} || 0 ),
- ),
- $X->Body( $soap, $closure->( $X, $state ) ),
- );
+=head1 Server methods
+
+
+=head2 InformResponse
+
+ $method->InformResponse( $state );
+
+=cut
+
+sub InformResponse {
+ my ( $self, $state ) = @_;
+ $self->xml( $state, sub {
+ my ( $X, $state ) = @_;
+ $X->InformResponse( $cwmp,
+ $X->MaxEnvelopes( $cwmp, 1 )
+ );
+ });
}
+=head1 BUGS
+
+All other methods are unimplemented.
+
+=cut
+
1;
projects / perl-cwmp.git / blobdiff