/[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 35 by dpavlin, Tue Jun 19 00:18:56 2007 UTC revision 36 by dpavlin, Tue Jun 19 00:38:49 2007 UTC
# Line 12  debug Line 12  debug
12  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
13  use CWMP::Request;  use CWMP::Request;
14  use CWMP::Response;  use CWMP::Response;
15    use Carp qw/confess/;
16    
17  =head1 NAME  =head1 NAME
18    
# Line 76  sub handle_request { Line 77  sub handle_request {
77          #... do something, print output to default          #... do something, print output to default
78          # selected filehandle...          # selected filehandle...
79    
80          warn ">> " . localtime() . " " . $ENV{REMOTE_ADDR} . "\n";          warn "<<< " . localtime() . " " . $ENV{REMOTE_ADDR} . "\n";
81    
82          warn "not SOAP request" unless defined ( $cgi->header('SOAPAction') );          warn "not SOAP request" unless defined ( $cgi->header('SOAPAction') );
83    
84            my $state;
85    
86          if ( my $payload = $cgi->param('POSTDATA') ) {          if ( my $payload = $cgi->param('POSTDATA') ) {
87                  warn "request payload:\n$payload\n" if $self->debug;                  warn "request payload:\n$payload\n" if $self->debug;
88    
89                  my $state = CWMP::Request->parse( $payload );                  $state = CWMP::Request->parse( $payload );
90    
91                  warn "acquired state = ", dump( $state );                  warn "acquired state = ", dump( $state );
92                    
93            } else {
94                    warn "empty request\n";
95          }          }
96    
97          my $response = CWMP::Response->new({ debug => $self->debug });          my $response = CWMP::Response->new({ debug => $self->debug });
98    
99          print "Content-Type: text/xml\r\n\r\n";          print "Content-Type: text/xml\r\n\r\n";
100    
101          print $response->Inform;          if ( my $dispatch = $state->{_dispatch} ) {
102                    if ( $response->can( $dispatch ) ) {
103                            warn ">>> dispatching to $dispatch\n";
104                            print $response->$dispatch;
105                    } else {
106                            confess "can't dispatch to $dispatch";
107                    }
108            } else {
109                    warn ">>> empty response\n";
110            }
111                    
112  };  };
113    
Legend:
Removed from v.35  
changed lines
  Added in v.36
  ViewVC Help
Powered by ViewVC 1.1.26