/[cwmp]/google/lib/CWMP/Server.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /google/lib/CWMP/Server.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 30 by dpavlin, Mon Jun 18 19:16:28 2007 UTC revision 34 by dpavlin, Tue Jun 19 00:03:56 2007 UTC
# Line 5  use strict; Line 5  use strict;
5  use warnings;  use warnings;
6    
7  use base qw/HTTP::Server::Simple::CGI Class::Accessor/;  use base qw/HTTP::Server::Simple::CGI Class::Accessor/;
   
8  __PACKAGE__->mk_accessors( qw/  __PACKAGE__->mk_accessors( qw/
9  debug  debug
10  / );  / );
11    
   
12  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
13    
14    =head1 NAME
15    
16    CWMP::Server - implement logic of CWMP protocol
17    
18    =head1 METHODS
19    
20    =head2 handler
21    
22    We override L<HTTP::Server::Simple::CGI/handler> so that we can support
23    chunked transfer encoding.
24    
25    =cut
26    
27  sub handler {  sub handler {
28      my $self = shift;      my $self = shift;
29    
# Line 22  sub handler { Line 33  sub handler {
33    
34          if ( $transfer_encoding && $transfer_encoding =~ qr/^chunked/i ) {          if ( $transfer_encoding && $transfer_encoding =~ qr/^chunked/i ) {
35    
36                  my $last = 0;                  my $len = 0;
37                  do {                  do {
38                          my $len = <STDIN>;                          $len = <STDIN>;
39                          $len =~ s/[\n\r]*$//s;                          $len =~ s/[\n\r]*$//s;
40                          $len = hex( $len );                          $len = hex( $len );
41    
42                          $last = 1 if ( $len == 0 );                          #warn "getting chunk of $len bytes\n";
   
                         warn "getting chunk of $len bytes\n";  
43    
44                          while( $len > 0 ) {                          while( $len > 0 ) {
45                                  my $line = <STDIN>;                                  my $line = <STDIN>;
# Line 38  sub handler { Line 47  sub handler {
47                                  $len -= length( $line );                                  $len -= length( $line );
48                          }                          }
49    
50                  } while ( ! $last );                  } while ( $len > 0 );
51          }          }
52    
53          warn "chunk (", length($chunk), " bytes)\n------>>\n$chunk\n<<-----\n";          warn "got ", length($chunk), " bytes\n" if $self->debug;
54    
55      my $cgi  = new CGI( $chunk );      my $cgi  = new CGI( $chunk );
56    
# Line 52  sub handler { Line 61  sub handler {
61      }      }
62  }  }
63    
64    =head2 handle_request
65    
66    Implementation of dispatch logic
67    
68    =cut
69    
70  sub handle_request {  sub handle_request {
71          my ($self, $cgi) = @_;          my ($self, $cgi) = @_;
72                                                                                                                                            
73          #... do something, print output to default          #... do something, print output to default
74          # selected filehandle...          # selected filehandle...
75    
76          warn ">> ", $ENV{REMOTE_ADDR}, $/;          warn ">> " . localtime() . " " . $ENV{REMOTE_ADDR} . "\n";
77    
78          warn "not SOAP request" unless defined ( $cgi->header('SOAPAction') );          warn "not SOAP request" unless defined ( $cgi->header('SOAPAction') );
79    
80  #       warn $cgi->param('POSTDATA'), dump( $cgi );          if ( my $payload = $cgi->param('POSTDATA') ) {
81                    warn "request payload:\n$payload\n" if $self->debug;
82    
83                    my $state = CWMP::Request->parse( $payload );
84    
85                    warn "acquired state = ", dump( $state );
86            
87            }
88    
89            my $response = CWMP::Server->new({ debug => $self->debug });
90    
91          print "Content-Type: text/xml\r\n\r\n";          print "Content-Type: text/xml\r\n\r\n";
92    
93            print $response->Inform;
94            
95  };  };
96    
97  1;  1;
Legend:
Removed from v.30  
changed lines
  Added in v.34
  ViewVC Help
Powered by ViewVC 1.1.26