lib/CWMP/Response.pm

package CWMP::Response;

use strict;
use warnings;

use base qw/Class::Accessor/;
__PACKAGE__->add_accessor( 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" if $self->debug;

        return $self;
}


my $cwmp = [ cwmp => 'urn:dslforum-org:cwmp-1-0' ];
my $soap = [ soap => "http://schemas.xmlsoap.org/soap/envelope/" ];

=head2 Inform

  $response->Inform( $state );

=cut

sub Inform {
        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 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;
1	dpavlin	31	package CWMP::Response;
2
3			use strict;
4			use warnings;
5
6	dpavlin	32	use base qw/Class::Accessor/;
7			__PACKAGE__->add_accessor( qw/
8			debug
9			/);
10	dpavlin	31
11	dpavlin	38	use XML::Generator;
12			use Carp qw/confess/;
13			use Data::Dump qw/dump/;
14
15	dpavlin	32	=head1 NAME
16	dpavlin	31
17	dpavlin	32	CWMP::Response - generate SOAP meesage for response
18	dpavlin	31
19	dpavlin	32	=head2 METHODS
20
21			=head2 new
22
23			my $response = CWMP::Response->new({ debug => 1 });
24
25			=cut
26
27			sub new {
28			my $class = shift;
29			my $self = $class->SUPER::new( @_ );
30
31			warn "created XML::Generator object" if $self->debug;
32
33			return $self;
34			}
35
36
37	dpavlin	31	my $cwmp = [ cwmp => 'urn:dslforum-org:cwmp-1-0' ];
38			my $soap = [ soap => "http://schemas.xmlsoap.org/soap/envelope/" ];
39
40	dpavlin	32	=head2 Inform
41	dpavlin	31
42	dpavlin	38	$response->Inform( $state );
43	dpavlin	32
44			=cut
45
46			sub Inform {
47	dpavlin	46	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	dpavlin	53	=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	dpavlin	59	=head2 GetParameterNames {
85
86	dpavlin	64	$response->GetParameterNames( $state, $ParameterPath, $NextLevel );
87	dpavlin	59
88			=cut
89
90			sub GetParameterNames {
91	dpavlin	64	my ( $self, $state, $ParameterPath, $NextLevel ) = @_;
92			$ParameterPath \|\|= ''; # all
93			$NextLevel \|\|= 0; # all
94			warn "# GetParameterNames( '$ParameterPath', $NextLevel )\n" if $self->debug;
95	dpavlin	59	$self->xml( $state, sub {
96			my ( $X, $state ) = @_;
97	dpavlin	64
98	dpavlin	59	$X->GetParameterNames( $cwmp,
99	dpavlin	64	$X->ParameterPath( $cwmp, $ParameterPath ),
100			$X->NextLevel( $cwmp, $NextLevel ),
101	dpavlin	59	);
102			});
103			}
104	dpavlin	61
105	dpavlin	48	=head2 xml
106
107			Used to implement methods which modify just body of soap message.
108			For examples, see source of this module.
109
110			=cut
111
112	dpavlin	46	sub xml {
113	dpavlin	32	my $self = shift;
114
115	dpavlin	46	my ( $state, $closure ) = @_;
116	dpavlin	38
117	dpavlin	46	confess "no state?" unless ($state);
118			confess "no body closure" unless ( $closure );
119
120	dpavlin	38	confess "no ID in state ", dump( $state ) unless ( $state->{ID} );
121
122	dpavlin	53	#warn "state used to generate xml = ", dump( $state ) if $self->debug;
123	dpavlin	50
124	dpavlin	32	my $X = XML::Generator->new(':pretty');
125
126			return $X->Envelope( $soap, { 'soap:encodingStyle' => "http://schemas.xmlsoap.org/soap/encoding/" },
127	dpavlin	50	$X->Header( $soap,
128	dpavlin	38	$X->ID( $cwmp, { mustUnderstand => 1 }, $state->{ID} ),
129	dpavlin	50	$X->NoMoreRequests( $cwmp, $state->{NoMoreRequests} \|\| 0 ),
130	dpavlin	32	),
131	dpavlin	46	$X->Body( $soap, $closure->( $X, $state ) ),
132	dpavlin	32	);
133			}
134
135			1;