lib/Catalyst/Request.pm

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