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'); # XXX Deprecated - warn?
29 has address => (is => 'rw');
30 has arguments => (is => 'rw', default => sub { [] });
31 has cookies => (is => 'ro', builder => 'prepare_cookies', lazy => 1);
33 =head2 $self->prepare_cookies($c)
35 Parse cookies from header. Sets a L<CGI::Simple::Cookie> object.
42 if ( my $header = $self->header('Cookie') ) {
43 return { CGI::Simple::Cookie->parse($header) };
48 has query_keywords => (is => 'rw');
49 has match => (is => 'rw');
50 has method => (is => 'rw');
51 has protocol => (is => 'rw');
52 has query_parameters => (is => 'rw', default => sub { {} });
53 has secure => (is => 'rw', default => 0);
54 has captures => (is => 'rw', default => sub { [] });
55 has uri => (is => 'rw', predicate => 'has_uri');
56 has remote_user => (is => 'rw');
59 isa => 'HTTP::Headers',
60 handles => [qw(content_encoding content_length content_type header referer user_agent)],
61 builder => 'prepare_headers',
65 =head2 $self->prepare_headers($c)
73 my $headers = HTTP::Headers->new();
75 for my $header (keys %{ $env }) {
76 next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i;
77 (my $field = $header) =~ s/^HTTPS?_//;
79 $headers->header($field => $env->{$header});
90 # Amount of data to read from input on each pass
91 our $CHUNKSIZE = 64 * 1024;
94 my ($self, $maxlength) = @_;
95 my $remaining = $self->_read_length - $self->_read_position;
96 $maxlength ||= $CHUNKSIZE;
98 # Are we done reading?
99 if ( $remaining <= 0 ) {
103 my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
104 my $rc = $self->read_chunk( my $buffer, $readlen );
106 if (0 == $rc) { # Nothing more to read even though Content-Length
107 # said there should be.
110 $self->_read_position( $self->_read_position + $rc );
114 Catalyst::Exception->throw(
115 message => "Unknown error reading input: $!" );
121 return $self->env->{'psgi.input'}->read(@_);
124 has body_parameters => (
128 default => sub { {} },
134 default => sub { {} },
140 builder => 'prepare_parameters',
144 # - Can we lose the before modifiers which just call prepare_body ?
145 # they are wasteful, slow us down and feel cluttery.
147 # Can we make _body an attribute, have the rest of
148 # these lazy build from there and kill all the direct hash access
149 # in Catalyst.pm and Engine.pm?
151 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];
176 before body_parameters => sub {
179 $self->prepare_body_parameters;
182 =head2 $self->prepare_body()
184 sets up the L<Catalyst::Request> object body using L<HTTP::Body>
190 predicate => '_has_uploadtmp',
196 if ( my $length = $self->_read_length ) {
197 unless ( $self->_body ) {
198 my $type = $self->header('Content-Type');
199 $self->_body(HTTP::Body->new( $type, $length ));
200 $self->_body->cleanup(1); # Make extra sure!
201 $self->_body->tmpdir( $self->_uploadtmp )
202 if $self->_has_uploadtmp;
205 # Check for definedness as you could read '0'
206 while ( defined ( my $buffer = $self->read() ) ) {
207 $self->prepare_body_chunk($buffer);
210 # paranoia against wrong Content-Length header
211 my $remaining = $length - $self->_read_position;
212 if ( $remaining > 0 ) {
213 Catalyst::Exception->throw(
214 "Wrong Content-Length value: $length" );
218 # Defined but will cause all body code to be skipped
223 =head2 $self->prepare_body_chunk()
225 Add a chunk to the request body.
229 sub prepare_body_chunk {
230 my ( $self, $chunk ) = @_;
232 $self->_body->add($chunk);
235 =head2 $self->prepare_body_parameters()
237 Sets up parameters from body.
241 sub prepare_body_parameters {
244 return unless $self->_body;
246 $self->{body_parameters} = $self->_body->param; # FIXME!! Recursion here.
249 sub prepare_connection {
252 my $env = $self->env;
254 $self->address( $env->{REMOTE_ADDR} );
255 $self->hostname( $env->{REMOTE_HOST} )
256 if exists $env->{REMOTE_HOST};
257 $self->protocol( $env->{SERVER_PROTOCOL} );
258 $self->remote_user( $env->{REMOTE_USER} );
259 $self->method( $env->{REQUEST_METHOD} );
260 $self->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
263 # XXX - FIXME - method is here now, move this crap...
264 around parameters => sub {
265 my ($orig, $self, $params) = @_;
267 if ( !ref $params ) {
269 "Attempt to retrieve '$params' with req->params(), " .
270 "you probably meant to call req->param('$params')"
274 return $self->$orig($params);
285 return $self->path if $self->has_uri;
290 is => 'rw', clearer => '_clear_body', predicate => '_has_body',
292 # Eugh, ugly. Should just be able to rename accessor methods to 'body'
293 # and provide a custom reader..
296 $self->prepare_body();
297 croak 'body is a reader' if scalar @_;
298 return blessed $self->_body ? $self->_body->body : $self->_body;
307 gethostbyaddr( inet_aton( $self->address ), AF_INET ) || $self->address
311 has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
313 # XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
314 # to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
315 has user => (is => 'rw');
317 sub args { shift->arguments(@_) }
318 sub body_params { shift->body_parameters(@_) }
319 sub input { shift->body(@_) }
320 sub params { shift->parameters(@_) }
321 sub query_params { shift->query_parameters(@_) }
322 sub path_info { shift->path(@_) }
323 sub snippets { shift->captures(@_) }
325 =for stopwords param params
329 Catalyst::Request - provides information about the current client request
334 $req->address eq "127.0.0.1";
339 $req->body_parameters;
340 $req->content_encoding;
341 $req->content_length;
349 $req->query_keywords;
357 $req->query_parameters;
361 $req->captures; # previously knows as snippets
368 See also L<Catalyst>, L<Catalyst::Request::Upload>.
372 This is the Catalyst Request class, which provides an interface to data for the
373 current client request. The request object is prepared by L<Catalyst::Engine>,
374 thus hiding the details of the particular engine implementation.
380 Returns the IP address of the client.
382 =head2 $req->arguments
384 Returns a reference to an array containing the arguments.
386 print $c->request->arguments->[0];
388 For example, if your action was
390 package MyApp::Controller::Foo;
396 and the URI for the request was C<http://.../foo/moose/bah>, the string C<bah>
397 would be the first and only argument.
399 Arguments get automatically URI-unescaped for you.
403 Shortcut for L</arguments>.
407 Contains the URI base. This will always have a trailing slash. Note that the
408 URI scheme (e.g., http vs. https) must be determined through heuristics;
409 depending on your server configuration, it may be incorrect. See $req->secure
412 If your application was queried with the URI
413 C<http://localhost:3000/some/path> then C<base> is C<http://localhost:3000/>.
417 Returns the message body of the request, as returned by L<HTTP::Body>: a string,
418 unless Content-Type is C<application/x-www-form-urlencoded>, C<text/xml>, or
419 C<multipart/form-data>, in which case a L<File::Temp> object is returned.
421 =head2 $req->body_parameters
423 Returns a reference to a hash containing body (POST) parameters. Values can
424 be either a scalar or an arrayref containing scalars.
426 print $c->request->body_parameters->{field};
427 print $c->request->body_parameters->{field}->[0];
429 These are the parameters from the POST part of the request, if any.
431 =head2 $req->body_params
433 Shortcut for body_parameters.
435 =head2 $req->content_encoding
437 Shortcut for $req->headers->content_encoding.
439 =head2 $req->content_length
441 Shortcut for $req->headers->content_length.
443 =head2 $req->content_type
445 Shortcut for $req->headers->content_type.
449 A convenient method to access $req->cookies.
451 $cookie = $c->request->cookie('name');
452 @cookies = $c->request->cookie;
460 return keys %{ $self->cookies };
467 unless ( exists $self->cookies->{$name} ) {
471 return $self->cookies->{$name};
477 Returns a reference to a hash containing the cookies.
479 print $c->request->cookies->{mycookie}->value;
481 The cookies in the hash are indexed by name, and the values are L<CGI::Simple::Cookie>
486 Shortcut for $req->headers->header.
490 Returns an L<HTTP::Headers> object containing the headers for the current request.
492 print $c->request->headers->header('X-Catalyst');
494 =head2 $req->hostname
496 Returns the hostname of the client. Use C<< $req->uri->host >> to get the hostname of the server.
500 Alias for $req->body.
502 =head2 $req->query_keywords
504 Contains the keywords portion of a query string, when no '=' signs are
507 http://localhost/path?some+keywords
509 $c->request->query_keywords will contain 'some keywords'
513 This contains the matching part of a Regex action. Otherwise
514 it returns the same as 'action', except for default actions,
515 which return an empty string.
519 Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
523 Returns GET and POST parameters with a CGI.pm-compatible param method. This
524 is an alternative method for accessing parameters in $c->req->parameters.
526 $value = $c->request->param( 'foo' );
527 @values = $c->request->param( 'foo' );
528 @params = $c->request->param;
530 Like L<CGI>, and B<unlike> earlier versions of Catalyst, passing multiple
531 arguments to this method, like this:
533 $c->request->param( 'foo', 'bar', 'gorch', 'quxx' );
535 will set the parameter C<foo> to the multiple values C<bar>, C<gorch> and
536 C<quxx>. Previously this would have added C<bar> as another value to C<foo>
537 (creating it if it didn't exist before), and C<quxx> as another value for
540 B<NOTE> this is considered a legacy interface and care should be taken when
541 using it. C<< scalar $c->req->param( 'foo' ) >> will return only the first
542 C<foo> param even if multiple are present; C<< $c->req->param( 'foo' ) >> will
543 return a list of as many are present, which can have unexpected consequences
544 when writing code of the form:
548 baz => $c->req->param( 'baz' ),
551 If multiple C<baz> parameters are provided this code might corrupt data or
552 cause a hash initialization error. For a more straightforward interface see
553 C<< $c->req->parameters >>.
561 return keys %{ $self->parameters };
568 unless ( exists $self->parameters->{$param} ) {
569 return wantarray ? () : undef;
572 if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
574 ? @{ $self->parameters->{$param} }
575 : $self->parameters->{$param}->[0];
579 ? ( $self->parameters->{$param} )
580 : $self->parameters->{$param};
585 $self->parameters->{$field} = [@_];
589 =head2 $req->parameters
591 Returns a reference to a hash containing GET and POST parameters. Values can
592 be either a scalar or an arrayref containing scalars.
594 print $c->request->parameters->{field};
595 print $c->request->parameters->{field}->[0];
597 This is the combination of C<query_parameters> and C<body_parameters>.
601 Shortcut for $req->parameters.
605 Returns the path, i.e. the part of the URI after $req->base, for the current request.
607 http://localhost/path/foo
609 $c->request->path will contain 'path/foo'
611 =head2 $req->path_info
613 Alias for path, added for compatibility with L<CGI>.
618 my ( $self, @params ) = @_;
621 $self->uri->path(@params);
624 elsif ( $self->_has_path ) {
628 my $path = $self->uri->path;
629 my $location = $self->base->path;
630 $path =~ s/^(\Q$location\E)?//;
638 =head2 $req->protocol
640 Returns the protocol (HTTP/1.0 or HTTP/1.1) used for the current request.
642 =head2 $req->query_parameters
644 =head2 $req->query_params
646 Returns a reference to a hash containing query string (GET) parameters. Values can
647 be either a scalar or an arrayref containing scalars.
649 print $c->request->query_parameters->{field};
650 print $c->request->query_parameters->{field}->[0];
652 =head2 $req->read( [$maxlength] )
654 Reads a chunk of data from the request body. This method is intended to be
655 used in a while loop, reading $maxlength bytes on every call. $maxlength
656 defaults to the size of the request if not specified.
658 =head2 $req->read_chunk(\$buff, $max)
662 You have to set MyApp->config(parse_on_demand => 1) to use this directly.
666 Shortcut for $req->headers->referer. Returns the referring page.
670 Returns true or false, indicating whether the connection is secure
671 (https). Note that the URI scheme (e.g., http vs. https) must be determined
672 through heuristics, and therefore the reliability of $req->secure will depend
673 on your server configuration. If you are serving secure pages on the standard
674 SSL port (443) and/or setting the HTTPS environment variable, $req->secure
677 =head2 $req->captures
679 Returns a reference to an array containing captured args from chained
680 actions or regex captures.
682 my @captures = @{ $c->request->captures };
684 =head2 $req->snippets
686 C<captures> used to be called snippets. This is still available for backwards
687 compatibility, but is considered deprecated.
691 A convenient method to access $req->uploads.
693 $upload = $c->request->upload('field');
694 @uploads = $c->request->upload('field');
695 @fields = $c->request->upload;
697 for my $upload ( $c->request->upload('field') ) {
698 print $upload->filename;
707 return keys %{ $self->uploads };
714 unless ( exists $self->uploads->{$upload} ) {
715 return wantarray ? () : undef;
718 if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
720 ? @{ $self->uploads->{$upload} }
721 : $self->uploads->{$upload}->[0];
725 ? ( $self->uploads->{$upload} )
726 : $self->uploads->{$upload};
732 while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
734 if ( exists $self->uploads->{$field} ) {
735 for ( $self->uploads->{$field} ) {
736 $_ = [$_] unless ref($_) eq "ARRAY";
737 push( @$_, $upload );
741 $self->uploads->{$field} = $upload;
749 Returns a reference to a hash containing uploads. Values can be either a
750 L<Catalyst::Request::Upload> object, or an arrayref of
751 L<Catalyst::Request::Upload> objects.
753 my $upload = $c->request->uploads->{field};
754 my $upload = $c->request->uploads->{field}->[0];
758 Returns a L<URI> object for the current request. Stringifies to the URI text.
760 =head2 $req->mangle_params( { key => 'value' }, $appendmode);
762 Returns a hashref of parameters stemming from the current request's params,
763 plus the ones supplied. Keys for which no current param exists will be
764 added, keys with undefined values will be removed and keys with existing
765 params will be replaced. Note that you can supply a true value as the final
766 argument to change behavior with regards to existing parameters, appending
767 values rather than replacing them.
771 # URI query params foo=1
772 my $hashref = $req->mangle_params({ foo => 2 });
773 # Result is query params of foo=2
777 # URI query params foo=1
778 my $hashref = $req->mangle_params({ foo => 2 }, 1);
779 # Result is query params of foo=1&foo=2
781 This is the code behind C<uri_with>.
786 my ($self, $args, $append) = @_;
788 carp('No arguments passed to mangle_params()') unless $args;
790 foreach my $value ( values %$args ) {
791 next unless defined $value;
792 for ( ref $value eq 'ARRAY' ? @$value : $value ) {
794 utf8::encode( $_ ) if utf8::is_utf8($_);
798 my %params = %{ $self->uri->query_form_hash };
799 foreach my $key (keys %{ $args }) {
800 my $val = $args->{$key};
803 if($append && exists($params{$key})) {
805 # This little bit of heaven handles appending a new value onto
806 # an existing one regardless if the existing value is an array
807 # or not, and regardless if the new value is an array or not
809 ref($params{$key}) eq 'ARRAY' ? @{ $params{$key} } : $params{$key},
810 ref($val) eq 'ARRAY' ? @{ $val } : $val
814 $params{$key} = $val;
818 # If the param wasn't defined then we delete it.
819 delete($params{$key});
827 =head2 $req->uri_with( { key => 'value' } );
829 Returns a rewritten URI object for the current request. Key/value pairs
830 passed in will override existing parameters. You can remove an existing
831 parameter by passing in an undef value. Unmodified pairs will be
834 You may also pass an optional second parameter that puts C<uri_with> into
837 $req->uri_with( { key => 'value' }, { mode => 'append' } );
839 See C<mangle_params> for an explanation of this behavior.
844 my( $self, $args, $behavior) = @_;
846 carp( 'No arguments passed to uri_with()' ) unless $args;
849 if((ref($behavior) eq 'HASH') && defined($behavior->{mode}) && ($behavior->{mode} eq 'append')) {
853 my $params = $self->mangle_params($args, $append);
855 my $uri = $self->uri->clone;
856 $uri->query_form($params);
861 =head2 $req->remote_user
863 Returns the value of the C<REMOTE_USER> environment variable.
865 =head2 $req->user_agent
867 Shortcut to $req->headers->user_agent. Returns the user agent (browser)
876 Catalyst Contributors, see Catalyst.pm
880 This library is free software. You can redistribute it and/or modify
881 it under the same terms as Perl itself.
885 __PACKAGE__->meta->make_immutable;