lib/Catalyst/Request.pm

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