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