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