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 parameters 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 Like L<CGI>, and B<unlike> previous versions of Catalyst, passing multiple
 286 arguments to this method, like this:
 287
 288         $c->request( 'foo', 'bar', 'gorch', 'quxx' );
 289
 290 will set the parameter C<foo> to the multiple values C<bar>, C<gorch> and
 291 C<quxx>. Previously this would have added C<bar> as another value to C<foo>
 292 (creating it if it didn't exist before), and C<quxx> as another value for C<gorch>.
 293
 294 =cut
 295
 296 sub param {
 297     my $self = shift;
 298
 299     if ( @_ == 0 ) {
 300         return keys %{ $self->parameters };
 301     }
 302
 303     if ( @_ == 1 ) {
 304
 305         my $param = shift;
 306
 307         unless ( exists $self->parameters->{$param} ) {
 308             return wantarray ? () : undef;
 309         }
 310
 311         if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
 312             return (wantarray)
 313               ? @{ $self->parameters->{$param} }
 314               : $self->parameters->{$param}->[0];
 315         }
 316         else {
 317             return (wantarray)
 318               ? ( $self->parameters->{$param} )
 319               : $self->parameters->{$param};
 320         }
 321     }
 322     elsif ( @_ > 1 ) {
 323         my $field = shift;
 324         $self->parameters->{$field} = [@_];
 325     }
 326 }
 327
 328 =item $req->params
 329
 330 Shortcut for $req->parameters.
 331
 332 =item $req->parameters
 333
 334 Returns a reference to a hash containing parameters. Values can
 335 be either a scalar or an arrayref containing scalars.
 336
 337     print $c->request->parameters->{field};
 338     print $c->request->parameters->{field}->[0];
 339
 340 This is the combination of C<query_parameters> and C<body_parameters>.
 341
 342 =cut
 343
 344 sub parameters {
 345     my ( $self, $params ) = @_;
 346     $self->{_context}->prepare_body;
 347     $self->{parameters} = $params if $params;
 348     return $self->{parameters};
 349 }
 350
 351 =item $req->path
 352
 353 Contains the path.
 354
 355     print $c->request->path;
 356
 357 =item $req->path_info
 358
 359 alias for path, added for compability with L<CGI>
 360
 361 =cut
 362
 363 sub path {
 364     my ( $self, $params ) = @_;
 365
 366     if ($params) {
 367         $self->uri->path($params);
 368     }
 369     else {
 370         return $self->{path} if $self->{path};
 371     }
 372
 373     my $path     = $self->uri->path;
 374     my $location = $self->base->path;
 375     $path =~ s/^(\Q$location\E)?//;
 376     $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
 377     $path =~ s/^\///;
 378     $self->{path} = $path;
 379
 380     return $path;
 381 }
 382
 383 =item $req->protocol
 384
 385 Contains the protocol.
 386
 387 =item $req->query_parameters
 388
 389 Returns a reference to a hash containing query parameters. Values can
 390 be either a scalar or an arrayref containing scalars.
 391
 392     print $c->request->query_parameters->{field};
 393     print $c->request->query_parameters->{field}->[0];
 394
 395 These are the parameters from the query string portion of the request's URI, if
 396 any.
 397
 398 =item $req->read( [$maxlength] )
 399
 400 Read a chunk of data from the request body.  This method is designed to be
 401 used in a while loop, reading $maxlength bytes on every call.  $maxlength
 402 defaults to the size of the request if not specified.
 403
 404 You have to set MyApp->config->{parse_on_demand} to use this directly.
 405
 406 =cut
 407
 408 sub read { shift->{_context}->read(@_); }
 409
 410 =item $req->referer
 411
 412 Shortcut to $req->headers->referer. Referring page.
 413
 414 =item $req->secure
 415
 416 Contains a boolean denoting whether the communication is secure.
 417
 418 =item $req->snippets
 419
 420 Returns a reference to an array containing regex snippets.
 421
 422     my @snippets = @{ $c->request->snippets };
 423
 424 =item $req->upload
 425
 426 A convenient method to $req->uploads.
 427
 428     $upload  = $c->request->upload('field');
 429     @uploads = $c->request->upload('field');
 430     @fields  = $c->request->upload;
 431
 432     for my $upload ( $c->request->upload('field') ) {
 433         print $upload->filename;
 434     }
 435
 436 =cut
 437
 438 sub upload {
 439     my $self = shift;
 440
 441     if ( @_ == 0 ) {
 442         return keys %{ $self->uploads };
 443     }
 444
 445     if ( @_ == 1 ) {
 446
 447         my $upload = shift;
 448
 449         unless ( exists $self->uploads->{$upload} ) {
 450             return wantarray ? () : undef;
 451         }
 452
 453         if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
 454             return (wantarray)
 455               ? @{ $self->uploads->{$upload} }
 456               : $self->uploads->{$upload}->[0];
 457         }
 458         else {
 459             return (wantarray)
 460               ? ( $self->uploads->{$upload} )
 461               : $self->uploads->{$upload};
 462         }
 463     }
 464
 465     if ( @_ > 1 ) {
 466
 467         while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
 468
 469             if ( exists $self->uploads->{$field} ) {
 470                 for ( $self->uploads->{$field} ) {
 471                     $_ = [$_] unless ref($_) eq "ARRAY";
 472                     push( @$_, $upload );
 473                 }
 474             }
 475             else {
 476                 $self->uploads->{$field} = $upload;
 477             }
 478         }
 479     }
 480 }
 481
 482 =item $req->uploads
 483
 484 Returns a reference to a hash containing uploads. Values can be either a
 485 hashref or a arrayref containing C<Catalyst::Request::Upload> objects.
 486
 487     my $upload = $c->request->uploads->{field};
 488     my $upload = $c->request->uploads->{field}->[0];
 489
 490 =cut
 491
 492 sub uploads {
 493     my ( $self, $uploads ) = @_;
 494     $self->{_context}->prepare_body;
 495     $self->{uploads} = $uploads if $uploads;
 496     return $self->{uploads};
 497 }
 498
 499 =item $req->uri
 500
 501 Returns a URI object for the request.
 502
 503 =item $req->user
 504
 505 Contains the user name of user if authentication check was successful.
 506
 507 =item $req->user_agent
 508
 509 Shortcut to $req->headers->user_agent. User Agent version string.
 510
 511 =back
 512
 513 =head1 AUTHOR
 514
 515 Sebastian Riedel, C<sri@cpan.org>
 516 Marcus Ramberg, C<mramberg@cpan.org>
 517
 518 =head1 COPYRIGHT
 519
 520 This program is free software, you can redistribute it and/or modify
 521 it under the same terms as Perl itself.
 522
 523 =cut
 524
 525 1;