Date: Thursday January 3, 2002 @ 22:35
Author: matt
Update of /home/cvs/AxKitB2B/lib/AxKitB2B/Server/Service
In directory ted:/home/matt/Perl/AxKitB2B/lib/AxKitB2B/Server/Service
Modified Files:
HTTP.pm
Log Message:
More hacking on getting a pipeline setup
Index: HTTP.pm
===================================================================
RCS file: /home/cvs/AxKitB2B/lib/AxKitB2B/Server/Service/HTTP.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- HTTP.pm 2002/01/03 17:30:19 1.2
+++ HTTP.pm 2002/01/03 22:35:05 1.3
@@ -1,4 +1,4 @@
-# $Id: HTTP.pm,v 1.2 2002/01/03 17:30:19 matt Exp $
+# $Id: HTTP.pm,v 1.3 2002/01/03 22:35:05 matt Exp $
package AxKitB2B::Server::Service::HTTP;
use strict;
@@ -26,6 +26,11 @@
my ($kernel, $heap, $uri) = @_[KERNEL, HEAP, ARG0];
# method is in $heap->{method}
+ my $sock = $heap->{socket_wheel};
+ return unless $sock;
+ $sock->event( InputState => 'ignore_data' );
+ $sock->set_filter( POE::Filter::Stream->new );
+
# now need to get app from configurator.
# TODO : this really should split the URI up, and go down and down
# until we find something, or nothing. As we go down the URI, we
@@ -44,6 +49,70 @@
}
}
+sub send_header {
+ my ($heap, $key, $value) = @_[HEAP, ARG0, ARG1];
+
+ my $sock = $heap->{socket_wheel};
+ return unless $sock;
+
+ if ($heap->{headers_sent}) {
+ # TODO do we want to log something here?
+ return;
+ }
+
+ push @{$heap->{output_headers_array}}, [ $key, $value ];
+ $heap->{output_headers}{lc($key)} = $value;
+}
+
+# TODO - lots to add here!!!
+my %single_headers = map { $_ => 1 } qw(
+ content-type
+);
+
+my %codes = (
+ 200 => 'OK',
+ 204 => 'No Content',
+ 404 => 'Not Found',
+ 500 => 'Internal Server Error',
+ 505 => 'HTTP Version not Supported',
+);
+
+sub send_headers {
+ my ($heap) = @_; # not a POE state/event!!!
+
+ return if $heap->{hearders_sent};
+
+ my $sock = $heap->{socket_wheel};
+ return unless $sock;
+
+ # TODO - send proper return code.
+ my $code = 200;
+ $sock->put("HTTP/$PROTOCOL_VERSION $code $codes{$code}\xD\xA");
+
+ foreach my $header (@{ $heap->{output_headers_array} }) {
+ my ($key, $value) = @$header;
+ if ($single_headers{$key}) {
+ $sock->put("$key: " . $heap->{output_headers}{lc($key)} . "\xD\xA");
+ }
+ else {
+ $sock->put("$key: $value\xD\xA");
+ }
+ }
+
+ $heap->{headers_sent}++;
+}
+
+sub send_body {
+ my ($kernel, $heap, $data) = @_[KERNEL, HEAP, ARG0];
+
+ send_headers($heap);
+
+ my $sock = $heap->{socket_wheel};
+ return unless $sock;
+
+ $sock->put($data);
+}
+
my %supported_protocol_versions = map { $_ => 1 }
qw(
1.0,
@@ -126,14 +195,6 @@
);
}
-my %codes = (
- 200 => 'OK',
- 204 => 'No Content',
- 404 => 'Not Found',
- 500 => 'Internal Server Error',
- 505 => 'HTTP Version not Supported',
-);
-
sub respond {
my ($kernel, $heap, $code, $headers, $body) =
@_[KERNEL, HEAP, ARG0, ARG1, ARG2];
@@ -169,6 +230,7 @@
sub socket_death {
my $heap = $_[HEAP];
+ send_headers($heap); # send if we have something to send
Logger->log({level => 'info', message => "Socket death"});
if($heap->{socket_wheel}) {
if ($heap->{socket_wheel}->get_driver_out_octets()) {
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
