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