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