get metaclass using preferred mechanism, via Moose
[catagits/Catalyst-Runtime.git] / lib / Catalyst / Request.pm
index 6d14c5b..f75319b 100644 (file)
@@ -14,10 +14,45 @@ use namespace::clean -except => 'meta';
 
 with 'MooseX::Emulate::Class::Accessor::Fast';
 
+has env => (is => 'ro', writer => '_set_env');
+# XXX Deprecated crap here - warn?
 has action => (is => 'rw');
+# XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
+# to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
+has user => (is => 'rw');
+sub snippets        { shift->captures(@_) }
+
+has _read_position => (
+    # FIXME: work around Moose bug RT#75367
+    # init_arg => undef,
+    is => 'ro',
+    writer => '_set_read_position',
+    default => 0,
+);
+has _read_length => (
+    # FIXME: work around Moose bug RT#75367
+    # init_arg => undef,
+    is => 'ro',
+    default => sub {
+        my $self = shift;
+        $self->header('Content-Length') || 0;
+    },
+    lazy => 1,
+);
+
 has address => (is => 'rw');
 has arguments => (is => 'rw', default => sub { [] });
-has cookies => (is => 'rw', default => sub { {} });
+has cookies => (is => 'ro', builder => 'prepare_cookies', lazy => 1);
+
+sub prepare_cookies {
+    my ( $self ) = @_;
+
+    if ( my $header = $self->header('Cookie') ) {
+        return { CGI::Simple::Cookie->parse($header) };
+    }
+    {};
+}
+
 has query_keywords => (is => 'rw');
 has match => (is => 'rw');
 has method => (is => 'rw');
@@ -31,23 +66,93 @@ has headers => (
   is      => 'rw',
   isa     => 'HTTP::Headers',
   handles => [qw(content_encoding content_length content_type header referer user_agent)],
-  default => sub { HTTP::Headers->new() },
-  required => 1,
+  builder => 'prepare_headers',
   lazy => 1,
 );
 
