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