From: Dobrica Pavlinusic Date: Sun, 28 Oct 2007 16:39:58 +0000 (+0000) Subject: great API breaking update to version [0.07] X-Git-Url: http://git.rot13.org/?p=perl-cwmp.git;a=commitdiff_plain;h=f164de0a280f1ebcf8fd031f58ea917fb79bcedf great API breaking update to version [0.07] CWMP::Response (which somewhat made sense since it was response from server) is now called CWMP::Methods (to more closely match protocol terminology) git-svn-id: https://perl-cwmp.googlecode.com/svn/trunk@172 836a5e1a-633d-0410-964b-294494ad4392 --- diff --git a/Makefile.PL b/Makefile.PL index 7431569..31c79c4 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -3,7 +3,7 @@ use lib './lib'; use inc::Module::Install; name 'CWMP'; -version '0.06'; +version '0.07'; license 'GPL'; requires 'Net::Server'; requires 'HTTP::Daemon'; diff --git a/lib/CWMP.pod b/lib/CWMP.pod index c3591b3..0810a9c 100644 --- a/lib/CWMP.pod +++ b/lib/CWMP.pod @@ -4,6 +4,15 @@ CWMP - CPE WAN Management Protocol =head1 DESCRIPTION +This is free, open source implementation of + +DSL Forum: TR-069 - CPE WAN Management Protocol, May 2004 + +In essence, it's relaxed SOAP server which eats garbage and tries to produce +standard compliant results. + +Standard defines following methods: + CPE methods Responding Calling GetRPCMethods Required Optional @@ -32,6 +41,8 @@ CWMP - CPE WAN Management Protocol Kicked Optional Optional +To see implemented methods take a look in L + =head1 AUTHOR Dobrica Pavlinusic, C<< dpavlin@rot13.org >> diff --git a/lib/CWMP/Methods.pm b/lib/CWMP/Methods.pm new file mode 100644 index 0000000..f8bf3ae --- /dev/null +++ b/lib/CWMP/Methods.pm @@ -0,0 +1,161 @@ +package CWMP::Methods; + +use strict; +use warnings; + + +use base qw/Class::Accessor/; +__PACKAGE__->mk_accessors( qw/debug/ ); + +use XML::Generator; +use Carp qw/confess/; +use Data::Dump qw/dump/; + +=head1 NAME + +CWMP::Methods - generate SOAP meesages for CPE + +=head2 METHODS + +=head2 new + + my $response = CWMP::Methods->new({ debug => 1 }); + +=cut + +sub new { + my $class = shift; + my $self = $class->SUPER::new( @_ ); + + warn "created XML::Generator object\n" if $self->debug; + + return $self; +} + + +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 + + $response->InformResponse( $state ); + +=cut + +sub InformResponse { + my ( $self, $state ) = @_; + $self->xml( $state, sub { + my ( $X, $state ) = @_; + $X->InformResponse( $cwmp, + $X->MaxEnvelopes( $cwmp, 1 ) + ); + }); +} + +=head2 GetRPCMethods + + $response->GetRPCMethods( $state ); + +=cut + +sub GetRPCMethods { + my ( $self, $state ) = @_; + $self->xml( $state, sub { + my ( $X, $state ) = @_; + $X->GetRPCMethods(); + }); +}; + +=head2 Reboot + + $response->Reboot( $state ); + +=cut + +sub Reboot { + my ( $self, $state ) = @_; + $self->xml( $state, sub { + my ( $X, $state ) = @_; + $X->Reboot(); + }); +} + +=head2 GetParameterNames + + $response->GetParameterNames( $state, $ParameterPath, $NextLevel ); + +=cut + +sub GetParameterNames { + my ( $self, $state, $ParameterPath, $NextLevel ) = @_; + $ParameterPath ||= ''; # all + $NextLevel ||= 0; # all + warn "# GetParameterNames( '$ParameterPath', $NextLevel )\n" if $self->debug; + $self->xml( $state, sub { + my ( $X, $state ) = @_; + + $X->GetParameterNames( $cwmp, + $X->ParameterPath( $cwmp, $ParameterPath ), + $X->NextLevel( $cwmp, $NextLevel ), + ); + }); +} + +=head2 GetParameterValues + + $response->GetParameterValues( $state, $ParameterNames ); + +=cut + +sub GetParameterValues { + my $self = shift; + my $state = shift; + my @ParameterNames = @_; + confess "need ParameterNames" unless @ParameterNames; + 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 xml + +Used to implement methods which modify just body of soap message. +For examples, see source of this module. + +=cut + +sub xml { + my $self = shift; + + my ( $state, $closure ) = @_; + + confess "no state?" unless ($state); + confess "no body closure" unless ( $closure ); + + 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 ) ), + ); +} + +1; diff --git a/lib/CWMP/Response.pm b/lib/CWMP/Response.pm deleted file mode 100644 index 4094114..0000000 --- a/lib/CWMP/Response.pm +++ /dev/null @@ -1,161 +0,0 @@ -package CWMP::Response; - -use strict; -use warnings; - - -use base qw/Class::Accessor/; -__PACKAGE__->mk_accessors( qw/debug/ ); - -use XML::Generator; -use Carp qw/confess/; -use Data::Dump qw/dump/; - -=head1 NAME - -CWMP::Response - generate SOAP meesage for response - -=head2 METHODS - -=head2 new - - my $response = CWMP::Response->new({ debug => 1 }); - -=cut - -sub new { - my $class = shift; - my $self = $class->SUPER::new( @_ ); - - warn "created XML::Generator object\n" if $self->debug; - - return $self; -} - - -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 - - $response->InformResponse( $state ); - -=cut - -sub InformResponse { - my ( $self, $state ) = @_; - $self->xml( $state, sub { - my ( $X, $state ) = @_; - $X->InformResponse( $cwmp, - $X->MaxEnvelopes( $cwmp, 1 ) - ); - }); -} - -=head2 GetRPCMethods - - $response->GetRPCMethods( $state ); - -=cut - -sub GetRPCMethods { - my ( $self, $state ) = @_; - $self->xml( $state, sub { - my ( $X, $state ) = @_; - $X->GetRPCMethods(); - }); -}; - -=head2 Reboot - - $response->Reboot( $state ); - -=cut - -sub Reboot { - my ( $self, $state ) = @_; - $self->xml( $state, sub { - my ( $X, $state ) = @_; - $X->Reboot(); - }); -} - -=head2 GetParameterNames - - $response->GetParameterNames( $state, $ParameterPath, $NextLevel ); - -=cut - -sub GetParameterNames { - my ( $self, $state, $ParameterPath, $NextLevel ) = @_; - $ParameterPath ||= ''; # all - $NextLevel ||= 0; # all - warn "# GetParameterNames( '$ParameterPath', $NextLevel )\n" if $self->debug; - $self->xml( $state, sub { - my ( $X, $state ) = @_; - - $X->GetParameterNames( $cwmp, - $X->ParameterPath( $cwmp, $ParameterPath ), - $X->NextLevel( $cwmp, $NextLevel ), - ); - }); -} - -=head2 GetParameterValues - - $response->GetParameterValues( $state, $ParameterNames ); - -=cut - -sub GetParameterValues { - my $self = shift; - my $state = shift; - my @ParameterNames = @_; - confess "need ParameterNames" unless @ParameterNames; - 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 xml - -Used to implement methods which modify just body of soap message. -For examples, see source of this module. - -=cut - -sub xml { - my $self = shift; - - my ( $state, $closure ) = @_; - - confess "no state?" unless ($state); - confess "no body closure" unless ( $closure ); - - 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 ) ), - ); -} - -1; diff --git a/lib/CWMP/Session.pm b/lib/CWMP/Session.pm index 4df8709..fd50a53 100644 --- a/lib/CWMP/Session.pm +++ b/lib/CWMP/Session.pm @@ -21,7 +21,7 @@ use Carp qw/confess cluck croak/; use File::Slurp; use CWMP::Request; -use CWMP::Response; +use CWMP::Methods; use CWMP::Store; =head1 NAME @@ -192,7 +192,7 @@ sub dispatch { push @args, @a; } - my $response = CWMP::Response->new({ debug => $self->debug }); + my $response = CWMP::Methods->new({ debug => $self->debug }); if ( $response->can( $dispatch ) ) { warn ">>> dispatching to $dispatch\n"; diff --git a/t/00-load.t b/t/00-load.t index 89ef933..ccd135f 100755 --- a/t/00-load.t +++ b/t/00-load.t @@ -10,7 +10,7 @@ use blib; BEGIN { use_ok('CWMP::Server'); use_ok('CWMP::Request'); - use_ok('CWMP::Response'); + use_ok('CWMP::Methods'); use_ok('CWMP::Store'); } diff --git a/t/20-methods.t b/t/20-methods.t new file mode 100755 index 0000000..ac09cb9 --- /dev/null +++ b/t/20-methods.t @@ -0,0 +1,49 @@ +#!/usr/bin/perl +use strict; +use warnings; + +my $debug = shift @ARGV; + +use Test::More tests => 14; +use Data::Dump qw/dump/; +use Cwd qw/abs_path/; +use File::Slurp; +use blib; + +BEGIN { + use_ok('CWMP::Methods'); +} + +ok(my $abs_path = abs_path($0), "abs_path"); +$abs_path =~ s!/[^/]*$!/!; #!fix-vim + +ok( my $response = CWMP::Methods->new({ debug => $debug }), 'new' ); +isa_ok( $response, 'CWMP::Methods' ); + +sub check_response { + my $command = shift || die "no command?"; + + my $state = { + ID => 42, + }; + + diag "check_response $command",dump( 'state', @_ ) if $debug; + ok( my $xml = $response->$command( $state, @_ ), "generate response $command" . dump(@_) ); + + my $file = "$abs_path/response/$command.xml"; + + if ( ! -e $file ) { + diag "creating $file"; + write_file( $file, $xml ); + } + + my $template_xml = read_file( $file ) || die "can't read template xml $file: $!"; + + is( $xml, $template_xml, "compare $command" ); +} + +check_response( 'InformResponse' ); +check_response( 'GetRPCMethods' ); +check_response( 'Reboot' ); +check_response( 'GetParameterNames', 'InternetGatewayDevice.DeviceInfo.SerialNumber' ); +check_response( 'GetParameterValues', 'InternetGatewayDevice.DeviceInfo.SerialNumber', 'InternetGatewayDevice.DeviceInfo.VendorConfigFile.' ); diff --git a/t/20-response.t b/t/20-response.t deleted file mode 100755 index df885b8..0000000 --- a/t/20-response.t +++ /dev/null @@ -1,49 +0,0 @@ -#!/usr/bin/perl -use strict; -use warnings; - -my $debug = shift @ARGV; - -use Test::More tests => 14; -use Data::Dump qw/dump/; -use Cwd qw/abs_path/; -use File::Slurp; -use blib; - -BEGIN { - use_ok('CWMP::Response'); -} - -ok(my $abs_path = abs_path($0), "abs_path"); -$abs_path =~ s!/[^/]*$!/!; #!fix-vim - -ok( my $response = CWMP::Response->new({ debug => $debug }), 'new' ); -isa_ok( $response, 'CWMP::Response' ); - -sub check_response { - my $command = shift || die "no command?"; - - my $state = { - ID => 42, - }; - - diag "check_response $command",dump( 'state', @_ ) if $debug; - ok( my $xml = $response->$command( $state, @_ ), "generate response $command" . dump(@_) ); - - my $file = "$abs_path/response/$command.xml"; - - if ( ! -e $file ) { - diag "creating $file"; - write_file( $file, $xml ); - } - - my $template_xml = read_file( $file ) || die "can't read template xml $file: $!"; - - is( $xml, $template_xml, "compare $command" ); -} - -check_response( 'InformResponse' ); -check_response( 'GetRPCMethods' ); -check_response( 'Reboot' ); -check_response( 'GetParameterNames', 'InternetGatewayDevice.DeviceInfo.SerialNumber' ); -check_response( 'GetParameterValues', 'InternetGatewayDevice.DeviceInfo.SerialNumber', 'InternetGatewayDevice.DeviceInfo.VendorConfigFile.' );