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