--- google/lib/CWMP/Session.pm	2007/06/24 18:18:47	100
+++ google/lib/CWMP/Session.pm	2007/10/21 01:33:53	110
@@ -15,7 +15,7 @@
 store
 / );
 
-use IO::Socket::INET;
+use HTTP::Daemon;
 use Data::Dump qw/dump/;
 use Carp qw/confess cluck croak/;
 
@@ -32,13 +32,12 @@
 =head2 new
 
   my $server = CWMP::Session->new({
-  	sock => $io_socket_object,
+	sock => $io_socket_object,
 	store_path => 'state.db',
 	queue => [ qw/GetRPCMethods GetParameterNames/ ],
 	debug => 1,
   });
 
-
 =cut
 
 sub new {
@@ -74,71 +73,24 @@
 
 	my $sock = $self->sock || die "no sock?";
 
-	die "not IO::Socket::INET but ", ref( $sock ) unless ( ref($sock) eq 'Net::Server::Proto::TCP' );
+#	die "not IO::Socket::INET but ", ref( $sock ) unless ( ref($sock) eq 'Net::Server::Proto::TCP' );
 
 	if ( ! $sock->connected ) {
 		warn "SOCKET NOT CONNECTED\n";
 		return 0;
 	}
 
-	$sock->autoflush( 1 );
-	$sock->blocking( 1 );
-
-	### read the first line of response
-	my $line = $sock->getline;
-	return $self->error(400, "No Data") unless ( defined $line );
-
-	$line =~ s/[\r\n]+$//;
-	if ($line !~ /^ (\w+) \ + (\S+) \ + (HTTP\/1.\d) $ /x) {
-		warn "ERROR: $line\n";
-		return $self->error(400, "Bad request");
-	}
-	my ($method, $req, $protocol) = ($1, $2, $3);
-	warn "<<<< ", $sock->peerhost, " - - [" . localtime() . "] \"$method $req $protocol\"\n";
-
-	### read in other headers
-	$self->read_headers || return $self->error(400, "Strange headers");
-
-	### do we support the type
-#	if ($method !~ /GET|POST|HEAD/) {
-	if ($method !~ /POST/) {
-		return $self->error(400, "Unsupported Method");
-	}
-
-    my $chunk;
-	my $transfer_encoding = $self->header('Transfer-Encoding');
-
-	if ( $transfer_encoding && $transfer_encoding =~ qr/^chunked/i ) {
-
-		my $len = 0;
+	bless $sock, 'HTTP::Daemon::ClientConn';
 
-		do {
+	# why do I have to do this?
+	# solution from http://use.perl.org/~Matts/journal/12896
+	${*$sock}{'httpd_daemon'} = HTTP::Daemon->new;
 
-			warn "get chunk len\n" if $self->debug > 1;
-			
-			my $hex;
-			do {
-				$hex = $sock->getline;
-				$hex =~ s/[\n\r]+$//;
-			} until ( $hex ne '' );
+	my $r = $sock->get_request || confess "can't get_request";
 
-			die "chunk size not valid hex: $hex" unless ( $hex =~ m/^[0-9a-f]+$/i);
-			$len = hex( $hex );
+	warn "<<<< ", $sock->peerhost, " - - [" . localtime() . "] ", $r->method, " ", $r->uri, "\n";
 
-			warn "getting chunk of $len bytes\n" if $self->debug > 1;
-
-			$sock->read( my $buff, $len );
-			$chunk .= $buff;
-
-			warn "--- $len bytes: --=>||$buff||<=--\n" if $self->debug > 1;
-
-		} while ( $len > 0 );
-		my $sep = $sock->getline;
-		die "expected separator, not ", dump( $sep ) if ( $sep !~ m/^[\n\r]+$/ );
-
-	} else {
-		die "right now, we support only Transfer-Encoding: chunked";
-	}
+	my $chunk = $r->content;
 
 	my $size = length( $chunk );
 
@@ -148,7 +100,7 @@
 
 	if ( $size > 0 ) {
 
-		die "no SOAPAction header in ",dump($chunk) unless defined ( $self->header('SOAPAction') );
+		die "no SOAPAction header in ",dump($chunk) unless defined ( $r->header('SOAPAction') );
 
 
 		if ( $chunk ) {
@@ -228,45 +180,6 @@
 	}
 };
 
-=head2 read_headers
-
-parse headers from request
-
-=cut
-
-sub read_headers {
-  my $self = shift;
-
-  $self->{headers} = {};
-
-  while (defined($_ = $self->sock->getline)) {
-    s/[\r\n]+$//;
-    last unless length $_;
-	warn "-- $_\n" if $self->debug;
-    return 0 if ! /^ ([\w\-]+) :[\ \t]* (.*) $/x;
-    $self->{headers}->{$1} = $2;
-  }
-
-  return 1;
-}
-
-=head2 header
-
-Getter for specific header
-
-  $self->header('Cookies');
-
-=cut
-
-sub header {
-	my $self = shift;
-	my $header = shift || die "no header?";
-	if ( defined( $self->{headers}->{$header} )) {
-		return $self->{headers}->{$header};
-	} else {
-		return;
-	}
-}
 
 =head2 error