X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=lib%2FCWMP%2FMethods.pm;h=585dcebfe4bfc57cb291b5d7e8939ac420a26b0a;hb=129255e972e244dd52982926ed3c391a6c73ffc8;hp=f8bf3aedd00a328f4ed30474d8e729546dd385ab;hpb=f164de0a280f1ebcf8fd031f58ea917fb79bcedf;p=perl-cwmp.git

diff --git a/lib/CWMP/Methods.pm b/lib/CWMP/Methods.pm
index f8bf3ae..585dceb 100644
--- a/lib/CWMP/Methods.pm
+++ b/lib/CWMP/Methods.pm
@@ -15,11 +15,11 @@ use Data::Dump qw/dump/;
 
 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
 
@@ -32,30 +32,45 @@ sub new {
 	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 )
-		);
-	});
+	confess "no ID in state ", dump( $state ) unless ( $state->{ID} );
+
+	#warn "state used to generate xml = ", dump( $state ) if $self->debug;
+
+	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 CPE methods
+
 =head2 GetRPCMethods
 
-  $response->GetRPCMethods( $state );
+  $method->GetRPCMethods( $state );
 
 =cut
 
@@ -67,30 +82,93 @@ sub GetRPCMethods {
 	});
 };
 
-=head2 Reboot
+=head2 SetParameterValues
+
+  $method->SetParameterValues( $state, {
+	param1 => 'value1',
+	param2 => 'value2',
+	...
+  });
 
-  $response->Reboot( $state );
+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( $cwmp,
+				$X->ParameterNames( $cwmp,
+					map {
+						$X->ParameterValueStruct( $cwmp,
+							$X->Name( $cwmp, $_ ),
+							$X->Value( $cwmp, $params->{$_} )
+						)
+					} sort keys %$params
+				)
+			)
+		);
+	});
+}
+
+
+=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 ) = @_;
@@ -102,23 +180,22 @@ sub GetParameterNames {
 	});
 }
 
-=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, $_ )
@@ -128,34 +205,44 @@ sub GetParameterValues {
 	});
 }
 
-=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 ) = @_;
 
-	confess "no state?" unless ($state);
-	confess "no body closure" unless ( $closure );
+=head1 Server methods
 
-	confess "no ID in state ", dump( $state ) unless ( $state->{ID} );
 
-	#warn "state used to generate xml = ", dump( $state ) if $self->debug;
+=head2 InformResponse
 
-	my $X = XML::Generator->new(':pretty');
+  $method->InformResponse( $state );
 
-	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 ) ),
-	);
+=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;