1 package Catalyst::Engine::HTTPEngine;
3 # Experimental HTTP::Engine engine
6 # * Lots of copying/reference going on between HTTP::Engine req/res and Catalyst req/res
9 # * Lots of test failures
13 use Data::Dump qw(dump);
17 use constant DEBUG => $ENV{CATALYST_HTTP_DEBUG} || 0;
20 my ( $self, $class, $port, $host, $options ) = @_;
24 $self->{appclass} = $class;
25 $self->{options} = $options;
27 my $addr = $host ? inet_aton($host) : INADDR_ANY;
28 if ( $addr eq INADDR_ANY ) {
29 require Sys::Hostname;
30 $host = lc Sys::Hostname::hostname();
33 $host = gethostbyaddr( $addr, AF_INET ) || inet_ntoa($addr);
36 my $engine = HTTP::Engine->new(
38 module => 'Standalone',
40 host => inet_ntoa($addr),
43 request_handler => sub {
44 $self->handler( $_[0] );
49 my $url = "http://$host";
50 $url .= ":$port" unless $port == 80;
52 print "You can connect to your server at $url\n";
58 my ( $self, $req ) = @_;
60 my $res = HTTP::Engine::Response->new;
62 # Pass control to Catalyst
63 $self->{appclass}->handle_request(
72 my ( $self, $c, %args ) = @_;
74 $c->{_ereq} = $args{req};
75 $c->{_eres} = $args{res};
78 sub prepare_connection {
79 my ( $self, $c ) = @_;
81 my $ci = $c->{_ereq}->connection_info;
82 my $request = $c->request;
84 $request->address( $ci->{address} );
88 $request->hostname( $ci->{address} );
89 $request->protocol( $ci->{protocol} );
90 $request->user( $ci->{user} );
91 $request->method( $ci->{method} );
93 # XXX $request->secure
96 sub prepare_query_parameters {
97 my ( $self, $c ) = @_;
99 my $ereq = $c->{_ereq};
101 return unless defined $ereq->uri->query;
103 # Check for keywords (no = signs)
104 # (yes, index() is faster than a regex :))
105 if ( index( $ereq->uri->query, '=' ) < 0 ) {
106 $c->request->query_keywords(
107 $self->unescape_uri( $ereq->uri->query )
112 $c->request->query_parameters( $ereq->query_parameters );
115 sub prepare_headers {
116 my ( $self, $c ) = @_;
118 $c->request->headers( $c->{_ereq}->headers );
121 sub prepare_cookies {
122 my ( $self, $c ) = @_;
124 $c->request->cookies( $c->{_ereq}->cookies );
128 my ( $self, $c ) = @_;
132 # XXX: cleaner way to get the main URI object?
133 $c->request->uri( $c->{_ereq}->uri->[0] );
135 $c->request->base( $c->{_ereq}->uri->base );
141 my ( $self, $c ) = @_;
143 if ( $c->request->content_length ) {
144 $c->request->{_body} = $c->{_ereq}->http_body;
147 $c->request->{_body} = 0;
151 sub prepare_body_parameters {
152 my ( $self, $c ) = @_;
154 return unless $c->request->{_body};
156 $c->request->body_parameters( $c->{_ereq}->body_parameters );
159 sub prepare_parameters {
160 my ( $self, $c ) = @_;
162 # XXX: HTTP::Engine loads HTTP::Body object when you call this,
163 # even if no Content-Length
164 $c->request->parameters( $c->{_ereq}->parameters );
167 sub prepare_uploads {
168 my ( $self, $c ) = @_;
170 return unless $c->request->{_body};
172 $c->request->uploads( $c->{_ereq}->uploads );
175 sub finalize_uploads {
176 my ( $self, $c ) = @_;
178 my $request = $c->request;
179 foreach my $key (keys %{ $request->uploads }) {
180 my $upload = $request->uploads->{$key};
181 unlink grep { -e $_ } map { $_->tempname }
182 (ref $upload eq 'ARRAY' ? @{$upload} : ($upload));
186 sub finalize_cookies {
187 my ( $self, $c ) = @_;
189 $c->{_eres}->cookies( $c->response->cookies );
192 sub finalize_headers {
193 my ( $self, $c ) = @_;
195 $c->{_eres}->status( $c->response->status );
196 $c->{_eres}->headers( $c->response->headers );
200 my ( $self, $c ) = @_;
202 $c->{_eres}->body( $c->response->body );
206 my ( $self, $str ) = @_;
208 $str =~ s/(?:%([0-9A-Fa-f]{2})|\+)/defined $1 ? chr(hex($1)) : ' '/eg;