Changeset 13398

Timestamp:

06/07/08 20:00:14 (5 years ago)

Author:

nothingmuch

Message:

lazify uri, use URI::WithBase?, path/base are handled by uri

Location:

lang/perl/HTTP-Engine/branches/lazy_request/lib/HTTP/Engine

Files:

• Request.pm (modified) (6 diffs)
• RequestBuilder.pm (modified) (6 diffs)
• Types/Core.pm (modified) (2 diffs)

lang/perl/HTTP-Engine/branches/lazy_request/lib/HTTP/Engine/Request.pm

@@ -8 +8 @@
 use HTTP::Request;
 
+sub BUILD {
+    my ( $self, $param ) = @_;
+
+    foreach my $field qw(base path) {
+        if ( my $val = $param->{$field} ) {
+            $self->$field($val);
+        }
+    }
+}
+
 has request_builder => (
     isa => "HTTP::Engine::RequestBuilder",
@@ -49 +59 @@
     is      => 'rw',
     isa     => 'HashRef',
-    default => sub { {} },
-);
+    lazy_build => 1,
+);
+
+sub _build_query_parameters {
+    my $self = shift;
+    $self->uri->query_form_hash;
+}
 
 # https or not?
@@ -63 +78 @@
     isa    => Uri,
     coerce => 1,
-);
+    lazy_build => 1,
+    handles => [qw(base path)],
+);
+
+sub _build_uri {
+    my $self = shift;
+
+    if ( my $rb = $self->request_builder ) {
+        $rb->_build_uri($self);
+    } else {
+        URI::WithBase->new;
+    }
+}
 
 has user => ( is => 'rw', );
@@ -93 +120 @@
 # Contains the URI base. This will always have a trailing slash.
 # If your application was queried with the URI C<http://localhost:3000/some/path> then C<base> is C<http://localhost:3000/>.
-has base => (
-    is      => 'rw',
-    isa     => Uri,
-    trigger => sub {
-        my $self = shift;
-
-        if ( $self->uri ) {
-            $self->path; # clear cache.
-        }
-    },
-);
 
 has hostname => (
@@ -181 +197 @@
         $self->parameters->{$field} = [@_];
     }
-}
-
-
-sub path {
-    my ($self, $params) = @_;
-
-    if ($params) {
-        $self->uri->path($params);
-    } else {
-        return $self->{path} if $self->{path};
-    }
-
-    my $path     = $self->uri->path;
-    my $location = $self->base->path;
-    $path =~ s/^(\Q$location\E)?//;
-    $path =~ s/^\///;
-    $self->{path} = $path;
-
-    return $path;
 }
 
@@ -267 +264 @@
 
     unless ($location =~ m!^https?://!) {
-        my $base = $self->base;
-        my $url = sprintf '%s://%s', $base->scheme, $base->host;
-        unless (($base->scheme eq 'http' && $base->port eq '80') ||
-               ($base->scheme eq 'https' && $base->port eq '443')) {
-            $url .= ':' . $base->port;
-        }
-        $url .= $base->path;
-        $location = URI->new_abs($location, $url);
-    }
-    $location;
+        return URI->new( $location )->abs( $self->base );
+    } else {
+        return $location;
+    }
 }
 

lang/perl/HTTP-Engine/branches/lazy_request/lib/HTTP/Engine/RequestBuilder.pm

@@ -37 +37 @@
 
     # do build.
-    for my $method (qw( connection query_parameters path body parameters uploads )) {
+    for my $method (qw( connection body parameters uploads )) {
         my $method = "_prepare_$method";
         $self->$method($context);
@@ -55 +55 @@
     $req->secure(1) if $ENV{HTTPS} && uc $ENV{HTTPS} eq 'ON';
     $req->secure(1) if $ENV{SERVER_PORT} == 443;
-}
-
-sub _prepare_query_parameters  {
-    my($self, $c) = @_;
-    my $query_string = $ENV{QUERY_STRING};
-    return unless 
-        defined $query_string && length($query_string);
-
-    # replace semi-colons
-    $query_string =~ s/;/&/g;
-
-    my $uri = URI->new('', 'http');
-    $uri->query($query_string);
-    for my $key ( $uri->query_param ) {
-        my @vals = $uri->query_param($key);
-        $c->req->query_parameters->{$key} = @vals > 1 ? [@vals] : $vals[0];
-    }
 }
 
@@ -103 +86 @@
 }
 
-sub _prepare_path  {
-    my($self, $c) = @_;
-
-    my $req    = $c->req;
+sub _build_uri  {
+    my($self, $req) = @_;
 
     my $scheme = $req->secure ? 'https' : 'http';
@@ -132 +113 @@
     # sanitize the URI
     $uri = $uri->canonical;
-    $req->uri($uri);
 
     # set the base URI
@@ -139 +119 @@
     my $base = $uri->clone;
     $base->path_query($base_path);
-    $c->req->base($base);
+
+    return URI::WithBase->new($uri, $base);
 }
 
@@ -153 +134 @@
     $req->http_body( HTTP::Body->new($type, $self->read_length) );
     $req->http_body->{tmpdir} = $self->upload_tmp if $self->upload_tmp;
+
+    $self->_read_to_end($c);
+}
+
+sub _read_to_end {
+    my ( $self, $c ) = @_;
 
     if ($self->read_length > 0) {

lang/perl/HTTP-Engine/branches/lazy_request/lib/HTTP/Engine/Types/Core.pm

@@ -8 +8 @@
 use Class::MOP;
 use URI;
+use URI::WithBase;
+use URI::QueryParam;
 use HTTP::Headers;
 
@@ -27 +29 @@
 };
 
-class_type Uri, { class => "URI" };
+class_type Uri, { class => "URI::WithBase" };
 
-coerce Uri, from Str => via { URI->new($_) };
+coerce Uri, from Str => via { URI::WithBase->new($_) };
 
 class_type Header, { class => "HTTP::Headers" };