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 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	package CWMP::Response;
2
3	use strict;
4	use warnings;
5
6	use base qw/Class::Accessor/;
7	__PACKAGE__->add_accessor( qw/
8	debug
9	/);
10
11	use XML::Generator;
12	use Carp qw/confess/;
13	use Data::Dump qw/dump/;
14
15	=head1 NAME
16
17	CWMP::Response - generate SOAP meesage for response
18
19	=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	my $cwmp = [ cwmp => 'urn:dslforum-org:cwmp-1-0' ];
38	my $soap = [ soap => "http://schemas.xmlsoap.org/soap/envelope/" ];
39
40	=head2 Inform
41
42	$response->Inform( $state );
43
44	=cut
45
46	sub Inform {
47	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	=head2 xml
71
72	Used to implement methods which modify just body of soap message.
73	For examples, see source of this module.
74
75	=cut
76
77	sub xml {
78	my $self = shift;
79
80	my ( $state, $closure ) = @_;
81
82	confess "no state?" unless ($state);
83	confess "no body closure" unless ( $closure );
84
85	confess "no ID in state ", dump( $state ) unless ( $state->{ID} );
86
87	warn "state used to generate xml = " . dump( $state ) if $self->debug;
88
89	my $X = XML::Generator->new(':pretty');
90
91	return $X->Envelope( $soap, { 'soap:encodingStyle' => "http://schemas.xmlsoap.org/soap/encoding/" },
92	$X->Header( $soap,
93	$X->ID( $cwmp, { mustUnderstand => 1 }, $state->{ID} ),
94	$X->NoMoreRequests( $cwmp, $state->{NoMoreRequests} \|\| 0 ),
95	),
96	$X->Body( $soap, $closure->( $X, $state ) ),
97	);
98	}
99
100	1;