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