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');
19 has _read_position => ( is => 'rw', default => 0 );
20 has _read_length => ( is => 'ro',
23 $self->header('Content-Length') || 0;
28 has action => (is => 'rw');
29 has address => (is => 'rw');
30 has arguments => (is => 'rw', default => sub { [] });
31 has cookies => (is => 'rw', default => sub { {} });
32 has query_keywords => (is => 'rw');
33 has match => (is => 'rw');
34 has method => (is => 'rw');
35 has protocol => (is => 'rw');
36 has query_parameters => (is => 'rw', default => sub { {} });
37 has secure => (is => 'rw', default => 0);
38 has captures => (is => 'rw', default => sub { [] });
39 has uri => (is => 'rw', predicate => 'has_uri');
40 has remote_user => (is => 'rw');
43 isa => 'HTTP::Headers',
44 handles => [qw(content_encoding content_length content_type header referer user_agent)],
45 default => sub { HTTP::Headers->new() },
53 clearer => '_clear_context',
56 # Amount of data to read from input on each pass
57 our $CHUNKSIZE = 64 * 1024;
60 my ($self, $maxlength) = @_;
61 my $remaining = $self->_read_length - $self->_read_position;
62 $maxlength ||= $CHUNKSIZE;
64 # Are we done reading?
65 if ( $remaining <= 0 ) {
69 my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
70 my $rc = $self->read_chunk( my $buffer, $readlen );
72 if (0 == $rc) { # Nothing more to read even though Content-Length
73 # said there should be.
76 $self->_read_position( $self->_read_position + $rc );
80 Catalyst::Exception->throw(
81 message => "Unknown error reading input: $!" );
87 return $self->env->{'psgi.input'}->read(@_);
90 has body_parameters => (
94 default => sub { {} },
100 default => sub { {} },
106 builder => 'prepare_parameters',
110 # - Can we lose the before modifiers which just call prepare_body ?
111 # they are wasteful, slow us down and feel cluttery.
113 # Can we make _body an attribute, have the rest of
114 # these lazy build from there and kill all the direct hash access
115 # in Catalyst.pm and Engine.pm?
117 sub prepare_parameters {
122 my $body_parameters = $self->body_parameters;
123 my $query_parameters = $self->query_parameters;
124 # We copy, no references
125 foreach my $name (keys %$query_parameters) {
126 my $param = $query_parameters->{$name};
127 $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param;
130 # Merge query and body parameters
131 foreach my $name (keys %$body_parameters) {
132 my $param = $body_parameters->{$name};
133 my @values = ref $param eq 'ARRAY' ? @$param : ($param);
134 if ( my $existing = $parameters->{$name} ) {
135 unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing));
137 $parameters->{$name} = @values > 1 ? \@values : $values[0];
142 before body_parameters => sub {
145 $self->prepare_body_parameters;
148 =head2 $self->prepare_body()
150 sets up the L<Catalyst::Request> object body using L<HTTP::Body>
156 predicate => '_has_uploadtmp',
162 if ( my $length = $self->_read_length ) {
163 unless ( $self->_body ) {
164 my $type = $self->header('Content-Type');
165 $self->_body(HTTP::Body->new( $type, $length ));
166 $self->_body->cleanup(1); # Make extra sure!
167 $self->_body->tmpdir( $self->_uploadtmp )
168 if $self->_has_uploadtmp;
171 # Check for definedness as you could read '0'
172 while ( defined ( my $buffer = $self->read() ) ) {
173 $self->prepare_body_chunk($buffer);
176 # paranoia against wrong Content-Length header
177 my $remaining = $length - $self->_read_position;
178 if ( $remaining > 0 ) {
179 Catalyst::Exception->throw(
180 "Wrong Content-Length value: $length" );
184 # Defined but will cause all body code to be skipped
189 =head2 $self->prepare_body_chunk()
191 Add a chunk to the request body.
195 sub prepare_body_chunk {
196 my ( $self, $chunk ) = @_;
198 $self->_body->add($chunk);
201 =head2 $self->prepare_body_parameters()
203 Sets up parameters from body.
207 sub prepare_body_parameters {
210 return unless $self->_body;
212 $self->{body_parameters} = $self->_body->param; # FIXME!! Recursion here.
215 around parameters => sub {
216 my ($orig, $self, $params) = @_;
218 if ( !ref $params ) {
219 $self->_context->log->warn(
220 "Attempt to retrieve '$params' with req->params(), " .
221 "you probably meant to call req->param('$params')"
225 return $self->$orig($params);
236 return $self->path if $self->has_uri;
241 is => 'rw', clearer => '_clear_body', predicate => '_has_body',
243 # Eugh, ugly. Should just be able to rename accessor methods to 'body'
244 # and provide a custom reader..
247 $self->prepare_body();
248 croak 'body is a reader' if scalar @_;
249 return blessed $self->_body ? $self->_body->body : $self->_body;
258 gethostbyaddr( inet_aton( $self->address ), AF_INET ) || $self->address
262 has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
264 # XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
265 # to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
266 has user => (is => 'rw');
268 sub args { shift->arguments(@_) }
269 sub body_params { shift->body_parameters(@_) }
270 sub input { shift->body(@_) }
271 sub params { shift->parameters(@_) }
272 sub query_params { shift->query_parameters(@_) }
273 sub path_info { shift->path(@_) }
274 sub snippets { shift->captures(@_) }
276 =for stopwords param params
280 Catalyst::Request - provides information about the current client request
291 $req->body_parameters;
292 $req->content_encoding;
293 $req->content_length;
301 $req->query_keywords;
309 $req->query_parameters;
313 $req->captures; # previously knows as snippets
320 See also L<Catalyst>, L<Catalyst::Request::Upload>.
324 This is the Catalyst Request class, which provides an interface to data for the
325 current client request. The request object is prepared by L<Catalyst::Engine>,
326 thus hiding the details of the particular engine implementation.
332 [DEPRECATED] Returns the name of the requested action.
335 Use C<< $c->action >> instead (which returns a
336 L<Catalyst::Action|Catalyst::Action> object).
340 Returns the IP address of the client.
342 =head2 $req->arguments
344 Returns a reference to an array containing the arguments.
346 print $c->request->arguments->[0];
348 For example, if your action was
350 package MyApp::Controller::Foo;
356 and the URI for the request was C<http://.../foo/moose/bah>, the string C<bah>
357 would be the first and only argument.
359 Arguments get automatically URI-unescaped for you.
363 Shortcut for L</arguments>.
367 Contains the URI base. This will always have a trailing slash. Note that the
368 URI scheme (e.g., http vs. https) must be determined through heuristics;
369 depending on your server configuration, it may be incorrect. See $req->secure
372 If your application was queried with the URI
373 C<http://localhost:3000/some/path> then C<base> is C<http://localhost:3000/>.
377 Returns the message body of the request, as returned by L<HTTP::Body>: a string,
378 unless Content-Type is C<application/x-www-form-urlencoded>, C<text/xml>, or
379 C<multipart/form-data>, in which case a L<File::Temp> object is returned.
381 =head2 $req->body_parameters
383 Returns a reference to a hash containing body (POST) parameters. Values can
384 be either a scalar or an arrayref containing scalars.
386 print $c->request->body_parameters->{field};
387 print $c->request->body_parameters->{field}->[0];
389 These are the parameters from the POST part of the request, if any.
391 =head2 $req->body_params
393 Shortcut for body_parameters.
395 =head2 $req->content_encoding
397 Shortcut for $req->headers->content_encoding.
399 =head2 $req->content_length
401 Shortcut for $req->headers->content_length.
403 =head2 $req->content_type
405 Shortcut for $req->headers->content_type.
409 A convenient method to access $req->cookies.
411 $cookie = $c->request->cookie('name');
412 @cookies = $c->request->cookie;
420 return keys %{ $self->cookies };
427 unless ( exists $self->cookies->{$name} ) {
431 return $self->cookies->{$name};
437 Returns a reference to a hash containing the cookies.
439 print $c->request->cookies->{mycookie}->value;
441 The cookies in the hash are indexed by name, and the values are L<CGI::Simple::Cookie>
446 Shortcut for $req->headers->header.
450 Returns an L<HTTP::Headers> object containing the headers for the current request.
452 print $c->request->headers->header('X-Catalyst');
454 =head2 $req->hostname
456 Returns the hostname of the client. Use C<< $req->uri->host >> to get the hostname of the server.
460 Alias for $req->body.
462 =head2 $req->query_keywords
464 Contains the keywords portion of a query string, when no '=' signs are
467 http://localhost/path?some+keywords
469 $c->request->query_keywords will contain 'some keywords'
473 This contains the matching part of a Regex action. Otherwise
474 it returns the same as 'action', except for default actions,
475 which return an empty string.
479 Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
483 Returns GET and POST parameters with a CGI.pm-compatible param method. This
484 is an alternative method for accessing parameters in $c->req->parameters.
486 $value = $c->request->param( 'foo' );
487 @values = $c->request->param( 'foo' );
488 @params = $c->request->param;
490 Like L<CGI>, and B<unlike> earlier versions of Catalyst, passing multiple
491 arguments to this method, like this:
493 $c->request->param( 'foo', 'bar', 'gorch', 'quxx' );
495 will set the parameter C<foo> to the multiple values C<bar>, C<gorch> and
496 C<quxx>. Previously this would have added C<bar> as another value to C<foo>
497 (creating it if it didn't exist before), and C<quxx> as another value for
500 B<NOTE> this is considered a legacy interface and care should be taken when
501 using it. C<< scalar $c->req->param( 'foo' ) >> will return only the first
502 C<foo> param even if multiple are present; C<< $c->req->param( 'foo' ) >> will
503 return a list of as many are present, which can have unexpected consequences
504 when writing code of the form:
508 baz => $c->req->param( 'baz' ),
511 If multiple C<baz> parameters are provided this code might corrupt data or
512 cause a hash initialization error. For a more straightforward interface see
513 C<< $c->req->parameters >>.
521 return keys %{ $self->parameters };
528 unless ( exists $self->parameters->{$param} ) {
529 return wantarray ? () : undef;
532 if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
534 ? @{ $self->parameters->{$param} }
535 : $self->parameters->{$param}->[0];
539 ? ( $self->parameters->{$param} )
540 : $self->parameters->{$param};
545 $self->parameters->{$field} = [@_];
549 =head2 $req->parameters
551 Returns a reference to a hash containing GET and POST parameters. Values can
552 be either a scalar or an arrayref containing scalars.
554 print $c->request->parameters->{field};
555 print $c->request->parameters->{field}->[0];
557 This is the combination of C<query_parameters> and C<body_parameters>.
561 Shortcut for $req->parameters.
565 Returns the path, i.e. the part of the URI after $req->base, for the current request.
567 http://localhost/path/foo
569 $c->request->path will contain 'path/foo'
571 =head2 $req->path_info
573 Alias for path, added for compatibility with L<CGI>.
578 my ( $self, @params ) = @_;
581 $self->uri->path(@params);
584 elsif ( $self->_has_path ) {
588 my $path = $self->uri->path;
589 my $location = $self->base->path;
590 $path =~ s/^(\Q$location\E)?//;
598 =head2 $req->protocol
600 Returns the protocol (HTTP/1.0 or HTTP/1.1) used for the current request.
602 =head2 $req->query_parameters
604 =head2 $req->query_params
606 Returns a reference to a hash containing query string (GET) parameters. Values can
607 be either a scalar or an arrayref containing scalars.
609 print $c->request->query_parameters->{field};
610 print $c->request->query_parameters->{field}->[0];
612 =head2 $req->read( [$maxlength] )
614 Reads a chunk of data from the request body. This method is intended to be
615 used in a while loop, reading $maxlength bytes on every call. $maxlength
616 defaults to the size of the request if not specified.
618 =head2 $req->read_chunk(\$buff, $max)
622 You have to set MyApp->config(parse_on_demand => 1) to use this directly.
626 Shortcut for $req->headers->referer. Returns the referring page.
630 Returns true or false, indicating whether the connection is secure
631 (https). Note that the URI scheme (e.g., http vs. https) must be determined
632 through heuristics, and therefore the reliability of $req->secure will depend
633 on your server configuration. If you are serving secure pages on the standard
634 SSL port (443) and/or setting the HTTPS environment variable, $req->secure
637 =head2 $req->captures
639 Returns a reference to an array containing captured args from chained
640 actions or regex captures.
642 my @captures = @{ $c->request->captures };
644 =head2 $req->snippets
646 C<captures> used to be called snippets. This is still available for backwards
647 compatibility, but is considered deprecated.
651 A convenient method to access $req->uploads.
653 $upload = $c->request->upload('field');
654 @uploads = $c->request->upload('field');
655 @fields = $c->request->upload;
657 for my $upload ( $c->request->upload('field') ) {
658 print $upload->filename;
667 return keys %{ $self->uploads };
674 unless ( exists $self->uploads->{$upload} ) {
675 return wantarray ? () : undef;
678 if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
680 ? @{ $self->uploads->{$upload} }
681 : $self->uploads->{$upload}->[0];
685 ? ( $self->uploads->{$upload} )
686 : $self->uploads->{$upload};
692 while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
694 if ( exists $self->uploads->{$field} ) {
695 for ( $self->uploads->{$field} ) {
696 $_ = [$_] unless ref($_) eq "ARRAY";
697 push( @$_, $upload );
701 $self->uploads->{$field} = $upload;
709 Returns a reference to a hash containing uploads. Values can be either a
710 L<Catalyst::Request::Upload> object, or an arrayref of
711 L<Catalyst::Request::Upload> objects.
713 my $upload = $c->request->uploads->{field};
714 my $upload = $c->request->uploads->{field}->[0];
718 Returns a L<URI> object for the current request. Stringifies to the URI text.
720 =head2 $req->mangle_params( { key => 'value' }, $appendmode);
722 Returns a hashref of parameters stemming from the current request's params,
723 plus the ones supplied. Keys for which no current param exists will be
724 added, keys with undefined values will be removed and keys with existing
725 params will be replaced. Note that you can supply a true value as the final
726 argument to change behavior with regards to existing parameters, appending
727 values rather than replacing them.
731 # URI query params foo=1
732 my $hashref = $req->mangle_params({ foo => 2 });
733 # Result is query params of foo=2
737 # URI query params foo=1
738 my $hashref = $req->mangle_params({ foo => 2 }, 1);
739 # Result is query params of foo=1&foo=2
741 This is the code behind C<uri_with>.
746 my ($self, $args, $append) = @_;
748 carp('No arguments passed to mangle_params()') unless $args;
750 foreach my $value ( values %$args ) {
751 next unless defined $value;
752 for ( ref $value eq 'ARRAY' ? @$value : $value ) {
754 utf8::encode( $_ ) if utf8::is_utf8($_);
758 my %params = %{ $self->uri->query_form_hash };
759 foreach my $key (keys %{ $args }) {
760 my $val = $args->{$key};
763 if($append && exists($params{$key})) {
765 # This little bit of heaven handles appending a new value onto
766 # an existing one regardless if the existing value is an array
767 # or not, and regardless if the new value is an array or not
769 ref($params{$key}) eq 'ARRAY' ? @{ $params{$key} } : $params{$key},
770 ref($val) eq 'ARRAY' ? @{ $val } : $val
774 $params{$key} = $val;
778 # If the param wasn't defined then we delete it.
779 delete($params{$key});
787 =head2 $req->uri_with( { key => 'value' } );
789 Returns a rewritten URI object for the current request. Key/value pairs
790 passed in will override existing parameters. You can remove an existing
791 parameter by passing in an undef value. Unmodified pairs will be
794 You may also pass an optional second parameter that puts C<uri_with> into
797 $req->uri_with( { key => 'value' }, { mode => 'append' } );
799 See C<mangle_params> for an explanation of this behavior.
804 my( $self, $args, $behavior) = @_;
806 carp( 'No arguments passed to uri_with()' ) unless $args;
809 if((ref($behavior) eq 'HASH') && defined($behavior->{mode}) && ($behavior->{mode} eq 'append')) {
813 my $params = $self->mangle_params($args, $append);
815 my $uri = $self->uri->clone;
816 $uri->query_form($params);
821 =head2 $req->remote_user
823 Returns the value of the C<REMOTE_USER> environment variable.
825 =head2 $req->user_agent
827 Shortcut to $req->headers->user_agent. Returns the user agent (browser)
836 Catalyst Contributors, see Catalyst.pm
840 This library is free software. You can redistribute it and/or modify
841 it under the same terms as Perl itself.
845 __PACKAGE__->meta->make_immutable;