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