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