1 package Catalyst::Request;
3 use IO::Socket qw[AF_INET inet_aton];
13 use namespace::clean -except => 'meta';
15 with 'MooseX::Emulate::Class::Accessor::Fast';
17 has env => (is => 'ro', writer => '_set_env');
18 # XXX Deprecated crap here - warn?
19 has action => (is => 'rw');
20 # XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
21 # to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
22 has user => (is => 'rw');
23 sub snippets { shift->captures(@_) }
25 has _read_position => (
28 writer => '_set_read_position',
36 $self->header('Content-Length') || 0;
41 has address => (is => 'rw');
42 has arguments => (is => 'rw', default => sub { [] });
43 has cookies => (is => 'ro', builder => 'prepare_cookies', lazy => 1);
48 if ( my $header = $self->header('Cookie') ) {
49 return { CGI::Simple::Cookie->parse($header) };
54 has query_keywords => (is => 'rw');
55 has match => (is => 'rw');
56 has method => (is => 'rw');
57 has protocol => (is => 'rw');
58 has query_parameters => (is => 'rw', default => sub { {} });
59 has secure => (is => 'rw', default => 0);
60 has captures => (is => 'rw', default => sub { [] });
61 has uri => (is => 'rw', predicate => 'has_uri');
62 has remote_user => (is => 'rw');
65 isa => 'HTTP::Headers',
66 handles => [qw(content_encoding content_length content_type header referer user_agent)],
67 builder => 'prepare_headers',
75 my $headers = HTTP::Headers->new();
77 for my $header (keys %{ $env }) {
78 next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i;
79 (my $field = $header) =~ s/^HTTPS?_//;
81 $headers->header($field => $env->{$header});
92 # Amount of data to read from input on each pass
93 our $CHUNKSIZE = 64 * 1024;
96 my ($self, $maxlength) = @_;
97 my $remaining = $self->_read_length - $self->_read_position;
98 $maxlength ||= $CHUNKSIZE;
100 # Are we done reading?
101 if ( $remaining <= 0 ) {
105 my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
106 my $rc = $self->read_chunk( my $buffer, $readlen );
108 if (0 == $rc) { # Nothing more to read even though Content-Length
109 # said there should be.
112 $self->_set_read_position( $self->_read_position + $rc );
116 Catalyst::Exception->throw(
117 message => "Unknown error reading input: $!" );
123 return $self->env->{'psgi.input'}->read(@_);
126 has body_parameters => (
130 builder => 'prepare_body_parameters',
136 default => sub { {} },
142 builder => 'prepare_parameters',
146 # - Can we lose the before modifiers which just call prepare_body ?
147 # they are wasteful, slow us down and feel cluttery.
149 # Can we make _body an attribute, have the rest of
150 # these lazy build from there and kill all the direct hash access
151 # in Catalyst.pm and Engine.pm?
153 sub prepare_parameters {
156 my $body_parameters = $self->body_parameters;
157 my $query_parameters = $self->query_parameters;
158 # We copy, no references
159 foreach my $name (keys %$query_parameters) {
160 my $param = $query_parameters->{$name};
161 $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param;
164 # Merge query and body parameters
165 foreach my $name (keys %$body_parameters) {
166 my $param = $body_parameters->{$name};
167 my @values = ref $param eq 'ARRAY' ? @$param : ($param);
168 if ( my $existing = $parameters->{$name} ) {
169 unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing));
171 $parameters->{$name} = @values > 1 ? \@values : $values[0];
178 predicate => '_has_uploadtmp',
184 if ( my $length = $self->_read_length ) {
185 unless ( $self->_body ) {
186 my $type = $self->header('Content-Type');
187 $self->_body(HTTP::Body->new( $type, $length ));
188 $self->_body->cleanup(1); # Make extra sure!
189 $self->_body->tmpdir( $self->_uploadtmp )
190 if $self->_has_uploadtmp;
193 # Check for definedness as you could read '0'
194 while ( defined ( my $buffer = $self->read() ) ) {
195 $self->prepare_body_chunk($buffer);
198 # paranoia against wrong Content-Length header
199 my $remaining = $length - $self->_read_position;
200 if ( $remaining > 0 ) {
201 Catalyst::Exception->throw(
202 "Wrong Content-Length value: $length" );
206 # Defined but will cause all body code to be skipped
211 sub prepare_body_chunk {
212 my ( $self, $chunk ) = @_;
214 $self->_body->add($chunk);
217 sub prepare_body_parameters {
220 $self->prepare_body if ! $self->_has_body;
221 return unless $self->_body;
223 return $self->_body->param;
226 sub prepare_connection {
229 my $env = $self->env;
231 $self->address( $env->{REMOTE_ADDR} );
232 $self->hostname( $env->{REMOTE_HOST} )
233 if exists $env->{REMOTE_HOST};
234 $self->protocol( $env->{SERVER_PROTOCOL} );
235 $self->remote_user( $env->{REMOTE_USER} );
236 $self->method( $env->{REQUEST_METHOD} );
237 $self->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
240 # XXX - FIXME - method is here now, move this crap...
241 around parameters => sub {
242 my ($orig, $self, $params) = @_;
244 if ( !ref $params ) {
246 "Attempt to retrieve '$params' with req->params(), " .
247 "you probably meant to call req->param('$params')"
251 return $self->$orig($params);
262 return $self->path if $self->has_uri;
267 is => 'rw', clearer => '_clear_body', predicate => '_has_body',
269 # Eugh, ugly. Should just be able to rename accessor methods to 'body'
270 # and provide a custom reader..
273 $self->prepare_body unless ! $self->_has_body;
274 croak 'body is a reader' if scalar @_;
275 return blessed $self->_body ? $self->_body->body : $self->_body;
284 gethostbyaddr( inet_aton( $self->address ), AF_INET ) || $self->address
288 has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
290 sub args { shift->arguments(@_) }
291 sub body_params { shift->body_parameters(@_) }
292 sub input { shift->body(@_) }
293 sub params { shift->parameters(@_) }
294 sub query_params { shift->query_parameters(@_) }
295 sub path_info { shift->path(@_) }
297 =for stopwords param params
301 Catalyst::Request - provides information about the current client request
306 $req->address eq "127.0.0.1";
311 $req->body_parameters;
312 $req->content_encoding;
313 $req->content_length;
321 $req->query_keywords;
329 $req->query_parameters;
340 See also L<Catalyst>, L<Catalyst::Request::Upload>.
344 This is the Catalyst Request class, which provides an interface to data for the
345 current client request. The request object is prepared by L<Catalyst::Engine>,
346 thus hiding the details of the particular engine implementation.
352 Returns the IP address of the client.
354 =head2 $req->arguments
356 Returns a reference to an array containing the arguments.
358 print $c->request->arguments->[0];
360 For example, if your action was
362 package MyApp::Controller::Foo;
368 and the URI for the request was C<http://.../foo/moose/bah>, the string C<bah>
369 would be the first and only argument.
371 Arguments get automatically URI-unescaped for you.
375 Shortcut for L</arguments>.
379 Contains the URI base. This will always have a trailing slash. Note that the
380 URI scheme (e.g., http vs. https) must be determined through heuristics;
381 depending on your server configuration, it may be incorrect. See $req->secure
384 If your application was queried with the URI
385 C<http://localhost:3000/some/path> then C<base> is C<http://localhost:3000/>.
389 Returns the message body of the request, as returned by L<HTTP::Body>: a string,
390 unless Content-Type is C<application/x-www-form-urlencoded>, C<text/xml>, or
391 C<multipart/form-data>, in which case a L<File::Temp> object is returned.
393 =head2 $req->body_parameters
395 Returns a reference to a hash containing body (POST) parameters. Values can
396 be either a scalar or an arrayref containing scalars.
398 print $c->request->body_parameters->{field};
399 print $c->request->body_parameters->{field}->[0];
401 These are the parameters from the POST part of the request, if any.
403 =head2 $req->body_params
405 Shortcut for body_parameters.
407 =head2 $req->content_encoding
409 Shortcut for $req->headers->content_encoding.
411 =head2 $req->content_length
413 Shortcut for $req->headers->content_length.
415 =head2 $req->content_type
417 Shortcut for $req->headers->content_type.
421 A convenient method to access $req->cookies.
423 $cookie = $c->request->cookie('name');
424 @cookies = $c->request->cookie;
432 return keys %{ $self->cookies };
439 unless ( exists $self->cookies->{$name} ) {
443 return $self->cookies->{$name};
449 Returns a reference to a hash containing the cookies.
451 print $c->request->cookies->{mycookie}->value;
453 The cookies in the hash are indexed by name, and the values are L<CGI::Simple::Cookie>
458 Shortcut for $req->headers->header.
462 Returns an L<HTTP::Headers> object containing the headers for the current request.
464 print $c->request->headers->header('X-Catalyst');
466 =head2 $req->hostname
468 Returns the hostname of the client. Use C<< $req->uri->host >> to get the hostname of the server.
472 Alias for $req->body.
474 =head2 $req->query_keywords
476 Contains the keywords portion of a query string, when no '=' signs are
479 http://localhost/path?some+keywords
481 $c->request->query_keywords will contain 'some keywords'
485 This contains the matching part of a Regex action. Otherwise
486 it returns the same as 'action', except for default actions,
487 which return an empty string.
491 Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
495 Returns GET and POST parameters with a CGI.pm-compatible param method. This
496 is an alternative method for accessing parameters in $c->req->parameters.
498 $value = $c->request->param( 'foo' );
499 @values = $c->request->param( 'foo' );
500 @params = $c->request->param;
502 Like L<CGI>, and B<unlike> earlier versions of Catalyst, passing multiple
503 arguments to this method, like this:
505 $c->request->param( 'foo', 'bar', 'gorch', 'quxx' );
507 will set the parameter C<foo> to the multiple values C<bar>, C<gorch> and
508 C<quxx>. Previously this would have added C<bar> as another value to C<foo>
509 (creating it if it didn't exist before), and C<quxx> as another value for
512 B<NOTE> this is considered a legacy interface and care should be taken when
513 using it. C<< scalar $c->req->param( 'foo' ) >> will return only the first
514 C<foo> param even if multiple are present; C<< $c->req->param( 'foo' ) >> will
515 return a list of as many are present, which can have unexpected consequences
516 when writing code of the form:
520 baz => $c->req->param( 'baz' ),
523 If multiple C<baz> parameters are provided this code might corrupt data or
524 cause a hash initialization error. For a more straightforward interface see
525 C<< $c->req->parameters >>.
533 return keys %{ $self->parameters };
540 unless ( exists $self->parameters->{$param} ) {
541 return wantarray ? () : undef;
544 if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
546 ? @{ $self->parameters->{$param} }
547 : $self->parameters->{$param}->[0];
551 ? ( $self->parameters->{$param} )
552 : $self->parameters->{$param};
557 $self->parameters->{$field} = [@_];
561 =head2 $req->parameters
563 Returns a reference to a hash containing GET and POST parameters. Values can
564 be either a scalar or an arrayref containing scalars.
566 print $c->request->parameters->{field};
567 print $c->request->parameters->{field}->[0];
569 This is the combination of C<query_parameters> and C<body_parameters>.
573 Shortcut for $req->parameters.
577 Returns the path, i.e. the part of the URI after $req->base, for the current request.
579 http://localhost/path/foo
581 $c->request->path will contain 'path/foo'
583 =head2 $req->path_info
585 Alias for path, added for compatibility with L<CGI>.
590 my ( $self, @params ) = @_;
593 $self->uri->path(@params);
596 elsif ( $self->_has_path ) {
600 my $path = $self->uri->path;
601 my $location = $self->base->path;
602 $path =~ s/^(\Q$location\E)?//;
610 =head2 $req->protocol
612 Returns the protocol (HTTP/1.0 or HTTP/1.1) used for the current request.
614 =head2 $req->query_parameters
616 =head2 $req->query_params
618 Returns a reference to a hash containing query string (GET) parameters. Values can
619 be either a scalar or an arrayref containing scalars.
621 print $c->request->query_parameters->{field};
622 print $c->request->query_parameters->{field}->[0];
624 =head2 $req->read( [$maxlength] )
626 Reads a chunk of data from the request body. This method is intended to be
627 used in a while loop, reading $maxlength bytes on every call. $maxlength
628 defaults to the size of the request if not specified.
630 =head2 $req->read_chunk(\$buff, $max)
634 You have to set MyApp->config(parse_on_demand => 1) to use this directly.
638 Shortcut for $req->headers->referer. Returns the referring page.
642 Returns true or false, indicating whether the connection is secure
643 (https). Note that the URI scheme (e.g., http vs. https) must be determined
644 through heuristics, and therefore the reliability of $req->secure will depend
645 on your server configuration. If you are serving secure pages on the standard
646 SSL port (443) and/or setting the HTTPS environment variable, $req->secure
649 =head2 $req->captures
651 Returns a reference to an array containing captured args from chained
652 actions or regex captures.
654 my @captures = @{ $c->request->captures };
658 A convenient method to access $req->uploads.
660 $upload = $c->request->upload('field');
661 @uploads = $c->request->upload('field');
662 @fields = $c->request->upload;
664 for my $upload ( $c->request->upload('field') ) {
665 print $upload->filename;
674 return keys %{ $self->uploads };
681 unless ( exists $self->uploads->{$upload} ) {
682 return wantarray ? () : undef;
685 if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
687 ? @{ $self->uploads->{$upload} }
688 : $self->uploads->{$upload}->[0];
692 ? ( $self->uploads->{$upload} )
693 : $self->uploads->{$upload};
699 while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
701 if ( exists $self->uploads->{$field} ) {
702 for ( $self->uploads->{$field} ) {
703 $_ = [$_] unless ref($_) eq "ARRAY";
704 push( @$_, $upload );
708 $self->uploads->{$field} = $upload;
716 Returns a reference to a hash containing uploads. Values can be either a
717 L<Catalyst::Request::Upload> object, or an arrayref of
718 L<Catalyst::Request::Upload> objects.
720 my $upload = $c->request->uploads->{field};
721 my $upload = $c->request->uploads->{field}->[0];
725 Returns a L<URI> object for the current request. Stringifies to the URI text.
727 =head2 $req->mangle_params( { key => 'value' }, $appendmode);
729 Returns a hashref of parameters stemming from the current request's params,
730 plus the ones supplied. Keys for which no current param exists will be
731 added, keys with undefined values will be removed and keys with existing
732 params will be replaced. Note that you can supply a true value as the final
733 argument to change behavior with regards to existing parameters, appending
734 values rather than replacing them.
738 # URI query params foo=1
739 my $hashref = $req->mangle_params({ foo => 2 });
740 # Result is query params of foo=2
744 # URI query params foo=1
745 my $hashref = $req->mangle_params({ foo => 2 }, 1);
746 # Result is query params of foo=1&foo=2
748 This is the code behind C<uri_with>.
753 my ($self, $args, $append) = @_;
755 carp('No arguments passed to mangle_params()') unless $args;
757 foreach my $value ( values %$args ) {
758 next unless defined $value;
759 for ( ref $value eq 'ARRAY' ? @$value : $value ) {
761 utf8::encode( $_ ) if utf8::is_utf8($_);
765 my %params = %{ $self->uri->query_form_hash };
766 foreach my $key (keys %{ $args }) {
767 my $val = $args->{$key};
770 if($append && exists($params{$key})) {
772 # This little bit of heaven handles appending a new value onto
773 # an existing one regardless if the existing value is an array
774 # or not, and regardless if the new value is an array or not
776 ref($params{$key}) eq 'ARRAY' ? @{ $params{$key} } : $params{$key},
777 ref($val) eq 'ARRAY' ? @{ $val } : $val
781 $params{$key} = $val;
785 # If the param wasn't defined then we delete it.
786 delete($params{$key});
794 =head2 $req->uri_with( { key => 'value' } );
796 Returns a rewritten URI object for the current request. Key/value pairs
797 passed in will override existing parameters. You can remove an existing
798 parameter by passing in an undef value. Unmodified pairs will be
801 You may also pass an optional second parameter that puts C<uri_with> into
804 $req->uri_with( { key => 'value' }, { mode => 'append' } );
806 See C<mangle_params> for an explanation of this behavior.
811 my( $self, $args, $behavior) = @_;
813 carp( 'No arguments passed to uri_with()' ) unless $args;
816 if((ref($behavior) eq 'HASH') && defined($behavior->{mode}) && ($behavior->{mode} eq 'append')) {
820 my $params = $self->mangle_params($args, $append);
822 my $uri = $self->uri->clone;
823 $uri->query_form($params);
828 =head2 $req->remote_user
830 Returns the value of the C<REMOTE_USER> environment variable.
832 =head2 $req->user_agent
834 Shortcut to $req->headers->user_agent. Returns the user agent (browser)
839 You should never need to call these yourself in application code,
840 however they are useful if extending Catalyst by applying a request role.
842 =head2 $self->prepare_headers()
844 Sets up the C<< $res->headers >> accessor.
846 =head2 $self->prepare_body()
848 Sets up the body using L<HTTP::Body>
850 =head2 $self->prepare_body_chunk()
852 Add a chunk to the request body.
854 =head2 $self->prepare_body_parameters()
856 Sets up parameters from body.
858 =head2 $self->prepare_cookies()
860 Parse cookies from header. Sets up a L<CGI::Simple::Cookie> object.
862 =head2 $self->prepare_connection()
864 Sets up various fields in the request like the local and remote addresses,
865 request method, hostname requested etc.
867 =head2 $self->prepare_parameters()
869 Ensures that the body has been parsed, then builds the parameters, which are
870 combined from those in the request and those in the body.
872 This method is the builder for the 'parameters' attribute.
880 Catalyst Contributors, see Catalyst.pm
884 This library is free software. You can redistribute it and/or modify
885 it under the same terms as Perl itself.
889 __PACKAGE__->meta->make_immutable;