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