Die in engine if prepare_body writing to psgi.input fails.
[catagits/Catalyst-Runtime.git] / lib / Catalyst / Request.pm
CommitLineData
fc7ec1d9 1package Catalyst::Request;
2
b4ca0ee8 3use IO::Socket qw[AF_INET inet_aton];
bd917b94 4use Carp;
fc42a730 5use utf8;
de19de2e 6use URI::http;
7use URI::https;
e669e88a 8use URI::QueryParam;
6680c772 9use HTTP::Headers;
191665f3 10use Stream::Buffered;
11use Hash::MultiValue;
12use Scalar::Util;
b9d96e27 13use HTTP::Body;
b94f8e72 14use Catalyst::Exception;
0d94e986 15use Catalyst::Request::PartData;
059c085b 16use Moose;
17
6802c884 18use namespace::clean -except => 'meta';
19
b99ff5d8 20with 'MooseX::Emulate::Class::Accessor::Fast';
21
f52cae56 22has env => (is => 'ro', writer => '_set_env', predicate => '_has_env');
47b9d68e 23# XXX Deprecated crap here - warn?
24has action => (is => 'rw');
25# XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
26# to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
27has user => (is => 'rw');
28sub snippets { shift->captures(@_) }
faa02805 29
47b9d68e 30has _read_position => (
26fc3c5f 31 # FIXME: work around Moose bug RT#75367
32 # init_arg => undef,
47b9d68e 33 is => 'ro',
34 writer => '_set_read_position',
35 default => 0,
36);
37has _read_length => (
26fc3c5f 38 # FIXME: work around Moose bug RT#75367
39 # init_arg => undef,
47b9d68e 40 is => 'ro',
faa02805 41 default => sub {
42 my $self = shift;
43 $self->header('Content-Length') || 0;
44 },
45 lazy => 1,
46);
47
5fb12dbb 48has address => (is => 'rw');
49has arguments => (is => 'rw', default => sub { [] });
d5f4b434 50has cookies => (is => 'ro', builder => 'prepare_cookies', lazy => 1);
51
d5f4b434 52sub prepare_cookies {
53 my ( $self ) = @_;
54
55 if ( my $header = $self->header('Cookie') ) {
56 return { CGI::Simple::Cookie->parse($header) };
57 }
58 {};
59}
60
5fb12dbb 61has query_keywords => (is => 'rw');
62has match => (is => 'rw');
63has method => (is => 'rw');
64has protocol => (is => 'rw');
f152ae23 65has query_parameters => (is => 'rw', lazy=>1, default => sub { shift->_use_hash_multivalue ? Hash::MultiValue->new : +{} });
5fb12dbb 66has secure => (is => 'rw', default => 0);
67has captures => (is => 'rw', default => sub { [] });
6cb9e383 68has uri => (is => 'rw', predicate => 'has_uri');
8026359e 69has remote_user => (is => 'rw');
5fb12dbb 70has headers => (
e5ecd5bc 71 is => 'rw',
059c085b 72 isa => 'HTTP::Headers',
73 handles => [qw(content_encoding content_length content_type header referer user_agent)],
d5f4b434 74 builder => 'prepare_headers',
6680c772 75 lazy => 1,
059c085b 76);
77
d5f4b434 78sub prepare_headers {
79 my ($self) = @_;
80
81 my $env = $self->env;
82 my $headers = HTTP::Headers->new();
83
84 for my $header (keys %{ $env }) {
85 next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i;
86 (my $field = $header) =~ s/^HTTPS?_//;
87 $field =~ tr/_/-/;
88 $headers->header($field => $env->{$header});
89 }
90 return $headers;
91}
92
7c1c4dc6 93has _log => (
94 is => 'ro',
95 weak_ref => 1,
96 required => 1,
059c085b 97);
98
eb1f4b49 99has io_fh => (
b87d834e 100 is=>'ro',
c2fef52f 101 predicate=>'_has_io_fh',
b87d834e 102 lazy=>1,
103 builder=>'_build_io_fh');
eb1f4b49 104
ade3da0a 105sub _build_io_fh {
eb1f4b49 106 my $self = shift;
107 return $self->env->{'psgix.io'}
c368f69e 108 || (
109 $self->env->{'net.async.http.server.req'} &&
110 $self->env->{'net.async.http.server.req'}->stream) ## Until I can make ioasync cabal see the value of supportin psgix.io (jnap)
eb1f4b49 111 || die "Your Server does not support psgix.io";
ade3da0a 112};
eb1f4b49 113
b87d834e 114has data_handlers => ( is=>'ro', isa=>'HashRef', default=>sub { +{} } );
ade3da0a 115
b87d834e 116has body_data => (
117 is=>'ro',
118 lazy=>1,
119 builder=>'_build_body_data');
120
121sub _build_body_data {
122 my ($self) = @_;
b94f8e72 123
124 # Not sure if these returns should not be exceptions...
125 my $content_type = $self->content_type || return;
126 return unless ($self->method eq 'POST' || $self->method eq 'PUT');
127
b87d834e 128 my ($match) = grep { $content_type =~/$_/i }
129 keys(%{$self->data_handlers});
130
131 if($match) {
132 my $fh = $self->body;
133 local $_ = $fh;
134 return $self->data_handlers->{$match}->($fh, $self);
135 } else {
b94f8e72 136 Catalyst::Exception->throw("$content_type is does not have an available data handler");
b87d834e 137 }
138}
eb1f4b49 139
88ba7793 140has _use_hash_multivalue => (
141 is=>'ro',
142 required=>1,
143 default=> sub {0});
144
f083854e 145# Amount of data to read from input on each pass
146our $CHUNKSIZE = 64 * 1024;
147
148sub read {
149 my ($self, $maxlength) = @_;
150 my $remaining = $self->_read_length - $self->_read_position;
151 $maxlength ||= $CHUNKSIZE;
152
153 # Are we done reading?
154 if ( $remaining <= 0 ) {
155 return;
156 }
157
158 my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
159 my $rc = $self->read_chunk( my $buffer, $readlen );
160 if ( defined $rc ) {
161 if (0 == $rc) { # Nothing more to read even though Content-Length
162 # said there should be.
163 return;
164 }
47b9d68e 165 $self->_set_read_position( $self->_read_position + $rc );
f083854e 166 return $buffer;
167 }
168 else {
169 Catalyst::Exception->throw(
170 message => "Unknown error reading input: $!" );
171 }
172}
173
87f50436 174sub read_chunk {
175 my $self = shift;
176 return $self->env->{'psgi.input'}->read(@_);
177}
178
059c085b 179has body_parameters => (
5fb12dbb 180 is => 'rw',
181 required => 1,
182 lazy => 1,
0d94e986 183 predicate => 'has_body_parameters',
d003ff83 184 builder => 'prepare_body_parameters',
fc7ec1d9 185);
186
059c085b 187has uploads => (
5fb12dbb 188 is => 'rw',
189 required => 1,
5fb12dbb 190 default => sub { {} },
059c085b 191);
192
059c085b 193has parameters => (
1cbdfa9b 194 is => 'rw',
195 lazy => 1,
11e7af55 196 builder => '_build_parameters',
197 clearer => '_clear_parameters',
059c085b 198);
199
341620d5 200# TODO:
201# - Can we lose the before modifiers which just call prepare_body ?
202# they are wasteful, slow us down and feel cluttery.
203
204# Can we make _body an attribute, have the rest of
205# these lazy build from there and kill all the direct hash access
206# in Catalyst.pm and Engine.pm?
207
1cbdfa9b 208sub prepare_parameters {
209 my ( $self ) = @_;
11e7af55 210 $self->_clear_parameters;
211 return $self->parameters;
212}
213
11e7af55 214sub _build_parameters {
215 my ( $self ) = @_;
1cbdfa9b 216 my $parameters = {};
217 my $body_parameters = $self->body_parameters;
218 my $query_parameters = $self->query_parameters;
bd822b43 219
88ba7793 220 if($self->_use_hash_multivalue) {
f152ae23 221 return Hash::MultiValue->new($query_parameters->flatten, $body_parameters->flatten);
88ba7793 222 }
223
1cbdfa9b 224 # We copy, no references
225 foreach my $name (keys %$query_parameters) {
226 my $param = $query_parameters->{$name};
227 $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param;
228 }
229
230 # Merge query and body parameters
231 foreach my $name (keys %$body_parameters) {
232 my $param = $body_parameters->{$name};
233 my @values = ref $param eq 'ARRAY' ? @$param : ($param);
234 if ( my $existing = $parameters->{$name} ) {
235 unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing));
236 }
237 $parameters->{$name} = @values > 1 ? \@values : $values[0];
238 }
239 $parameters;
240}
241
398f13db 242has _uploadtmp => (
243 is => 'ro',
244 predicate => '_has_uploadtmp',
245);
246
247sub prepare_body {
248 my ( $self ) = @_;
249
191665f3 250 # If previously applied middleware created the HTTP::Body object, then we
251 # just use that one.
952ff530 252
b111b5c1 253 if(my $plack_body = $self->_has_env ? $self->env->{'plack.request.http.body'} : undef) {
952ff530 254 $self->_body($plack_body);
191665f3 255 $self->_body->cleanup(1);
256 return;
952ff530 257 }
258
191665f3 259 # If there is nothing to read, set body to naught and return. This
260 # will cause all body code to be skipped
398f13db 261
191665f3 262 return $self->_body(0) unless my $length = $self->_read_length;
952ff530 263
191665f3 264 # Unless the body has already been set, create it. Not sure about this
265 # code, how else might it be set, but this was existing logic.
266
267 unless ($self->_body) {
268 my $type = $self->header('Content-Type');
269 $self->_body(HTTP::Body->new( $type, $length ));
270 $self->_body->cleanup(1);
952ff530 271
191665f3 272 # JNAP: I'm not sure this is doing what we expect, but it also doesn't
273 # seem to be hurting (seems ->_has_uploadtmp is true more than I would
274 # expect.
275
276 $self->_body->tmpdir( $self->_uploadtmp )
277 if $self->_has_uploadtmp;
952ff530 278 }
279
191665f3 280 # Ok if we get this far, we have to read psgi.input into the new body
281 # object. Lets play nice with any plack app or other downstream, so
282 # we create a buffer unless one exists.
283
284 my $stream_buffer;
285 if ($self->env->{'psgix.input.buffered'}) {
286 # Be paranoid about previous psgi middleware or apps that read the
287 # input but didn't return the buffer to the start.
288 $self->env->{'psgi.input'}->seek(0, 0);
289 } else {
290 $stream_buffer = Stream::Buffered->new($length);
291 }
952ff530 292
191665f3 293 # Check for definedness as you could read '0'
294 while ( defined ( my $chunk = $self->read() ) ) {
295 $self->prepare_body_chunk($chunk);
eb1f418b 296 next unless $stream_buffer;
297
298 $stream_buffer->print($chunk)
299 || die sprintf "Failed to write %d bytes to psgi.input file: $!", length( $chunk );
191665f3 300 }
952ff530 301
191665f3 302 # Ok, we read the body. Lets play nice for any PSGI app down the pipe
303
304 if ($stream_buffer) {
305 $self->env->{'psgix.input.buffered'} = 1;
306 $self->env->{'psgi.input'} = $stream_buffer->rewind;
307 } else {
308 $self->env->{'psgi.input'}->seek(0, 0); # Reset the buffer for downstream middleware or apps
952ff530 309 }
191665f3 310
191665f3 311 # paranoia against wrong Content-Length header
312 my $remaining = $length - $self->_read_position;
313 if ( $remaining > 0 ) {
314 Catalyst::Exception->throw("Wrong Content-Length value: $length" );
952ff530 315 }
316}
317
398f13db 318sub prepare_body_chunk {
319 my ( $self, $chunk ) = @_;
320
321 $self->_body->add($chunk);
322}
323
398f13db 324sub prepare_body_parameters {
c0d561c1 325 my ( $self, $c ) = @_;
0d94e986 326 return $self->body_parameters if $self->has_body_parameters;
d003ff83 327 $self->prepare_body if ! $self->_has_body;
f152ae23 328
329 unless($self->_body) {
0d94e986 330 my $return = $self->_use_hash_multivalue ? Hash::MultiValue->new : {};
331 $self->body_parameters($return);
332 return $return;
f152ae23 333 }
398f13db 334
0d94e986 335 my $params;
336 my %part_data = %{$self->_body->part_data};
337 if(scalar %part_data && !$c->config->{skip_complex_post_part_handling}) {
338 foreach my $key (keys %part_data) {
339 my $proto_value = $part_data{$key};
340 my ($val, @extra) = (ref($proto_value)||'') eq 'ARRAY' ? @$proto_value : ($proto_value);
341
342 if(@extra) {
343 $params->{$key} = [map { Catalyst::Request::PartData->build_from_part_data($_) } ($val,@extra)];
344 } else {
345 $params->{$key} = Catalyst::Request::PartData->build_from_part_data($val);
346 }
347 }
348 } else {
349 $params = $self->_body->param;
350 }
c0d561c1 351
352 # If we have an encoding configured (like UTF-8) in general we expect a client
353 # to POST with the encoding we fufilled the request in. Otherwise don't do any
354 # encoding (good change wide chars could be in HTML entity style llike the old
355 # days -JNAP
356
357 # so, now that HTTP::Body prepared the body params, we gotta 'walk' the structure
358 # and do any needed decoding.
359
360 # This only does something if the encoding is set via the encoding param. Remember
361 # this is assuming the client is not bad and responds with what you provided. In
362 # general you can just use utf8 and get away with it.
363 #
364 # I need to see if $c is here since this also doubles as a builder for the object :(
365
0d94e986 366 if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) {
c0d561c1 367 $params = $c->_handle_unicode_decoding($params);
368 }
369
0d94e986 370 my $return = $self->_use_hash_multivalue ?
c0d561c1 371 Hash::MultiValue->from_mixed($params) :
372 $params;
0d94e986 373
374 $self->body_parameters($return) unless $self->has_body_parameters;
375 return $return;
398f13db 376}
341620d5 377
2f498a7e 378sub prepare_connection {
379 my ($self) = @_;
380
381 my $env = $self->env;
382
383 $self->address( $env->{REMOTE_ADDR} );
384 $self->hostname( $env->{REMOTE_HOST} )
385 if exists $env->{REMOTE_HOST};
386 $self->protocol( $env->{SERVER_PROTOCOL} );
387 $self->remote_user( $env->{REMOTE_USER} );
388 $self->method( $env->{REQUEST_METHOD} );
389 $self->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
390}
391
392# XXX - FIXME - method is here now, move this crap...
e99ec2dc 393around parameters => sub {
394 my ($orig, $self, $params) = @_;
395 if ($params) {
396 if ( !ref $params ) {
7c1c4dc6 397 $self->_log->warn(
e99ec2dc 398 "Attempt to retrieve '$params' with req->params(), " .
399 "you probably meant to call req->param('$params')"
400 );
401 $params = undef;
402 }
403 return $self->$orig($params);
404 }
405 $self->$orig();
059c085b 406};
407
408has base => (
5fb12dbb 409 is => 'rw',
410 required => 1,
411 lazy => 1,
412 default => sub {
059c085b 413 my $self = shift;
6cb9e383 414 return $self->path if $self->has_uri;
059c085b 415 },
416);
417
069355da 418has _body => (
0f56bbcf 419 is => 'rw', clearer => '_clear_body', predicate => '_has_body',
059c085b 420);
610bc6ec 421# Eugh, ugly. Should just be able to rename accessor methods to 'body'
b0ad47c1 422# and provide a custom reader..
610bc6ec 423sub body {
424 my $self = shift;
952ff530 425 $self->prepare_body unless $self->_has_body;
14c057aa 426 croak 'body is a reader' if scalar @_;
610bc6ec 427 return blessed $self->_body ? $self->_body->body : $self->_body;
428}
059c085b 429
430has hostname => (
431 is => 'rw',
432 required => 1,
433 lazy => 1,
434 default => sub {
435 my ($self) = @_;
9fb936e5 436 gethostbyaddr( inet_aton( $self->address ), AF_INET ) || $self->address
059c085b 437 },
438);
439
02570318 440has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
441
059c085b 442sub args { shift->arguments(@_) }
443sub body_params { shift->body_parameters(@_) }
444sub input { shift->body(@_) }
445sub params { shift->parameters(@_) }
446sub query_params { shift->query_parameters(@_) }
447sub path_info { shift->path(@_) }
f7e4e231 448
8738b8fe 449=for stopwords param params
965f3e35 450
fc7ec1d9 451=head1 NAME
452
3e19f4f6 453Catalyst::Request - provides information about the current client request
fc7ec1d9 454
455=head1 SYNOPSIS
456
b22c6668 457 $req = $c->request;
767480fd 458 $req->address eq "127.0.0.1";
b22c6668 459 $req->arguments;
3e19f4f6 460 $req->args;
b22c6668 461 $req->base;
06e1b616 462 $req->body;
974733c0 463 $req->body_data;
fbcc39ad 464 $req->body_parameters;
b5176d9e 465 $req->content_encoding;
466 $req->content_length;
467 $req->content_type;
b77e7869 468 $req->cookie;
b22c6668 469 $req->cookies;
b5176d9e 470 $req->header;
b22c6668 471 $req->headers;
472 $req->hostname;
61bacdcc 473 $req->input;
3b4d1251 474 $req->query_keywords;
b22c6668 475 $req->match;
476 $req->method;
e7c0c583 477 $req->param;
e7c0c583 478 $req->parameters;
3e19f4f6 479 $req->params;
b22c6668 480 $req->path;
bfde09a2 481 $req->protocol;
fbcc39ad 482 $req->query_parameters;
483 $req->read;
b5176d9e 484 $req->referer;
bfde09a2 485 $req->secure;
47b9d68e 486 $req->captures;
e7c0c583 487 $req->upload;
b22c6668 488 $req->uploads;
77d12cae 489 $req->uri;
7ce7ca2e 490 $req->user;
66294129 491 $req->user_agent;
9d8d0ab9 492 $req->env;
b22c6668 493
3e22baa5 494See also L<Catalyst>, L<Catalyst::Request::Upload>.
fc7ec1d9 495
496=head1 DESCRIPTION
497
3e19f4f6 498This is the Catalyst Request class, which provides an interface to data for the
499current client request. The request object is prepared by L<Catalyst::Engine>,
500thus hiding the details of the particular engine implementation.
b22c6668 501
502=head1 METHODS
fc7ec1d9 503
b5ecfcf0 504=head2 $req->address
0556eb49 505
3e19f4f6 506Returns the IP address of the client.
61b1e958 507
b5ecfcf0 508=head2 $req->arguments
61b1e958 509
b22c6668 510Returns a reference to an array containing the arguments.
fc7ec1d9 511
512 print $c->request->arguments->[0];
513
c436c1e8 514For example, if your action was
515
7d7519a4 516 package MyApp::Controller::Foo;
85d9fce6 517
518 sub moose : Local {
519 ...
520 }
c436c1e8 521
3e19f4f6 522and the URI for the request was C<http://.../foo/moose/bah>, the string C<bah>
c436c1e8 523would be the first and only argument.
524
6d920953 525Arguments get automatically URI-unescaped for you.
8f58057d 526
b5ecfcf0 527=head2 $req->args
3e19f4f6 528
01011731 529Shortcut for L</arguments>.
3e19f4f6 530
b5ecfcf0 531=head2 $req->base
fc7ec1d9 532
328f225e 533Contains the URI base. This will always have a trailing slash. Note that the
f4dda4a8 534URI scheme (e.g., http vs. https) must be determined through heuristics;
328f225e 535depending on your server configuration, it may be incorrect. See $req->secure
536for more info.
c436c1e8 537
3e19f4f6 538If your application was queried with the URI
539C<http://localhost:3000/some/path> then C<base> is C<http://localhost:3000/>.
fc7ec1d9 540
b5ecfcf0 541=head2 $req->body
06e1b616 542
843871cf 543Returns the message body of the request, as returned by L<HTTP::Body>: a string,
544unless Content-Type is C<application/x-www-form-urlencoded>, C<text/xml>, or
545C<multipart/form-data>, in which case a L<File::Temp> object is returned.
e060fe05 546
974733c0 547=head2 $req->body_data
548
549Returns a Perl representation of POST/PUT body data that is not classic HTML
550form data, such as JSON, XML, etc. By default, Catalyst will parse incoming
551data of the type 'application/json' and return access to that data via this
552method. You may define addition data_handlers via a global configuration
553setting. See L<Catalyst\DATA HANDLERS> for more information.
554
b94f8e72 555If the POST is malformed in some way (such as undefined or not content that
556matches the content-type) we raise a L<Catalyst::Exception> with the error
557text as the message.
558
566678d0 559If the POSTed content type does not match an available data handler, this
b94f8e72 560will also raise an exception.
561
b5ecfcf0 562=head2 $req->body_parameters
fbcc39ad 563
3e19f4f6 564Returns a reference to a hash containing body (POST) parameters. Values can
fbcc39ad 565be either a scalar or an arrayref containing scalars.
566
567 print $c->request->body_parameters->{field};
568 print $c->request->body_parameters->{field}->[0];
c436c1e8 569
d631b5f9 570These are the parameters from the POST part of the request, if any.
e5ecd5bc 571
0d94e986 572B<NOTE> If your POST is multipart, but contains non file upload parts (such
573as an line part with an alternative encoding or content type) we cannot determine
574the correct way to extra a meaningful value from the upload. In this case any
575part like this will be represented as an instance of L<Catalyst::Request::PartData>.
576
b5ecfcf0 577=head2 $req->body_params
fbcc39ad 578
3e19f4f6 579Shortcut for body_parameters.
fbcc39ad 580
b5ecfcf0 581=head2 $req->content_encoding
b5176d9e 582
3e19f4f6 583Shortcut for $req->headers->content_encoding.
b5176d9e 584
b5ecfcf0 585=head2 $req->content_length
b5176d9e 586
3e19f4f6 587Shortcut for $req->headers->content_length.
b5176d9e 588
b5ecfcf0 589=head2 $req->content_type
b5176d9e 590
3e19f4f6 591Shortcut for $req->headers->content_type.
b5176d9e 592
b5ecfcf0 593=head2 $req->cookie
3ad654e0 594
3e19f4f6 595A convenient method to access $req->cookies.
3ad654e0 596
597 $cookie = $c->request->cookie('name');
598 @cookies = $c->request->cookie;
599
600=cut
601
602sub cookie {
603 my $self = shift;
604
605 if ( @_ == 0 ) {
b77e7869 606 return keys %{ $self->cookies };
3ad654e0 607 }
608
609 if ( @_ == 1 ) {
610
611 my $name = shift;
612
b77e7869 613 unless ( exists $self->cookies->{$name} ) {
3ad654e0 614 return undef;
615 }
fbcc39ad 616
b77e7869 617 return $self->cookies->{$name};
3ad654e0 618 }
619}
620
b5ecfcf0 621=head2 $req->cookies
fc7ec1d9 622
b22c6668 623Returns a reference to a hash containing the cookies.
fc7ec1d9 624
625 print $c->request->cookies->{mycookie}->value;
626
7e743798 627The cookies in the hash are indexed by name, and the values are L<CGI::Simple::Cookie>
c436c1e8 628objects.
629
b5ecfcf0 630=head2 $req->header
b5176d9e 631
3e19f4f6 632Shortcut for $req->headers->header.
b5176d9e 633
b5ecfcf0 634=head2 $req->headers
fc7ec1d9 635
3e19f4f6 636Returns an L<HTTP::Headers> object containing the headers for the current request.
fc7ec1d9 637
638 print $c->request->headers->header('X-Catalyst');
639
b5ecfcf0 640=head2 $req->hostname
0556eb49 641
178dca5f 642Returns the hostname of the client. Use C<< $req->uri->host >> to get the hostname of the server.
e5ecd5bc 643
b5ecfcf0 644=head2 $req->input
61bacdcc 645
3e19f4f6 646Alias for $req->body.
61bacdcc 647
3b4d1251 648=head2 $req->query_keywords
649
650Contains the keywords portion of a query string, when no '=' signs are
651present.
652
653 http://localhost/path?some+keywords
b0ad47c1 654
3b4d1251 655 $c->request->query_keywords will contain 'some keywords'
656
b5ecfcf0 657=head2 $req->match
fc7ec1d9 658
3e19f4f6 659This contains the matching part of a Regex action. Otherwise
2c83fd5a 660it returns the same as 'action', except for default actions,
661which return an empty string.
fc7ec1d9 662
b5ecfcf0 663=head2 $req->method
b5176d9e 664
665Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
666
b5ecfcf0 667=head2 $req->param
e7c0c583 668
b0ad47c1 669Returns GET and POST parameters with a CGI.pm-compatible param method. This
3e19f4f6 670is an alternative method for accessing parameters in $c->req->parameters.
e7c0c583 671
a82c2894 672 $value = $c->request->param( 'foo' );
673 @values = $c->request->param( 'foo' );
e7c0c583 674 @params = $c->request->param;
675
3e705254 676Like L<CGI>, and B<unlike> earlier versions of Catalyst, passing multiple
a82c2894 677arguments to this method, like this:
678
85d9fce6 679 $c->request->param( 'foo', 'bar', 'gorch', 'quxx' );
a82c2894 680
681will set the parameter C<foo> to the multiple values C<bar>, C<gorch> and
682C<quxx>. Previously this would have added C<bar> as another value to C<foo>
3e19f4f6 683(creating it if it didn't exist before), and C<quxx> as another value for
684C<gorch>.
a82c2894 685
83312afd 686B<NOTE> this is considered a legacy interface and care should be taken when
687using it. C<< scalar $c->req->param( 'foo' ) >> will return only the first
688C<foo> param even if multiple are present; C<< $c->req->param( 'foo' ) >> will
689return a list of as many are present, which can have unexpected consequences
690when writing code of the form:
691
692 $foo->bar(
693 a => 'b',
694 baz => $c->req->param( 'baz' ),
695 );
696
697If multiple C<baz> parameters are provided this code might corrupt data or
698cause a hash initialization error. For a more straightforward interface see
699C<< $c->req->parameters >>.
700
f384c848 701B<NOTE> Interfaces like this, which are based on L<CGI> and the C<param> method
ac1cf8d4 702are known to cause demonstrated exploits. It is highly recommended that you
703avoid using this method, and migrate existing code away from it. Here's a
f384c848 704whitepaper of the exploit:
0810283f 705
706L<http://blog.gerv.net/2014/10/new-class-of-vulnerability-in-perl-web-applications/>
707
ac1cf8d4 708B<NOTE> Further discussion on IRC indicate that the L<Catalyst> core team from 'back then'
709were well aware of this hack and this is the main reason we added the new approach to
710getting parameters in the first place.
711
0810283f 712Basically this is an exploit that takes advantage of how L<\param> will do one thing
713in scalar context and another thing in list context. This is combined with how Perl
714chooses to deal with duplicate keys in a hash definition by overwriting the value of
715existing keys with a new value if the same key shows up again. Generally you will be
566678d0 716vulnerable to this exploit if you are using this method in a direct assignment in a
0810283f 717hash, such as with a L<DBIx::Class> create statement. For example, if you have
718parameters like:
719
720 user?user=123&foo=a&foo=user&foo=456
721
722You could end up with extra parameters injected into your method calls:
723
724 $c->model('User')->create({
725 user => $c->req->param('user'),
726 foo => $c->req->param('foo'),
727 });
728
729Which would look like:
730
731 $c->model('User')->create({
732 user => 123,
733 foo => qw(a user 456),
734 });
735
736(or to be absolutely clear if you are not seeing it):
737
738 $c->model('User')->create({
739 user => 456,
740 foo => 'a',
741 });
742
743Possible remediations include scrubbing your parameters with a form validator like
744L<HTML::FormHandler> or being careful to force scalar context using the scalar
745keyword:
746
747 $c->model('User')->create({
748 user => scalar($c->req->param('user')),
749 foo => scalar($c->req->param('foo')),
750 });
751
f384c848 752Upcoming versions of L<Catalyst> will disable this interface by default and require
753you to positively enable it should you require it for backwards compatibility reasons.
754
e7c0c583 755=cut
756
757sub param {
758 my $self = shift;
759
760 if ( @_ == 0 ) {
761 return keys %{ $self->parameters };
762 }
763
4f96d61c 764 # If anything in @_ is undef, carp about that, and remove it from
765 # the list;
766
767 my @params = grep { defined($_) ? 1 : do {carp "You called ->params with an undefined value"; 0} } @_;
768
769 if ( @params == 1 ) {
e7c0c583 770
4f96d61c 771 defined(my $param = shift @params) ||
772 carp "You called ->params with an undefined value 2";
6bd2b72c 773
bfde09a2 774 unless ( exists $self->parameters->{$param} ) {
775 return wantarray ? () : undef;
776 }
777
778 if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
779 return (wantarray)
780 ? @{ $self->parameters->{$param} }
781 : $self->parameters->{$param}->[0];
782 }
783 else {
784 return (wantarray)
785 ? ( $self->parameters->{$param} )
786 : $self->parameters->{$param};
787 }
d7945f32 788 }
4f96d61c 789 elsif ( @params > 1 ) {
790 my $field = shift @params;
90d3ac10 791 $self->parameters->{$field} = [@params];
d7945f32 792 }
e7c0c583 793}
b5176d9e 794
b5ecfcf0 795=head2 $req->parameters
61b1e958 796
3e19f4f6 797Returns a reference to a hash containing GET and POST parameters. Values can
d08ced28 798be either a scalar or an arrayref containing scalars.
fc7ec1d9 799
e7c0c583 800 print $c->request->parameters->{field};
801 print $c->request->parameters->{field}->[0];
fc7ec1d9 802
c436c1e8 803This is the combination of C<query_parameters> and C<body_parameters>.
804
b5ecfcf0 805=head2 $req->params
3e19f4f6 806
807Shortcut for $req->parameters.
808
b5ecfcf0 809=head2 $req->path
fc7ec1d9 810
3e19f4f6 811Returns the path, i.e. the part of the URI after $req->base, for the current request.
fc7ec1d9 812
be6801fa 813 http://localhost/path/foo
814
815 $c->request->path will contain 'path/foo'
816
b5ecfcf0 817=head2 $req->path_info
fbcc39ad 818
10011c19 819Alias for path, added for compatibility with L<CGI>.
fbcc39ad 820
821=cut
822
823sub path {
02fb5d78 824 my ( $self, @params ) = @_;
4f5ebacd 825
02fb5d78 826 if (@params) {
827 $self->uri->path(@params);
02570318 828 $self->_clear_path;
fbcc39ad 829 }
02570318 830 elsif ( $self->_has_path ) {
831 return $self->_path;
e561386f 832 }
02fb5d78 833 else {
834 my $path = $self->uri->path;
835 my $location = $self->base->path;
836 $path =~ s/^(\Q$location\E)?//;
837 $path =~ s/^\///;
02570318 838 $self->_path($path);
fbcc39ad 839
02fb5d78 840 return $path;
841 }
fbcc39ad 842}
843
b5ecfcf0 844=head2 $req->protocol
bfde09a2 845
3e19f4f6 846Returns the protocol (HTTP/1.0 or HTTP/1.1) used for the current request.
bfde09a2 847
b5ecfcf0 848=head2 $req->query_parameters
fbcc39ad 849
def54ce2 850=head2 $req->query_params
851
3e19f4f6 852Returns a reference to a hash containing query string (GET) parameters. Values can
fbcc39ad 853be either a scalar or an arrayref containing scalars.
854
855 print $c->request->query_parameters->{field};
856 print $c->request->query_parameters->{field}->[0];
b0ad47c1 857
b5ecfcf0 858=head2 $req->read( [$maxlength] )
fbcc39ad 859
3e19f4f6 860Reads a chunk of data from the request body. This method is intended to be
861used in a while loop, reading $maxlength bytes on every call. $maxlength
fbcc39ad 862defaults to the size of the request if not specified.
863
87f50436 864=head2 $req->read_chunk(\$buff, $max)
865
d7f18923 866Reads a chunk.
87f50436 867
9779c885 868You have to set MyApp->config(parse_on_demand => 1) to use this directly.
fbcc39ad 869
b5ecfcf0 870=head2 $req->referer
fc7ec1d9 871
3e19f4f6 872Shortcut for $req->headers->referer. Returns the referring page.
fc7ec1d9 873
b5ecfcf0 874=head2 $req->secure
bfde09a2 875
328f225e 876Returns true or false, indicating whether the connection is secure
d7f18923 877(https). The reliability of $req->secure may depend on your server
878configuration; Catalyst relies on PSGI to determine whether or not a
879request is secure (Catalyst looks at psgi.url_scheme), and different
880PSGI servers may make this determination in different ways (as by
881directly passing along information from the server, interpreting any of
882several HTTP headers, or using heuristics of their own).
bfde09a2 883
2982e768 884=head2 $req->captures
885
5c6a56e0 886Returns a reference to an array containing captured args from chained
887actions or regex captures.
fc7ec1d9 888
2982e768 889 my @captures = @{ $c->request->captures };
890
b5ecfcf0 891=head2 $req->upload
e7c0c583 892
3e19f4f6 893A convenient method to access $req->uploads.
e7c0c583 894
895 $upload = $c->request->upload('field');
896 @uploads = $c->request->upload('field');
897 @fields = $c->request->upload;
bfde09a2 898
e7c0c583 899 for my $upload ( $c->request->upload('field') ) {
146554c5 900 print $upload->filename;
e7c0c583 901 }
902
903=cut
904
905sub upload {
906 my $self = shift;
907
908 if ( @_ == 0 ) {
909 return keys %{ $self->uploads };
910 }
911
bfde09a2 912 if ( @_ == 1 ) {
e7c0c583 913
bfde09a2 914 my $upload = shift;
915
916 unless ( exists $self->uploads->{$upload} ) {
917 return wantarray ? () : undef;
918 }
6bd2b72c 919
bfde09a2 920 if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
921 return (wantarray)
922 ? @{ $self->uploads->{$upload} }
923 : $self->uploads->{$upload}->[0];
924 }
925 else {
926 return (wantarray)
fbcc39ad 927 ? ( $self->uploads->{$upload} )
928 : $self->uploads->{$upload};
bfde09a2 929 }
d7945f32 930 }
bfde09a2 931
a4f5c51e 932 if ( @_ > 1 ) {
bfde09a2 933
934 while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
935
936 if ( exists $self->uploads->{$field} ) {
937 for ( $self->uploads->{$field} ) {
938 $_ = [$_] unless ref($_) eq "ARRAY";
939 push( @$_, $upload );
940 }
941 }
942 else {
943 $self->uploads->{$field} = $upload;
944 }
945 }
e7c0c583 946 }
947}
948
b5ecfcf0 949=head2 $req->uploads
fc7ec1d9 950
bfde09a2 951Returns a reference to a hash containing uploads. Values can be either a
b0ad47c1 952L<Catalyst::Request::Upload> object, or an arrayref of
84e7aa89 953L<Catalyst::Request::Upload> objects.
e7c0c583 954
955 my $upload = $c->request->uploads->{field};
956 my $upload = $c->request->uploads->{field}->[0];
957
b5ecfcf0 958=head2 $req->uri
fbcc39ad 959
d26ee0d0 960Returns a L<URI> object for the current request. Stringifies to the URI text.
fbcc39ad 961
a375a206 962=head2 $req->mangle_params( { key => 'value' }, $appendmode);
bd917b94 963
a375a206 964Returns a hashref of parameters stemming from the current request's params,
965plus the ones supplied. Keys for which no current param exists will be
966added, keys with undefined values will be removed and keys with existing
967params will be replaced. Note that you can supply a true value as the final
968argument to change behavior with regards to existing parameters, appending
969values rather than replacing them.
970
971A quick example:
972
973 # URI query params foo=1
974 my $hashref = $req->mangle_params({ foo => 2 });
975 # Result is query params of foo=2
976
977versus append mode:
978
979 # URI query params foo=1
980 my $hashref = $req->mangle_params({ foo => 2 }, 1);
981 # Result is query params of foo=1&foo=2
982
983This is the code behind C<uri_with>.
bd917b94 984
985=cut
986
a375a206 987sub mangle_params {
988 my ($self, $args, $append) = @_;
b0ad47c1 989
a375a206 990 carp('No arguments passed to mangle_params()') unless $args;
fbb513f7 991
2f381252 992 foreach my $value ( values %$args ) {
d0f0fcf6 993 next unless defined $value;
fbb513f7 994 for ( ref $value eq 'ARRAY' ? @$value : $value ) {
995 $_ = "$_";
5c779e98 996 # utf8::encode($_);
fc42a730 997 }
fc42a730 998 };
b0ad47c1 999
a375a206 1000 my %params = %{ $self->uri->query_form_hash };
1001 foreach my $key (keys %{ $args }) {
1002 my $val = $args->{$key};
1003 if(defined($val)) {
1004
1005 if($append && exists($params{$key})) {
1006
1007 # This little bit of heaven handles appending a new value onto
1008 # an existing one regardless if the existing value is an array
1009 # or not, and regardless if the new value is an array or not
1010 $params{$key} = [
1011 ref($params{$key}) eq 'ARRAY' ? @{ $params{$key} } : $params{$key},
1012 ref($val) eq 'ARRAY' ? @{ $val } : $val
1013 ];
1014
1015 } else {
1016 $params{$key} = $val;
1017 }
1018 } else {
1019
1020 # If the param wasn't defined then we delete it.
1021 delete($params{$key});
1022 }
1023 }
1024
1025
1026 return \%params;
1027}
1028
1029=head2 $req->uri_with( { key => 'value' } );
1030
1031Returns a rewritten URI object for the current request. Key/value pairs
1032passed in will override existing parameters. You can remove an existing
1033parameter by passing in an undef value. Unmodified pairs will be
1034preserved.
1035
1036You may also pass an optional second parameter that puts C<uri_with> into
1037append mode:
1038
1039 $req->uri_with( { key => 'value' }, { mode => 'append' } );
9779c885 1040
a375a206 1041See C<mangle_params> for an explanation of this behavior.
1042
1043=cut
1044
1045sub uri_with {
1046 my( $self, $args, $behavior) = @_;
1047
1048 carp( 'No arguments passed to uri_with()' ) unless $args;
1049
1050 my $append = 0;
1051 if((ref($behavior) eq 'HASH') && defined($behavior->{mode}) && ($behavior->{mode} eq 'append')) {
1052 $append = 1;
1053 }
1054
1055 my $params = $self->mangle_params($args, $append);
1056
1057 my $uri = $self->uri->clone;
1058 $uri->query_form($params);
2f381252 1059
bd917b94 1060 return $uri;
1061}
1062
8026359e 1063=head2 $req->remote_user
1064
1065Returns the value of the C<REMOTE_USER> environment variable.
7ce7ca2e 1066
b5ecfcf0 1067=head2 $req->user_agent
b5176d9e 1068
3e19f4f6 1069Shortcut to $req->headers->user_agent. Returns the user agent (browser)
1070version string.
b5176d9e 1071
eb1f4b49 1072=head2 $req->io_fh
1073
1074Returns a psgix.io bidirectional socket, if your server supports one. Used for
1075when you want to jailbreak out of PSGI and handle bidirectional client server
1076communication manually, such as when you are using cometd or websockets.
1077
47b9d68e 1078=head1 SETUP METHODS
1079
1080You should never need to call these yourself in application code,
1081however they are useful if extending Catalyst by applying a request role.
1082
1083=head2 $self->prepare_headers()
1084
1085Sets up the C<< $res->headers >> accessor.
1086
1087=head2 $self->prepare_body()
1088
1089Sets up the body using L<HTTP::Body>
1090
1091=head2 $self->prepare_body_chunk()
1092
1093Add a chunk to the request body.
1094
1095=head2 $self->prepare_body_parameters()
1096
1097Sets up parameters from body.
1098
8738b8fe 1099=head2 $self->prepare_cookies()
47b9d68e 1100
1101Parse cookies from header. Sets up a L<CGI::Simple::Cookie> object.
1102
8738b8fe 1103=head2 $self->prepare_connection()
1104
1105Sets up various fields in the request like the local and remote addresses,
f59eeb09 1106request method, hostname requested etc.
8738b8fe 1107
1108=head2 $self->prepare_parameters()
1109
1110Ensures that the body has been parsed, then builds the parameters, which are
1111combined from those in the request and those in the body.
1112
11e7af55 1113If parameters have already been set will clear the parameters and build them again.
1114
9d8d0ab9 1115=head2 $self->env
1116
1117Access to the raw PSGI env.
8738b8fe 1118
059c085b 1119=head2 meta
1120
1121Provided by Moose
1122
3e19f4f6 1123=head1 AUTHORS
fc7ec1d9 1124
2f381252 1125Catalyst Contributors, see Catalyst.pm
fc7ec1d9 1126
1127=head1 COPYRIGHT
1128
536bee89 1129This library is free software. You can redistribute it and/or modify
61b1e958 1130it under the same terms as Perl itself.
fc7ec1d9 1131
1132=cut
1133
e5ecd5bc 1134__PACKAGE__->meta->make_immutable;
1135
fc7ec1d9 11361;