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