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