/[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 40 by dpavlin, Tue Jun 19 17:29:07 2007 UTC revision 41 by dpavlin, Tue Jun 19 18:11:37 2007 UTC
# Line 8  use base qw/Class::Accessor/; Line 8  use base qw/Class::Accessor/;
8  __PACKAGE__->mk_accessors( qw/  __PACKAGE__->mk_accessors( qw/
9  debug  debug
10  port  port
11    sock
12  / );  / );
13    
14  use IO::Socket::INET;  use IO::Socket::INET;
# Line 51  sub run { Line 52  sub run {
52    
53                  warn "connection from ", $sock->peerhost, "\n";                  warn "connection from ", $sock->peerhost, "\n";
54    
55                    $self->sock( $sock );   # FIXME this will not work for multiple clients
56                  $self->process_request( $sock );                  $self->process_request( $sock );
57    
58                  warn "...another one bites a dust...\n";                  warn "...another one bites a dust...\n";
# Line 142  sub process_request { Line 144  sub process_request {
144    
145          my $response = CWMP::Response->new({ debug => $self->debug });          my $response = CWMP::Response->new({ debug => $self->debug });
146    
147          print $self->status(200), $self->content_type('text/xml; charset="utf-8"'), "\r\n";          $sock->print(
148                    $self->status(200),
149          print "Server: AcmeCWMP/42\r\nSOAPServer: AcmeCWMP/42\r\n";                  $self->content_type('text/xml; charset="utf-8"'),
150                    "Server: AcmeCWMP/42\r\n",
151                    "SOAPServer: AcmeCWMP/42\r\n"
152            );
153    
154          print "Set-Cookie: ID=" , $state->{ID}, "; path=/\r\n" if ( $state->{ID} );          $sock->print( "Set-Cookie: ID=" , $state->{ID}, "; path=/\r\n" ) if ( $state->{ID} );
155                    
156          my $xml = '';          my $xml = '';
157    
# Line 162  sub process_request { Line 167  sub process_request {
167                  warn ">>> empty response\n";                  warn ">>> empty response\n";
168          }          }
169    
170          print "Content-length: ", length( $xml ), "\r\n\r\n";          $sock->print( "Content-length: ", length( $xml ), "\r\n\r\n" );
171          print $xml or die "can't send response";          $sock->print( $xml ) or die "can't send response";
172    
173          warn "### request over";          warn "### request over";
174    
# Line 206  sub content_type { Line 211  sub content_type {
211    
212  sub error{  sub error{
213    my ($self, $number, $msg) = @_;    my ($self, $number, $msg) = @_;
214    print $self->status($number, $msg), "\r\n";    $self->sock->print( $self->status($number, $msg), "\r\n" );
215    warn "Error - $number - $msg\n";    warn "Error - $number - $msg\n";
216  }  }
217    
# Line 221  sub http_header { Line 226  sub http_header {
226    my $self = shift;    my $self = shift;
227    my $number = shift || 200;    my $number = shift || 200;
228    return if ! delete $self->{needs_header};    return if ! delete $self->{needs_header};
229    print "HTTP/1.0 $number\r\n";    $self->sock->Print("HTTP/1.0 $number\r\n");
230    return 1;    return 1;
231  }  }
232    
Legend:
Removed from v.40  
changed lines
  Added in v.41
  ViewVC Help
Powered by ViewVC 1.1.26