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
   8 __PACKAGE__->mk_accessors(
   9     qw/action address arguments cookies headers match method
  10       protocol query_parameters secure snippets uri/
  11 );
  12
  13 *args         = \&arguments;
  14 *body_params  = \&body_parameters;
  15 *input        = \&body;
  16 *params       = \&parameters;
  17 *query_params = \&query_parameters;
  18 *path_info    = \&path;
  19
  20 sub content_encoding { shift->headers->content_encoding(@_) }
  21 sub content_length   { shift->headers->content_length(@_) }
  22 sub content_type     { shift->headers->content_type(@_) }
  23 sub header           { shift->headers->header(@_) }
  24 sub referer          { shift->headers->referer(@_) }
  25 sub user_agent       { shift->headers->user_agent(@_) }
  26
  27 =head1 NAME
  28
  29 Catalyst::Request - Catalyst Request Class
  30
  31 =head1 SYNOPSIS
  32
  33
  34     $req = $c->request;
  35     $req->action;
  36     $req->address;
  37     $req->args;
  38     $req->arguments;
  39     $req->base;
  40     $req->body;
  41     $req->body_parameters;
  42     $req->content_encoding;
  43     $req->content_length;
  44     $req->content_type;
  45     $req->cookie;
  46     $req->cookies;
  47     $req->header;
  48     $req->headers;
  49     $req->hostname;
  50     $req->input;
  51     $req->match;
  52     $req->method;
  53     $req->param;
  54     $req->params;
  55     $req->parameters;
  56     $req->path;
  57     $req->protocol;
  58     $req->query_parameters;
  59     $req->read;
  60     $req->referer;
  61     $req->secure;
  62     $req->snippets;
  63     $req->upload;
  64     $req->uploads;
  65     $req->uri;
  66     $req->user_agent;
  67
  68 See also L<Catalyst>.
  69
  70 =head1 DESCRIPTION
  71
  72 This is the Catalyst Request class, which provides a set of accessors to the
  73 request data.  The request object is prepared by the specialized Catalyst
  74 Engine module thus hiding the details of the particular engine implementation.
  75
  76
  77 =head1 METHODS
  78
  79 =over 4
  80
  81 =item $req->action
  82
  83 Contains the requested action.
  84
  85     print $c->request->action;
  86
  87 =item $req->address
  88
  89 Contains the remote address.
  90
  91     print $c->request->address
  92
  93 =item $req->args
  94
  95 Shortcut for arguments
  96
  97 =item $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 =item $req->base
 115
 116 Contains the URI base. This will always have a trailing slash.
 117
 118 If your application was queried with the URI C<http://localhost:3000/some/path>
 119 then C<base> is C<http://localhost:3000/>.
 120
 121 =cut
 122
 123 sub base {
 124     my ( $self, $base ) = @_;
 125
 126     return $self->{base} unless $base;
 127
 128     $self->{base} = $base;
 129
 130     # set the value in path for backwards-compat
 131     if ( $self->uri ) {
 132         $self->path;
 133     }
 134
 135     return $self->{base};
 136 }
 137
 138 =item $req->body
 139
 140 Contains the message body of the request unless Content-Type is
 141 C<application/x-www-form-urlencoded> or C<multipart/form-data>.
 142
 143     print $c->request->body
 144
 145 =cut
 146
 147 sub body {
 148     my ( $self, $body ) = @_;
 149     $self->{_context}->prepare_body;
 150     return $self->{_body}->body;
 151 }
 152
 153 =item $req->body_parameters
 154
 155 Returns a reference to a hash containing body parameters. Values can
 156 be either a scalar or an arrayref containing scalars.
 157
 158     print $c->request->body_parameters->{field};
 159     print $c->request->body_parameters->{field}->[0];
 160
 161 These are the parameters from the POST part of the request, if any.
 162
 163 =item $req->body_params
 164
 165 An alias for body_parameters.
 166
 167 =cut
 168
 169 sub body_parameters {
 170     my ( $self, $params ) = @_;
 171     $self->{_context}->prepare_body;
 172     $self->{body_parameters} = $params if $params;
 173     return $self->{body_parameters};
 174 }
 175
 176 =item $req->content_encoding
 177
 178 Shortcut to $req->headers->content_encoding
 179
 180 =item $req->content_length
 181
 182 Shortcut to $req->headers->content_length
 183
 184 =item $req->content_type
 185
 186 Shortcut to $req->headers->content_type
 187
 188 =item $req->cookie
 189
 190 A convenient method to $req->cookies.
 191
 192     $cookie  = $c->request->cookie('name');
 193     @cookies = $c->request->cookie;
 194
 195 =cut
 196
 197 sub cookie {
 198     my $self = shift;
 199
 200     if ( @_ == 0 ) {
 201         return keys %{ $self->cookies };
 202     }
 203
 204     if ( @_ == 1 ) {
 205
 206         my $name = shift;
 207
 208         unless ( exists $self->cookies->{$name} ) {
 209             return undef;
 210         }
 211
 212         return $self->cookies->{$name};
 213     }
 214 }
 215
 216 =item $req->cookies
 217
 218 Returns a reference to a hash containing the cookies.
 219
 220     print $c->request->cookies->{mycookie}->value;
 221
 222 The cookies in the hash are indexed by name, and the values are C<CGI::Cookie>
 223 objects.
 224
 225 =item $req->header
 226
 227 Shortcut to $req->headers->header
 228
 229 =item $req->headers
 230
 231 Returns an L<HTTP::Headers> object containing the headers.
 232
 233     print $c->request->headers->header('X-Catalyst');
 234
 235 =item $req->hostname
 236
 237 Lookup the current users DNS hostname.
 238
 239     print $c->request->hostname
 240
 241 =cut
 242
 243 sub hostname {
 244     my $self = shift;
 245
 246     if ( @_ == 0 && not $self->{hostname} ) {
 247         $self->{hostname} =
 248           gethostbyaddr( inet_aton( $self->address ), AF_INET );
 249     }
 250
 251     if ( @_ == 1 ) {
 252         $self->{hostname} = shift;
 253     }
 254
 255     return $self->{hostname};
 256 }
 257
 258 =item $req->input
 259
 260 Shortcut for $req->body.
 261
 262 =item $req->match
 263
 264 This contains the matching part of a regexp action. Otherwise
 265 it returns the same as 'action'.
 266
 267     print $c->request->match;
 268
 269 =item $req->method
 270
 271 Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
 272
 273     print $c->request->method;
 274
 275 =item $req->param
 276
 277 Get request parameters with a CGI.pm-compatible param method. This
 278 is a method for accessing parameters in $c->req->parameters.
 279
 280     $value  = $c->request->param( 'foo' );
 281     @values = $c->request->param( 'foo' );
 282     @params = $c->request->param;
 283
 284 Like L<CGI>, and B<unlike> previous versions of Catalyst, passing multiple
 285 arguments to this method, like this:
 286
 287         $c->request( 'foo', 'bar', 'gorch', 'quxx' );
 288
 289 will set the parameter C<foo> to the multiple values C<bar>, C<gorch> and
 290 C<quxx>. Previously this would have added C<bar> as another value to C<foo>
 291 (creating it if it didn't exist before), and C<quxx> as another value for C<gorch>.
 292
 293 =cut
 294
 295 sub param {
 296     my $self = shift;
 297
 298     if ( @_ == 0 ) {
 299         return keys %{ $self->parameters };
 300     }
 301
 302     if ( @_ == 1 ) {
 303
 304         my $param = shift;
 305
 306         unless ( exists $self->parameters->{$param} ) {
 307             return wantarray ? () : undef;
 308         }
 309
 310         if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
 311             return (wantarray)
 312               ? @{ $self->parameters->{$param} }
 313               : $self->parameters->{$param}->[0];
 314         }
 315         else {
 316             return (wantarray)
 317               ? ( $self->parameters->{$param} )
 318               : $self->parameters->{$param};
 319         }
 320     }
 321     elsif ( @_ > 1 ) {
 322         my $field = shift;
 323         $self->parameters->{$field} = [@_];
 324     }
 325 }
 326
 327 =item $req->params
 328
 329 Shortcut for $req->parameters.
 330
 331 =item $req->parameters
 332
 333 Returns a reference to a hash containing parameters. Values can
 334 be either a scalar or an arrayref containing scalars.
 335
 336     print $c->request->parameters->{field};
 337     print $c->request->parameters->{field}->[0];
 338
 339 This is the combination of C<query_parameters> and C<body_parameters>.
 340
 341 =cut
 342
 343 sub parameters {
 344     my ( $self, $params ) = @_;
 345     $self->{_context}->prepare_body;
 346     $self->{parameters} = $params if $params;
 347     return $self->{parameters};
 348 }
 349
 350 =item $req->path
 351
 352 Contains the path.
 353
 354     print $c->request->path;
 355
 356 =item $req->path_info
 357
 358 alias for path, added for compability with L<CGI>
 359
 360 =cut
 361
 362 sub path {
 363     my ( $self, $params ) = @_;
 364
 365     if ($params) {
 366         $self->uri->path($params);
 367     }
 368     else {
 369         return $self->{path} if $self->{path};
 370     }
 371
 372     my $path     = $self->uri->path;
 373     my $location = $self->base->path;
 374     $path =~ s/^(\Q$location\E)?//;
 375     $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
 376     $path =~ s/^\///;
 377     $self->{path} = $path;
 378
 379     return $path;
 380 }
 381
 382 =item $req->protocol
 383
 384 Contains the protocol.
 385
 386 =item $req->query_parameters
 387
 388 Returns a reference to a hash containing query parameters. Values can
 389 be either a scalar or an arrayref containing scalars.
 390
 391     print $c->request->query_parameters->{field};
 392     print $c->request->query_parameters->{field}->[0];
 393
 394 These are the parameters from the query string portion of the request's URI, if
 395 any.
 396
 397 =item $req->read( [$maxlength] )
 398
 399 Read a chunk of data from the request body.  This method is designed to be
 400 used in a while loop, reading $maxlength bytes on every call.  $maxlength
 401 defaults to the size of the request if not specified.
 402
 403 You have to set MyApp->config->{parse_on_demand} to use this directly.
 404
 405 =cut
 406
 407 sub read { shift->{_context}->read(@_); }
 408
 409 =item $req->referer
 410
 411 Shortcut to $req->headers->referer. Referring page.
 412
 413 =item $req->secure
 414
 415 Contains a boolean denoting whether the communication is secure.
 416
 417 =item $req->snippets
 418
 419 Returns a reference to an array containing regex snippets.
 420
 421     my @snippets = @{ $c->request->snippets };
 422
 423 =item $req->upload
 424
 425 A convenient method to $req->uploads.
 426
 427     $upload  = $c->request->upload('field');
 428     @uploads = $c->request->upload('field');
 429     @fields  = $c->request->upload;
 430
 431     for my $upload ( $c->request->upload('field') ) {
 432         print $upload->filename;
 433     }
 434
 435 =cut
 436
 437 sub upload {
 438     my $self = shift;
 439
 440     if ( @_ == 0 ) {
 441         return keys %{ $self->uploads };
 442     }
 443
 444     if ( @_ == 1 ) {
 445
 446         my $upload = shift;
 447
 448         unless ( exists $self->uploads->{$upload} ) {
 449             return wantarray ? () : undef;
 450         }
 451
 452         if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
 453             return (wantarray)
 454               ? @{ $self->uploads->{$upload} }
 455               : $self->uploads->{$upload}->[0];
 456         }
 457         else {
 458             return (wantarray)
 459               ? ( $self->uploads->{$upload} )
 460               : $self->uploads->{$upload};
 461         }
 462     }
 463
 464     if ( @_ > 1 ) {
 465
 466         while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
 467
 468             if ( exists $self->uploads->{$field} ) {
 469                 for ( $self->uploads->{$field} ) {
 470                     $_ = [$_] unless ref($_) eq "ARRAY";
 471                     push( @$_, $upload );
 472                 }
 473             }
 474             else {
 475                 $self->uploads->{$field} = $upload;
 476             }
 477         }
 478     }
 479 }
 480
 481 =item $req->uploads
 482
 483 Returns a reference to a hash containing uploads. Values can be either a
 484 hashref or a arrayref containing C<Catalyst::Request::Upload> objects.
 485
 486     my $upload = $c->request->uploads->{field};
 487     my $upload = $c->request->uploads->{field}->[0];
 488
 489 =cut
 490
 491 sub uploads {
 492     my ( $self, $uploads ) = @_;
 493     $self->{_context}->prepare_body;
 494     $self->{uploads} = $uploads if $uploads;
 495     return $self->{uploads};
 496 }
 497
 498 =item $req->uri
 499
 500 Returns a URI object for the request.
 501
 502 =item $req->user_agent
 503
 504 Shortcut to $req->headers->user_agent. User Agent version string.
 505
 506 =back
 507
 508 =head1 AUTHOR
 509
 510 Sebastian Riedel, C<sri@cpan.org>
 511 Marcus Ramberg, C<mramberg@cpan.org>
 512
 513 =head1 COPYRIGHT
 514
 515 This program is free software, you can redistribute it and/or modify
 516 it under the same terms as Perl itself.
 517
 518 =cut
 519
 520 1;