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