-has _context => (
-  is => 'rw',
-  weak_ref => 1,
-  handles => ['read'],
-  clearer => '_clear_context',
+sub prepare_headers {
+    my ($self) = @_;
+
+    my $env = $self->env;
+    my $headers = HTTP::Headers->new();
+
+    for my $header (keys %{ $env }) {
+        next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i;
+        (my $field = $header) =~ s/^HTTPS?_//;
+        $field =~ tr/_/-/;
+        $headers->header($field => $env->{$header});
+    }
+    return $headers;
+}
+
+has _log => (
+    is => 'ro',
+    weak_ref => 1,
+    required => 1,
 );
 
+has io_fh => (
+  is=>'ro',
+  predicate=>'has_io_fh',
+  lazy=>1,
+  builder=>'_build_io_fh');
+
+sub _build_io_fh {
+    my $self = shift;
+    return $self->env->{'psgix.io'}
+      || die "Your Server does not support psgix.io";
+};
+
+has body_fh => (
+  is=>'ro',
+  predicate=>'has_body_fh',
+  lazy=>1,
+  builder=>'_build_body_fh');
+
+sub _build_body_fh {
+    (my $input_fh = shift->env->{'psgi.input'})->seek(0, 0);
+    return $input_fh;
+};
+
+# Amount of data to read from input on each pass
+our $CHUNKSIZE = 64 * 1024;
+
+sub read {
+    my ($self, $maxlength) = @_;
+    my $remaining = $self->_read_length - $self->_read_position;
+    $maxlength ||= $CHUNKSIZE;
+
+    # Are we done reading?
+    if ( $remaining <= 0 ) {
+        return;
+    }
+
+    my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
+    my $rc = $self->read_chunk( my $buffer, $readlen );
+    if ( defined $rc ) {
+        if (0 == $rc) { # Nothing more to read even though Content-Length
+                        # said there should be.
+            return;
+        }
+        $self->_set_read_position( $self->_read_position + $rc );
+        return $buffer;
+    }
+    else {
+        Catalyst::Exception->throw(
+            message => "Unknown error reading input: $!" );
+    }
+}
+
+sub read_chunk {
+    my $self = shift;
+    return $self->env->{'psgi.input'}->read(@_);
+}
+
 has body_parameters => (
   is => 'rw',
   required => 1,
   lazy => 1,
-  default => sub { {} },
+  builder => 'prepare_body_parameters',
 );
 
 has uploads => (
@@ -57,10 +162,10 @@ has uploads => (
 );
 
 has parameters => (
-  is => 'rw',
-  required => 1,
-  lazy => 1,
-  default => sub { {} },
+    is => 'rw',
+    lazy => 1,
+    builder => '_build_parameters',
+    clearer => '_clear_parameters',
 );
 
 # TODO:
@@ -71,17 +176,107 @@ has parameters => (
 #  these lazy build from there and kill all the direct hash access
 #  in Catalyst.pm and Engine.pm?
 
-before $_ => sub {
+sub prepare_parameters {
+    my ( $self ) = @_;
+    $self->_clear_parameters;
+    return $self->parameters;
+}
+
+
+
+sub _build_parameters {
+    my ( $self ) = @_;
+    my $parameters = {};
+    my $body_parameters = $self->body_parameters;
+    my $query_parameters = $self->query_parameters;
+    # We copy, no references
+    foreach my $name (keys %$query_parameters) {
+        my $param = $query_parameters->{$name};
+        $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param;
+    }
+
+    # Merge query and body parameters
+    foreach my $name (keys %$body_parameters) {
+        my $param = $body_parameters->{$name};
+        my @values = ref $param eq 'ARRAY' ? @$param : ($param);
+        if ( my $existing = $parameters->{$name} ) {
+          unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing));
+        }
+        $parameters->{$name} = @values > 1 ? \@values : $values[0];
+    }
+    $parameters;
+}
+
+has _uploadtmp => (
+    is => 'ro',
+    predicate => '_has_uploadtmp',
+);
+
+sub prepare_body {
+    my ( $self ) = @_;
+
+    if ( my $length = $self->_read_length ) {
+        unless ( $self->_body ) {
+            my $type = $self->header('Content-Type');
+            $self->_body(HTTP::Body->new( $type, $length ));
+            $self->_body->cleanup(1); # Make extra sure!
+            $self->_body->tmpdir( $self->_uploadtmp )
+              if $self->_has_uploadtmp;
+        }
+
+        # Check for definedness as you could read '0'
+        while ( defined ( my $buffer = $self->read() ) ) {
+            $self->prepare_body_chunk($buffer);
+        }
+
+        # paranoia against wrong Content-Length header
+        my $remaining = $length - $self->_read_position;
+        if ( $remaining > 0 ) {
+            Catalyst::Exception->throw(
+                "Wrong Content-Length value: $length" );
+        }
+    }
+    else {
+        # Defined but will cause all body code to be skipped
+        $self->_body(0);
+    }
+}
+
+sub prepare_body_chunk {
+    my ( $self, $chunk ) = @_;
+
+    $self->_body->add($chunk);
+}
+
+sub prepare_body_parameters {
+    my ( $self ) = @_;
+
+    $self->prepare_body if ! $self->_has_body;
+    return {} unless $self->_body;
+
+    return $self->_body->param;
+}
+
+sub prepare_connection {
     my ($self) = @_;
-    my $context = $self->_context || return;
-    $context->prepare_body;
-} for qw/parameters body_parameters/;
 
+    my $env = $self->env;
+
+    $self->address( $env->{REMOTE_ADDR} );
+    $self->hostname( $env->{REMOTE_HOST} )
+        if exists $env->{REMOTE_HOST};
+    $self->protocol( $env->{SERVER_PROTOCOL} );
+    $self->remote_user( $env->{REMOTE_USER} );
+    $self->method( $env->{REQUEST_METHOD} );
+    $self->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
+}
+
+# XXX - FIXME - method is here now, move this crap...
 around parameters => sub {
     my ($orig, $self, $params) = @_;
     if ($params) {
         if ( !ref $params ) {
-            $self->_context->log->warn(
+            $self->_log->warn(
                 "Attempt to retrieve '$params' with req->params(), " .
                 "you probably meant to call req->param('$params')"
             );
@@ -109,7 +304,7 @@ has _body => (
 #             and provide a custom reader..
 sub body {
   my $self = shift;
-  $self->_context->prepare_body();
+  $self->prepare_body unless ! $self->_has_body;
   croak 'body is a reader' if scalar @_;
   return blessed $self->_body ? $self->_body->body : $self->_body;
 }
@@ -126,17 +321,12 @@ has hostname => (
 
 has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
 
-# XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
-# to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
-has user => (is => 'rw');
-
 sub args            { shift->arguments(@_) }
 sub body_params     { shift->body_parameters(@_) }
 sub input           { shift->body(@_) }
 sub params          { shift->parameters(@_) }
 sub query_params    { shift->query_parameters(@_) }
 sub path_info       { shift->path(@_) }
-sub snippets        { shift->captures(@_) }
 
 =for stopwords param params
 
@@ -147,8 +337,7 @@ Catalyst::Request - provides information about the current client request
 =head1 SYNOPSIS
 
     $req = $c->request;
-    $req->action;
-    $req->address;
+    $req->address eq "127.0.0.1";
     $req->arguments;
     $req->args;
     $req->base;
@@ -175,7 +364,7 @@ Catalyst::Request - provides information about the current client request
     $req->read;
     $req->referer;
     $req->secure;
-    $req->captures; # previously knows as snippets
+    $req->captures;
     $req->upload;
     $req->uploads;
     $req->uri;
@@ -192,14 +381,6 @@ thus hiding the details of the particular engine implementation.
 
 =head1 METHODS
 
-=head2 $req->action
-
-[DEPRECATED] Returns the name of the requested action.
-
-
-Use C<< $c->action >> instead (which returns a
-L<Catalyst::Action|Catalyst::Action> object).
-
 =head2 $req->address
 
 Returns the IP address of the client.
@@ -480,6 +661,10 @@ Reads a chunk of data from the request body. This method is intended to be
 used in a while loop, reading $maxlength bytes on every call. $maxlength
 defaults to the size of the request if not specified.
 
+=head2 $req->read_chunk(\$buff, $max)
+
+Reads a chunk.
+
 You have to set MyApp->config(parse_on_demand => 1) to use this directly.
 
 =head2 $req->referer
@@ -489,11 +674,12 @@ Shortcut for $req->headers->referer. Returns the referring page.
 =head2 $req->secure
 
 Returns true or false, indicating whether the connection is secure
-(https). Note that the URI scheme (e.g., http vs. https) must be determined
-through heuristics, and therefore the reliability of $req->secure will depend
-on your server configuration. If you are serving secure pages on the standard
-SSL port (443) and/or setting the HTTPS environment variable, $req->secure
-should be valid.
+(https). The reliability of $req->secure may depend on your server
+configuration; Catalyst relies on PSGI to determine whether or not a
+request is secure (Catalyst looks at psgi.url_scheme), and different
+PSGI servers may make this determination in different ways (as by
+directly passing along information from the server, interpreting any of
+several HTTP headers, or using heuristics of their own).
 
 =head2 $req->captures
 
@@ -502,11 +688,6 @@ actions or regex captures.
 
     my @captures = @{ $c->request->captures };
 
-=head2 $req->snippets
-
-C<captures> used to be called snippets. This is still available for backwards
-compatibility, but is considered deprecated.
-
 =head2 $req->upload
 
 A convenient method to access $req->uploads.
@@ -688,6 +869,50 @@ Returns the value of the C<REMOTE_USER> environment variable.
 Shortcut to $req->headers->user_agent. Returns the user agent (browser)
 version string.
 
+=head2 $req->io_fh
+
+Returns a psgix.io bidirectional socket, if your server supports one.  Used for
+when you want to jailbreak out of PSGI and handle bidirectional client server
+communication manually, such as when you are using cometd or websockets.
+
+=head1 SETUP METHODS
+
+You should never need to call these yourself in application code,
+however they are useful if extending Catalyst by applying a request role.
+
+=head2 $self->prepare_headers()
+
+Sets up the C<< $res->headers >> accessor.
+
+=head2 $self->prepare_body()
+
+Sets up the body using L<HTTP::Body>
+
+=head2 $self->prepare_body_chunk()
+
+Add a chunk to the request body.
+
+=head2 $self->prepare_body_parameters()
+
+Sets up parameters from body.
+
+=head2 $self->prepare_cookies()
+
+Parse cookies from header. Sets up a L<CGI::Simple::Cookie> object.
+
+=head2 $self->prepare_connection()
+
+Sets up various fields in the request like the local and remote addresses,
+request method, hostname requested etc.
+
+=head2 $self->prepare_parameters()
+
+Ensures that the body has been parsed, then builds the parameters, which are
+combined from those in the request and those in the body.
+
+If parameters have already been set will clear the parameters and build them again.
+
+
 =head2 meta
 
 Provided by Moose