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 action => (is => 'rw');
  18 has address => (is => 'rw');
  19 has arguments => (is => 'rw', default => sub { [] });
  20 has cookies => (is => 'rw', default => sub { {} });
  21 has query_keywords => (is => 'rw');
  22 has match => (is => 'rw');
  23 has method => (is => 'rw');
  24 has protocol => (is => 'rw');
  25 has query_parameters  => (is => 'rw', default => sub { {} });
  26 has secure => (is => 'rw', default => 0);
  27 has captures => (is => 'rw', default => sub { [] });
  28 has uri => (is => 'rw', predicate => 'has_uri');
  29 has remote_user => (is => 'rw');
  30 has headers => (
  31   is      => 'rw',
  32   isa     => 'HTTP::Headers',
  33   handles => [qw(content_encoding content_length content_type header referer user_agent)],
  34   default => sub { HTTP::Headers->new() },
  35   required => 1,
  36   lazy => 1,
  37 );
  38
  39 has _context => (
  40   is => 'rw',
  41   weak_ref => 1,
  42   handles => ['read'],
  43   clearer => '_clear_context',
  44 );
  45
  46 has body_parameters => (
  47   is => 'rw',
  48   required => 1,
  49   lazy => 1,
  50   default => sub { {} },
  51 );
  52
  53 has uploads => (
  54   is => 'rw',
  55   required => 1,
  56   default => sub { {} },
  57 );
  58
  59 has parameters => (
  60   is => 'rw',
  61   required => 1,
  62   lazy => 1,
  63   default => sub { {} },
  64 );
  65
  66 # TODO:
  67 # - Can we lose the before modifiers which just call prepare_body ?
  68 #   they are wasteful, slow us down and feel cluttery.
  69
  70 #  Can we make _body an attribute, have the rest of
  71 #  these lazy build from there and kill all the direct hash access
  72 #  in Catalyst.pm and Engine.pm?
  73
  74 before $_ => sub {
  75     my ($self) = @_;
  76     my $context = $self->_context || return;
  77     $context->prepare_body;
  78 } for qw/parameters body_parameters/;
  79
  80 around parameters => sub {
  81     my ($orig, $self, $params) = @_;
  82     if ($params) {
  83         if ( !ref $params ) {
  84             $self->_context->log->warn(
  85                 "Attempt to retrieve '$params' with req->params(), " .
  86                 "you probably meant to call req->param('$params')"
  87             );
  88             $params = undef;
  89         }
  90         return $self->$orig($params);
  91     }
  92     $self->$orig();
  93 };
  94
  95 has base => (
  96   is => 'rw',
  97   required => 1,
  98   lazy => 1,
  99   default => sub {
 100     my $self = shift;
 101     return $self->path if $self->has_uri;
 102   },
 103 );
 104
 105 has _body => (
 106   is => 'rw', clearer => '_clear_body', predicate => '_has_body',
 107 );
 108 # Eugh, ugly. Should just be able to rename accessor methods to 'body'
 109 #             and provide a custom reader..
 110 sub body {
 111   my $self = shift;
 112   $self->_context->prepare_body();
 113   $self->_body(@_) if scalar @_;
 114   return blessed $self->_body ? $self->_body->body : $self->_body;
 115 }
 116
 117 has hostname => (
 118   is        => 'rw',
 119   required  => 1,
 120   lazy      => 1,
 121   default   => sub {
 122     my ($self) = @_;
 123     gethostbyaddr( inet_aton( $self->address ), AF_INET ) || 'localhost'
 124   },
 125 );
 126
 127 has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
 128
 129 # XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
 130 # to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
 131 has user => (is => 'rw');
 132
 133 sub args            { shift->arguments(@_) }
 134 sub body_params     { shift->body_parameters(@_) }
 135 sub input           { shift->body(@_) }
 136 sub params          { shift->parameters(@_) }
 137 sub query_params    { shift->query_parameters(@_) }
 138 sub path_info       { shift->path(@_) }
 139 sub snippets        { shift->captures(@_) }
 140
 141 =head1 NAME
 142
 143 Catalyst::Request - provides information about the current client request
 144
 145 =head1 SYNOPSIS
 146
 147     $req = $c->request;
 148     $req->action;
 149     $req->address;
 150     $req->arguments;
 151     $req->args;
 152     $req->base;
 153     $req->body;
 154     $req->body_parameters;
 155     $req->content_encoding;
 156     $req->content_length;
 157     $req->content_type;
 158     $req->cookie;
 159     $req->cookies;
 160     $req->header;
 161     $req->headers;
 162     $req->hostname;
 163     $req->input;
 164     $req->query_keywords;
 165     $req->match;
 166     $req->method;
 167     $req->param;
 168     $req->parameters;
 169     $req->params;
 170     $req->path;
 171     $req->protocol;
 172     $req->query_parameters;
 173     $req->read;
 174     $req->referer;
 175     $req->secure;
 176     $req->captures; # previously knows as snippets
 177     $req->upload;
 178     $req->uploads;
 179     $req->uri;
 180     $req->user;
 181     $req->user_agent;
 182
 183 See also L<Catalyst>, L<Catalyst::Request::Upload>.
 184
 185 =head1 DESCRIPTION
 186
 187 This is the Catalyst Request class, which provides an interface to data for the
 188 current client request. The request object is prepared by L<Catalyst::Engine>,
 189 thus hiding the details of the particular engine implementation.
 190
 191 =head1 METHODS
 192
 193 =head2 $req->action
 194
 195 [DEPRECATED] Returns the name of the requested action.
 196
 197
 198 Use C<< $c->action >> instead (which returns a
 199 L<Catalyst::Action|Catalyst::Action> object).
 200
 201 =head2 $req->address
 202
 203 Returns the IP address of the client.
 204
 205 =head2 $req->arguments
 206
 207 Returns a reference to an array containing the arguments.
 208
 209     print $c->request->arguments->[0];
 210
 211 For example, if your action was
 212
 213     package MyApp::C::Foo;
 214
 215     sub moose : Local {
 216         ...
 217     }
 218
 219 and the URI for the request was C<http://.../foo/moose/bah>, the string C<bah>
 220 would be the first and only argument.
 221
 222 Arguments just get passed through and B<don't> get unescaped automatically, so
 223 you should do that explicitly.
 224
 225 =head2 $req->args
 226
 227 Shortcut for arguments.
 228
 229 =head2 $req->base
 230
 231 Contains the URI base. This will always have a trailing slash. Note that the
 232 URI scheme (eg., http vs. https) must be determined through heuristics;
 233 depending on your server configuration, it may be incorrect. See $req->secure
 234 for more info.
 235
 236 If your application was queried with the URI
 237 C<http://localhost:3000/some/path> then C<base> is C<http://localhost:3000/>.
 238
 239 =head2 $req->body
 240
 241 Returns the message body of the request, unless Content-Type is
 242 C<application/x-www-form-urlencoded> or C<multipart/form-data>.
 243
 244 =head2 $req->body_parameters
 245
 246 Returns a reference to a hash containing body (POST) parameters. Values can
 247 be either a scalar or an arrayref containing scalars.
 248
 249     print $c->request->body_parameters->{field};
 250     print $c->request->body_parameters->{field}->[0];
 251
 252 These are the parameters from the POST part of the request, if any.
 253
 254 =head2 $req->body_params
 255
 256 Shortcut for body_parameters.
 257
 258 =head2 $req->content_encoding
 259
 260 Shortcut for $req->headers->content_encoding.
 261
 262 =head2 $req->content_length
 263
 264 Shortcut for $req->headers->content_length.
 265
 266 =head2 $req->content_type
 267
 268 Shortcut for $req->headers->content_type.
 269
 270 =head2 $req->cookie
 271
 272 A convenient method to access $req->cookies.
 273
 274     $cookie  = $c->request->cookie('name');
 275     @cookies = $c->request->cookie;
 276
 277 =cut
 278
 279 sub cookie {
 280     my $self = shift;
 281
 282     if ( @_ == 0 ) {
 283         return keys %{ $self->cookies };
 284     }
 285
 286     if ( @_ == 1 ) {
 287
 288         my $name = shift;
 289
 290         unless ( exists $self->cookies->{$name} ) {
 291             return undef;
 292         }
 293
 294         return $self->cookies->{$name};
 295     }
 296 }
 297
 298 =head2 $req->cookies
 299
 300 Returns a reference to a hash containing the cookies.
 301
 302     print $c->request->cookies->{mycookie}->value;
 303
 304 The cookies in the hash are indexed by name, and the values are L<CGI::Cookie>
 305 objects.
 306
 307 =head2 $req->header
 308
 309 Shortcut for $req->headers->header.
 310
 311 =head2 $req->headers
 312
 313 Returns an L<HTTP::Headers> object containing the headers for the current request.
 314
 315     print $c->request->headers->header('X-Catalyst');
 316
 317 =head2 $req->hostname
 318
 319 Returns the hostname of the client.
 320
 321 =head2 $req->input
 322
 323 Alias for $req->body.
 324
 325 =head2 $req->query_keywords
 326
 327 Contains the keywords portion of a query string, when no '=' signs are
 328 present.
 329
 330     http://localhost/path?some+keywords
 331
 332     $c->request->query_keywords will contain 'some keywords'
 333
 334 =head2 $req->match
 335
 336 This contains the matching part of a Regex action. Otherwise
 337 it returns the same as 'action', except for default actions,
 338 which return an empty string.
 339
 340 =head2 $req->method
 341
 342 Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
 343
 344 =head2 $req->param
 345
 346 Returns GET and POST parameters with a CGI.pm-compatible param method. This
 347 is an alternative method for accessing parameters in $c->req->parameters.
 348
 349     $value  = $c->request->param( 'foo' );
 350     @values = $c->request->param( 'foo' );
 351     @params = $c->request->param;
 352
 353 Like L<CGI>, and B<unlike> earlier versions of Catalyst, passing multiple
 354 arguments to this method, like this:
 355
 356     $c->request->param( 'foo', 'bar', 'gorch', 'quxx' );
 357
 358 will set the parameter C<foo> to the multiple values C<bar>, C<gorch> and
 359 C<quxx>. Previously this would have added C<bar> as another value to C<foo>
 360 (creating it if it didn't exist before), and C<quxx> as another value for
 361 C<gorch>.
 362
 363 =cut
 364
 365 sub param {
 366     my $self = shift;
 367
 368     if ( @_ == 0 ) {
 369         return keys %{ $self->parameters };
 370     }
 371
 372     if ( @_ == 1 ) {
 373
 374         my $param = shift;
 375
 376         unless ( exists $self->parameters->{$param} ) {
 377             return wantarray ? () : undef;
 378         }
 379
 380         if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
 381             return (wantarray)
 382               ? @{ $self->parameters->{$param} }
 383               : $self->parameters->{$param}->[0];
 384         }
 385         else {
 386             return (wantarray)
 387               ? ( $self->parameters->{$param} )
 388               : $self->parameters->{$param};
 389         }
 390     }
 391     elsif ( @_ > 1 ) {
 392         my $field = shift;
 393         $self->parameters->{$field} = [@_];
 394     }
 395 }
 396
 397 =head2 $req->parameters
 398
 399 Returns a reference to a hash containing GET and POST parameters. Values can
 400 be either a scalar or an arrayref containing scalars.
 401
 402     print $c->request->parameters->{field};
 403     print $c->request->parameters->{field}->[0];
 404
 405 This is the combination of C<query_parameters> and C<body_parameters>.
 406
 407 =head2 $req->params
 408
 409 Shortcut for $req->parameters.
 410
 411 =head2 $req->path
 412
 413 Returns the path, i.e. the part of the URI after $req->base, for the current request.
 414
 415 =head2 $req->path_info
 416
 417 Alias for path, added for compatibility with L<CGI>.
 418
 419 =cut
 420
 421 sub path {
 422     my ( $self, @params ) = @_;
 423
 424     if (@params) {
 425         $self->uri->path(@params);
 426         $self->_clear_path;
 427     }
 428     elsif ( $self->_has_path ) {
 429         return $self->_path;
 430     }
 431     else {
 432         my $path     = $self->uri->path;
 433         my $location = $self->base->path;
 434         $path =~ s/^(\Q$location\E)?//;
 435         $path =~ s/^\///;
 436         $self->_path($path);
 437
 438         return $path;
 439     }
 440 }
 441
 442 =head2 $req->protocol
 443
 444 Returns the protocol (HTTP/1.0 or HTTP/1.1) used for the current request.
 445
 446 =head2 $req->query_parameters
 447
 448 =head2 $req->query_params
 449
 450 Returns a reference to a hash containing query string (GET) parameters. Values can
 451 be either a scalar or an arrayref containing scalars.
 452
 453     print $c->request->query_parameters->{field};
 454     print $c->request->query_parameters->{field}->[0];
 455
 456 =head2 $req->read( [$maxlength] )
 457
 458 Reads a chunk of data from the request body. This method is intended to be
 459 used in a while loop, reading $maxlength bytes on every call. $maxlength
 460 defaults to the size of the request if not specified.
 461
 462 You have to set MyApp->config->{parse_on_demand} to use this directly.
 463
 464 =head2 $req->referer
 465
 466 Shortcut for $req->headers->referer. Returns the referring page.
 467
 468 =head2 $req->secure
 469
 470 Returns true or false, indicating whether the connection is secure
 471 (https). Note that the URI scheme (eg., http vs. https) must be determined
 472 through heuristics, and therefore the reliablity of $req->secure will depend
 473 on your server configuration. If you are serving secure pages on the standard
 474 SSL port (443) and/or setting the HTTPS environment variable, $req->secure
 475 should be valid.
 476
 477 =head2 $req->captures
 478
 479 Returns a reference to an array containing captured args from chained
 480 actions or regex captures.
 481
 482     my @captures = @{ $c->request->captures };
 483
 484 =head2 $req->snippets
 485
 486 C<captures> used to be called snippets. This is still available for backwards
 487 compatibility, but is considered deprecated.
 488
 489 =head2 $req->upload
 490
 491 A convenient method to access $req->uploads.
 492
 493     $upload  = $c->request->upload('field');
 494     @uploads = $c->request->upload('field');
 495     @fields  = $c->request->upload;
 496
 497     for my $upload ( $c->request->upload('field') ) {
 498         print $upload->filename;
 499     }
 500
 501 =cut
 502
 503 sub upload {
 504     my $self = shift;
 505
 506     if ( @_ == 0 ) {
 507         return keys %{ $self->uploads };
 508     }
 509
 510     if ( @_ == 1 ) {
 511
 512         my $upload = shift;
 513
 514         unless ( exists $self->uploads->{$upload} ) {
 515             return wantarray ? () : undef;
 516         }
 517
 518         if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
 519             return (wantarray)
 520               ? @{ $self->uploads->{$upload} }
 521               : $self->uploads->{$upload}->[0];
 522         }
 523         else {
 524             return (wantarray)
 525               ? ( $self->uploads->{$upload} )
 526               : $self->uploads->{$upload};
 527         }
 528     }
 529
 530     if ( @_ > 1 ) {
 531
 532         while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
 533
 534             if ( exists $self->uploads->{$field} ) {
 535                 for ( $self->uploads->{$field} ) {
 536                     $_ = [$_] unless ref($_) eq "ARRAY";
 537                     push( @$_, $upload );
 538                 }
 539             }
 540             else {
 541                 $self->uploads->{$field} = $upload;
 542             }
 543         }
 544     }
 545 }
 546
 547 =head2 $req->uploads
 548
 549 Returns a reference to a hash containing uploads. Values can be either a
 550 L<Catalyst::Request::Upload> object, or an arrayref of
 551 L<Catalyst::Request::Upload> objects.
 552
 553     my $upload = $c->request->uploads->{field};
 554     my $upload = $c->request->uploads->{field}->[0];
 555
 556 =head2 $req->uri
 557
 558 Returns a URI object for the current request. Stringifies to the URI text.
 559
 560 =head2 $req->uri_with( { key => 'value' } );
 561
 562 Returns a rewritten URI object for the current request. Key/value pairs
 563 passed in will override existing parameters. You can remove an existing
 564 parameter by passing in an undef value. Unmodified pairs will be
 565 preserved.
 566
 567 =cut
 568
 569 sub uri_with {
 570     my( $self, $args ) = @_;
 571
 572     carp( 'No arguments passed to uri_with()' ) unless $args;
 573
 574     foreach my $value ( values %$args ) {
 575         next unless defined $value;
 576         for ( ref $value eq 'ARRAY' ? @$value : $value ) {
 577             $_ = "$_";
 578             utf8::encode( $_ ) if utf8::is_utf8($_);
 579         }
 580     };
 581
 582     my $uri   = $self->uri->clone;
 583     my %query = ( %{ $uri->query_form_hash }, %$args );
 584
 585     $uri->query_form( {
 586         # remove undef values
 587         map { defined $query{ $_ } ? ( $_ => $query{ $_ } ) : () } keys %query
 588     } );
 589     return $uri;
 590 }
 591
 592 =head2 $req->user
 593
 594 Returns the currently logged in user. B<Highly deprecated>, do not call,
 595 this will be removed in version 5.81.
 596
 597 =head2 $req->remote_user
 598
 599 Returns the value of the C<REMOTE_USER> environment variable.
 600
 601 =head2 $req->user_agent
 602
 603 Shortcut to $req->headers->user_agent. Returns the user agent (browser)
 604 version string.
 605
 606 =head2 meta
 607
 608 Provided by Moose
 609
 610 =head1 AUTHORS
 611
 612 Catalyst Contributors, see Catalyst.pm
 613
 614 =head1 COPYRIGHT
 615
 616 This program is free software, you can redistribute it and/or modify
 617 it under the same terms as Perl itself.
 618
 619 =cut
 620
 621 __PACKAGE__->meta->make_immutable;
 622
 623 1;