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 body base cookies headers match method
  10        parameters path protocol secure snippets uploads user/
  11 );
  12
  13 *args   = \&arguments;
  14 *input  = \&body;
  15 *params = \&parameters;
  16
  17 sub content_encoding { shift->headers->content_encoding(@_) }
  18 sub content_length   { shift->headers->content_length(@_)   }
  19 sub content_type     { shift->headers->content_type(@_)     }
  20 sub header           { shift->headers->header(@_)           }
  21 sub referer          { shift->headers->referer(@_)          }
  22 sub user_agent       { shift->headers->user_agent(@_)       }
  23
  24 =head1 NAME
  25
  26 Catalyst::Request - Catalyst Request Class
  27
  28 =head1 SYNOPSIS
  29
  30
  31     $req = $c->request;
  32     $req->action;
  33     $req->address;
  34     $req->args;
  35     $req->arguments;
  36     $req->base;
  37     $req->body;
  38     $req->content_encoding;
  39     $req->content_length;
  40     $req->content_type;
  41     $req->cookie;
  42     $req->cookies;
  43     $req->full_uri;
  44     $req->header;
  45     $req->headers;
  46     $req->hostname;
  47     $req->input;
  48     $req->match;
  49     $req->method;
  50     $req->param;
  51     $req->params;
  52     $req->parameters;
  53     $req->path;
  54     $req->protocol;
  55     $req->referer;
  56     $req->secure;
  57     $req->snippets;
  58     $req->upload;
  59     $req->uploads;
  60     $req->uri;
  61     $req->user;
  62     $req->user_agent;
  63
  64 See also L<Catalyst>.
  65
  66 =head1 DESCRIPTION
  67
  68 This is the Catalyst Request class, which provides a set of accessors to the
  69 request data.  The request object is prepared by the specialized Catalyst
  70 Engine module thus hiding the details of the particular engine implementation.
  71
  72
  73 =head1 METHODS
  74
  75 =over 4
  76
  77 =item $req->action
  78
  79 Contains the requested action.
  80
  81     print $c->request->action;
  82
  83 =item $req->address
  84
  85 Contains the remote address.
  86
  87     print $c->request->address
  88
  89 =item $req->args
  90
  91 Shortcut for arguments
  92
  93 =item $req->arguments
  94
  95 Returns a reference to an array containing the arguments.
  96
  97     print $c->request->arguments->[0];
  98
  99 =item $req->base
 100
 101 Contains the url base. This will always have a trailing slash.
 102
 103 =item $req->body
 104
 105 Contains the message body of the request unless Content-Type is
 106 C<application/x-www-form-urlencoded> or C<multipart/form-data>.
 107
 108     print $c->request->body
 109
 110 =item $req->content_encoding
 111
 112 Shortcut to $req->headers->content_encoding
 113
 114 =item $req->content_length
 115
 116 Shortcut to $req->headers->content_length
 117
 118 =item $req->content_type
 119
 120 Shortcut to $req->headers->content_type
 121
 122 =item $req->cookie
 123
 124 A convenient method to $req->cookies.
 125
 126     $cookie  = $c->request->cookie('name');
 127     @cookies = $c->request->cookie;
 128
 129 =cut
 130
 131 sub cookie {
 132     my $self = shift;
 133
 134     if ( @_ == 0 ) {
 135         return keys %{ $self->cookies };
 136     }
 137
 138     if ( @_ == 1 ) {
 139
 140         my $name = shift;
 141
 142         unless ( exists $self->cookies->{$name} ) {
 143             return undef;
 144         }
 145
 146         return $self->cookies->{$name};
 147     }
 148 }
 149
 150 =item $req->cookies
 151
 152 Returns a reference to a hash containing the cookies.
 153
 154     print $c->request->cookies->{mycookie}->value;
 155
 156 =item $req->full_uri
 157
 158 Returns the complete URI, with the parameter query string.
 159
 160 =cut
 161
 162 sub full_uri {
 163   my $self = shift;
 164   my $uri = $self->uri;
 165   my $full_uri = $uri;
 166
 167   if ( scalar $self->param ) {
 168     my @params;
 169     foreach my $arg ( sort keys %{ $self->params } ) {
 170       if ( ref $self->params->{$arg} ) {
 171         my $list = $self->params->{$arg};
 172         push @params, map { "$arg=" . $_  } sort @{$list};
 173       } else {
 174         push @params, "$arg=" . $self->params->{$arg};
 175       }
 176     }
 177     $full_uri .= '?' . join( '&', @params );
 178   }
 179   return $full_uri;
 180 }
 181
 182 =item $req->header
 183
 184 Shortcut to $req->headers->header
 185
 186 =item $req->headers
 187
 188 Returns an L<HTTP::Headers> object containing the headers.
 189
 190     print $c->request->headers->header('X-Catalyst');
 191
 192 =item $req->hostname
 193
 194 Lookup the current users DNS hostname.
 195
 196     print $c->request->hostname
 197
 198 =cut
 199
 200 sub hostname {
 201     my $self = shift;
 202
 203     if ( @_ == 0 && not $self->{hostname} ) {
 204          $self->{hostname} = gethostbyaddr( inet_aton( $self->address ), AF_INET );
 205     }
 206
 207     if ( @_ == 1 ) {
 208         $self->{hostname} = shift;
 209     }
 210
 211     return $self->{hostname};
 212 }
 213
 214 =item $req->input
 215
 216 Shortcut for $req->body.
 217
 218 =item $req->match
 219
 220 This contains the matching part of a regexp action. Otherwise
 221 it returns the same as 'action'.
 222
 223     print $c->request->match;
 224
 225 =item $req->method
 226
 227 Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
 228
 229     print $c->request->method;
 230
 231 =item $req->param
 232
 233 Get request parameters with a CGI.pm-compatible param method. This
 234 is a method for accessing parameters in $c->req->parameters.
 235
 236     $value  = $c->request->param('foo');
 237     @values = $c->request->param('foo');
 238     @params = $c->request->param;
 239
 240 =cut
 241
 242 sub param {
 243     my $self = shift;
 244
 245     if ( @_ == 0 ) {
 246         return keys %{ $self->parameters };
 247     }
 248
 249     if ( @_ == 1 ) {
 250
 251         my $param = shift;
 252
 253         unless ( exists $self->parameters->{$param} ) {
 254             return wantarray ? () : undef;
 255         }
 256
 257         if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
 258             return (wantarray)
 259               ? @{ $self->parameters->{$param} }
 260               : $self->parameters->{$param}->[0];
 261         }
 262         else {
 263             return (wantarray)
 264               ? ( $self->parameters->{$param} )
 265               : $self->parameters->{$param};
 266         }
 267     }
 268
 269     if ( @_ > 1 ) {
 270
 271         while ( my ( $field, $value ) = splice( @_, 0, 2 ) ) {
 272
 273             next unless defined $field;
 274
 275             if ( exists $self->parameters->{$field} ) {
 276                 for ( $self->parameters->{$field} ) {
 277                     $_ = [$_] unless ref($_) eq "ARRAY";
 278                     push( @$_, $value );
 279                 }
 280             }
 281             else {
 282                 $self->parameters->{$field} = $value;
 283             }
 284         }
 285     }
 286 }
 287
 288 =item $req->params
 289
 290 Shortcut for $req->parameters.
 291
 292 =item $req->parameters
 293
 294 Returns a reference to a hash containing parameters. Values can
 295 be either a scalar or an arrayref containing scalars.
 296
 297     print $c->request->parameters->{field};
 298     print $c->request->parameters->{field}->[0];
 299
 300 =item $req->path
 301
 302 Contains the path.
 303
 304     print $c->request->path;
 305
 306 =item $req->protocol
 307
 308 Contains the protocol.
 309
 310 =item $req->referer
 311
 312 Shortcut to $req->headers->referer. Referring page.
 313
 314 =item $req->secure
 315
 316 Contains a boolean whether the communciation is secure.
 317
 318 =item $req->snippets
 319
 320 Returns a reference to an array containing regex snippets.
 321
 322     my @snippets = @{ $c->request->snippets };
 323
 324 =item $req->upload
 325
 326 A convenient method to $req->uploads.
 327
 328     $upload  = $c->request->upload('field');
 329     @uploads = $c->request->upload('field');
 330     @fields  = $c->request->upload;
 331
 332     for my $upload ( $c->request->upload('field') ) {
 333         print $upload->filename;
 334     }
 335
 336 =cut
 337
 338 sub upload {
 339     my $self = shift;
 340
 341     if ( @_ == 0 ) {
 342         return keys %{ $self->uploads };
 343     }
 344
 345     if ( @_ == 1 ) {
 346
 347         my $upload = shift;
 348
 349         unless ( exists $self->uploads->{$upload} ) {
 350             return wantarray ? () : undef;
 351         }
 352
 353         if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
 354             return (wantarray)
 355               ? @{ $self->uploads->{$upload} }
 356               : $self->uploads->{$upload}->[0];
 357         }
 358         else {
 359             return (wantarray)
 360                ? ( $self->uploads->{$upload} )
 361                : $self->uploads->{$upload};
 362         }
 363     }
 364
 365     if ( @_ > 1 ) {
 366
 367         while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
 368
 369             if ( exists $self->uploads->{$field} ) {
 370                 for ( $self->uploads->{$field} ) {
 371                     $_ = [$_] unless ref($_) eq "ARRAY";
 372                     push( @$_, $upload );
 373                 }
 374             }
 375             else {
 376                 $self->uploads->{$field} = $upload;
 377             }
 378         }
 379     }
 380 }
 381
 382 =item $req->uploads
 383
 384 Returns a reference to a hash containing uploads. Values can be either a
 385 hashref or a arrayref containing C<Catalyst::Request::Upload> objects.
 386
 387     my $upload = $c->request->uploads->{field};
 388     my $upload = $c->request->uploads->{field}->[0];
 389
 390 =item $req->uri
 391
 392 Shortcut for C<< $req->base . $req->path >>.
 393
 394 =cut
 395
 396 sub uri {
 397     my $self = shift;
 398     my $path = shift || $self->path || '';
 399     return $self->base . $path;
 400 }
 401
 402 =item $req->user
 403
 404 Contains the user name of user if authentication check was successful.
 405
 406 =item $req->user_agent
 407
 408 Shortcut to $req->headers->user_agent. User Agent version string.
 409
 410 =back
 411
 412 =head1 AUTHOR
 413
 414 Sebastian Riedel, C<sri@cpan.org>
 415 Marcus Ramberg, C<mramberg@cpan.org>
 416
 417 =head1 COPYRIGHT
 418
 419 This program is free software, you can redistribute it and/or modify
 420 it under the same terms as Perl itself.
 421
 422 =cut
 423
 424 1;