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