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