lib/CWMP/Methods.pm

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/" ];

=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, $ParameterPath, $NextLevel );

=cut

sub GetParameterValues {
        my ( $self, $state, $ParameterPath, $NextLevel ) = @_;
        $ParameterPath ||= '';  # all
        $NextLevel ||= 0;               # all
        warn "# GetParameterValues( '$ParameterPath', $NextLevel )\n" if $self->debug;
        $self->xml( $state, sub {
                my ( $X, $state ) = @_;

                $X->GetParameterValues( $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	106
7	dpavlin	32	use base qw/Class::Accessor/;
8	dpavlin	106	__PACKAGE__->mk_accessors( qw/debug/ );
9	dpavlin	31
10	dpavlin	38	use XML::Generator;
11			use Carp qw/confess/;
12			use Data::Dump qw/dump/;
13
14	dpavlin	32	=head1 NAME
15	dpavlin	31
16	dpavlin	32	CWMP::Response - generate SOAP meesage for response
17	dpavlin	31
18	dpavlin	32	=head2 METHODS
19
20			=head2 new
21
22			my $response = CWMP::Response->new({ debug => 1 });
23
24			=cut
25
26			sub new {
27			my $class = shift;
28			my $self = $class->SUPER::new( @_ );
29
30	dpavlin	71	warn "created XML::Generator object\n" if $self->debug;
31	dpavlin	32
32			return $self;
33			}
34
35
36	dpavlin	31	my $cwmp = [ cwmp => 'urn:dslforum-org:cwmp-1-0' ];
37			my $soap = [ soap => "http://schemas.xmlsoap.org/soap/envelope/" ];
38
39	dpavlin	71	=head2 InformResponse
40	dpavlin	31
41	dpavlin	71	$response->InformResponse( $state );
42	dpavlin	32
43			=cut
44
45	dpavlin	71	sub InformResponse {
46	dpavlin	46	my ( $self, $state ) = @_;
47			$self->xml( $state, sub {
48			my ( $X, $state ) = @_;
49			$X->InformResponse( $cwmp,
50			$X->MaxEnvelopes( $cwmp, 1 )
51			);
52			});
53			}
54
55			=head2 GetRPCMethods
56
57			$response->GetRPCMethods( $state );
58
59			=cut
60
61			sub GetRPCMethods {
62			my ( $self, $state ) = @_;
63			$self->xml( $state, sub {
64			my ( $X, $state ) = @_;
65			$X->GetRPCMethods();
66			});
67			};
68
69	dpavlin	166	=head2 Reboot
70	dpavlin	53
71			$response->Reboot( $state );
72
73			=cut
74
75			sub Reboot {
76			my ( $self, $state ) = @_;
77			$self->xml( $state, sub {
78			my ( $X, $state ) = @_;
79			$X->Reboot();
80			});
81			}
82
83	dpavlin	166	=head2 GetParameterNames
84	dpavlin	59
85	dpavlin	64	$response->GetParameterNames( $state, $ParameterPath, $NextLevel );
86	dpavlin	59
87			=cut
88
89			sub GetParameterNames {
90	dpavlin	64	my ( $self, $state, $ParameterPath, $NextLevel ) = @_;
91			$ParameterPath \|\|= ''; # all
92			$NextLevel \|\|= 0; # all
93			warn "# GetParameterNames( '$ParameterPath', $NextLevel )\n" if $self->debug;
94	dpavlin	59	$self->xml( $state, sub {
95			my ( $X, $state ) = @_;
96	dpavlin	64
97	dpavlin	59	$X->GetParameterNames( $cwmp,
98	dpavlin	64	$X->ParameterPath( $cwmp, $ParameterPath ),
99			$X->NextLevel( $cwmp, $NextLevel ),
100	dpavlin	59	);
101			});
102			}
103	dpavlin	61
104	dpavlin	166	=head2 GetParameterValues
105	oleide	141
106			$response->GetParameterValues( $state, $ParameterPath, $NextLevel );
107
108			=cut
109
110			sub GetParameterValues {
111			my ( $self, $state, $ParameterPath, $NextLevel ) = @_;
112			$ParameterPath \|\|= ''; # all
113			$NextLevel \|\|= 0; # all
114			warn "# GetParameterValues( '$ParameterPath', $NextLevel )\n" if $self->debug;
115			$self->xml( $state, sub {
116			my ( $X, $state ) = @_;
117
118			$X->GetParameterValues( $cwmp,
119			$X->ParameterPath( $cwmp, $ParameterPath ),
120			$X->NextLevel( $cwmp, $NextLevel ),
121			);
122			});
123			}
124
125	dpavlin	48	=head2 xml
126
127			Used to implement methods which modify just body of soap message.
128			For examples, see source of this module.
129
130			=cut
131
132	dpavlin	46	sub xml {
133	dpavlin	32	my $self = shift;
134
135	dpavlin	46	my ( $state, $closure ) = @_;
136	dpavlin	38
137	dpavlin	46	confess "no state?" unless ($state);
138			confess "no body closure" unless ( $closure );
139
140	dpavlin	38	confess "no ID in state ", dump( $state ) unless ( $state->{ID} );
141
142	dpavlin	53	#warn "state used to generate xml = ", dump( $state ) if $self->debug;
143	dpavlin	50
144	dpavlin	32	my $X = XML::Generator->new(':pretty');
145
146			return $X->Envelope( $soap, { 'soap:encodingStyle' => "http://schemas.xmlsoap.org/soap/encoding/" },
147	dpavlin	50	$X->Header( $soap,
148	dpavlin	38	$X->ID( $cwmp, { mustUnderstand => 1 }, $state->{ID} ),
149	dpavlin	50	$X->NoMoreRequests( $cwmp, $state->{NoMoreRequests} \|\| 0 ),
150	dpavlin	32	),
151	dpavlin	46	$X->Body( $soap, $closure->( $X, $state ) ),
152	dpavlin	32	);
153			}
154
155			1;