lib/CWMP/Session.pm

# Dobrica Pavlinusic, <dpavlin@rot13.org> 06/18/07 10:19:50 CEST
package CWMP::Server;

use strict;
use warnings;

use base qw/HTTP::Server::Simple::CGI Class::Accessor/;

__PACKAGE__->mk_accessors( qw/
debug
/ );


use Data::Dump qw/dump/;

sub handler {
    my $self = shift;

    my $chunk;

        my $transfer_encoding = $self->header('Transfer-Encoding');

        if ( $transfer_encoding && $transfer_encoding =~ qr/^chunked/i ) {

                my $len = 0;
                do {
                        $len = <STDIN>;
                        $len =~ s/[\n\r]*$//s;
                        $len = hex( $len );

                        #warn "getting chunk of $len bytes\n";

                        while( $len > 0 ) {
                                my $line = <STDIN>;
                                $chunk .= $line;
                                $len -= length( $line );
                        }

                } while ( $len > 0 );
        }

        warn "got ", length($chunk), " bytes\n";

    my $cgi  = new CGI( $chunk );

    eval { $self->handle_request($cgi) };
    if ($@) {
        my $error = $@;
        warn $error;
    }
}

sub handle_request {
        my ($self, $cgi) = @_;
                                                                    
        #... do something, print output to default
        # selected filehandle...

        warn ">> ", $ENV{REMOTE_ADDR}, $/;

        warn "not SOAP request" unless defined ( $cgi->header('SOAPAction') );

#       warn $cgi->param('POSTDATA'), dump( $cgi );

        print "Content-Type: text/xml\r\n\r\n";

};

1;

1	dpavlin	30	# Dobrica Pavlinusic, <dpavlin@rot13.org> 06/18/07 10:19:50 CEST
2			package CWMP::Server;
3
4			use strict;
5			use warnings;
6
7			use base qw/HTTP::Server::Simple::CGI Class::Accessor/;
8
9			__PACKAGE__->mk_accessors( qw/
10			debug
11			/ );
12
13
14			use Data::Dump qw/dump/;
15
16			sub handler {
17			my $self = shift;
18
19			my $chunk;
20
21			my $transfer_encoding = $self->header('Transfer-Encoding');
22
23			if ( $transfer_encoding && $transfer_encoding =~ qr/^chunked/i ) {
24
25	dpavlin	31	my $len = 0;
26	dpavlin	30	do {
27	dpavlin	31	$len = <STDIN>;
28	dpavlin	30	$len =~ s/[\n\r]*$//s;
29			$len = hex( $len );
30
31	dpavlin	31	#warn "getting chunk of $len bytes\n";
32	dpavlin	30
33			while( $len > 0 ) {
34			my $line = <STDIN>;
35			$chunk .= $line;
36			$len -= length( $line );
37			}
38
39	dpavlin	31	} while ( $len > 0 );
40	dpavlin	30	}
41
42	dpavlin	31	warn "got ", length($chunk), " bytes\n";
43	dpavlin	30
44			my $cgi = new CGI( $chunk );
45
46			eval { $self->handle_request($cgi) };
47			if ($@) {
48			my $error = $@;
49			warn $error;
50			}
51			}
52
53			sub handle_request {
54			my ($self, $cgi) = @_;
55
56			#... do something, print output to default
57			# selected filehandle...
58
59			warn ">> ", $ENV{REMOTE_ADDR}, $/;
60
61			warn "not SOAP request" unless defined ( $cgi->header('SOAPAction') );
62
63			# warn $cgi->param('POSTDATA'), dump( $cgi );
64
65			print "Content-Type: text/xml\r\n\r\n";
66
67			};
68
69			1;
70