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