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->cookie
 121
 122 A convenient method to $req->cookies.
 123
 124     $cookie  = $c->request->cookie('name');
 125     @cookies = $c->request->cookie;
 126
 127 =cut
 128
 129 sub cookie {
 130     my $self = shift;
 131
 132     if ( @_ == 0 ) {
 133         return keys %{ $self->cookie };
 134     }
 135
 136     if ( @_ == 1 ) {
 137
 138         my $name = shift;
 139
 140         unless ( exists $self->cookie->{$name} ) {
 141             return undef;
 142         }
 143
 144         return $self->cookie->{$name};
 145     }
 146 }
 147
 148 =item $req->cookies
 149
 150 Returns a reference to a hash containing the cookies.
 151
 152     print $c->request->cookies->{mycookie}->value;
 153
 154 =item $req->header
 155
 156 Shortcut to $req->headers->header
 157
 158 =item $req->headers
 159
 160 Returns an L<HTTP::Headers> object containing the headers.
 161
 162     print $c->request->headers->header('X-Catalyst');
 163
 164 =item $req->hostname
 165
 166 Lookup the current users DNS hostname.
 167
 168     print $c->request->hostname
 169
 170 =cut
 171
 172 sub hostname {
 173     my $self = shift;
 174
 175     if ( @_ == 0 && not $self->{hostname} ) {
 176          $self->{hostname} = gethostbyaddr( inet_aton( $self->address ), AF_INET );
 177     }
 178
 179     if ( @_ == 1 ) {
 180         $self->{hostname} = shift;
 181     }
 182
 183     return $self->{hostname};
 184 }
 185
 186 =item $req->input
 187
 188 Shortcut for $req->body.
 189
 190 =item $req->match
 191
 192 This contains the matching part of a regexp action. Otherwise
 193 it returns the same as 'action'.
 194
 195     print $c->request->match;
 196
 197 =item $req->method
 198
 199 Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
 200
 201     print $c->request->method;
 202
 203 =item $req->param
 204
 205 Get request parameters with a CGI.pm-compatible param method. This
 206 is a method for accessing parameters in $c->req->parameters.
 207
 208     $value  = $c->request->param('foo');
 209     @values = $c->request->param('foo');
 210     @params = $c->request->param;
 211
 212 =cut
 213
 214 sub param {
 215     my $self = shift;
 216
 217     if ( @_ == 0 ) {
 218         return keys %{ $self->parameters };
 219     }
 220
 221     if ( @_ == 1 ) {
 222
 223         my $param = shift;
 224
 225         unless ( exists $self->parameters->{$param} ) {
 226             return wantarray ? () : undef;
 227         }
 228
 229         if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
 230             return (wantarray)
 231               ? @{ $self->parameters->{$param} }
 232               : $self->parameters->{$param}->[0];
 233         }
 234         else {
 235             return (wantarray)
 236               ? ( $self->parameters->{$param} )
 237               : $self->parameters->{$param};
 238         }
 239     }
 240
 241     if ( @_ > 1 ) {
 242
 243         while ( my ( $field, $value ) = splice( @_, 0, 2 ) ) {
 244
 245             next unless defined $field;
 246
 247             if ( exists $self->parameters->{$field} ) {
 248                 for ( $self->parameters->{$field} ) {
 249                     $_ = [$_] unless ref($_) eq "ARRAY";
 250                     push( @$_, $value );
 251                 }
 252             }
 253             else {
 254                 $self->parameters->{$field} = $value;
 255             }
 256         }
 257     }
 258 }
 259
 260 =item $req->params
 261
 262 Shortcut for $req->parameters.
 263
 264 =item $req->parameters
 265
 266 Returns a reference to a hash containing parameters. Values can
 267 be either a scalar or a arrayref containing scalars.
 268
 269     print $c->request->parameters->{field};
 270     print $c->request->parameters->{field}->[0];
 271
 272 =item $req->path
 273
 274 Contains the path.
 275
 276     print $c->request->path;
 277
 278 =item $req->protocol
 279
 280 Contains the protocol.
 281
 282 =item $req->referer
 283
 284 Shortcut to $req->headers->referer. Referring page.
 285
 286 =item $req->secure
 287
 288 Contains a boolean whether the communciation is secure.
 289
 290 =item $req->snippets
 291
 292 Returns a reference to an array containing regex snippets.
 293
 294     my @snippets = @{ $c->request->snippets };
 295
 296 =item $req->upload
 297
 298 A convenient method to $req->uploads.
 299
 300     $upload  = $c->request->upload('field');
 301     @uploads = $c->request->upload('field');
 302     @fields  = $c->request->upload;
 303
 304     for my $upload ( $c->request->upload('field') ) {
 305         print $upload->filename;
 306     }
 307
 308 =cut
 309
 310 sub upload {
 311     my $self = shift;
 312
 313     if ( @_ == 0 ) {
 314         return keys %{ $self->uploads };
 315     }
 316
 317     if ( @_ == 1 ) {
 318
 319         my $upload = shift;
 320
 321         unless ( exists $self->uploads->{$upload} ) {
 322             return wantarray ? () : undef;
 323         }
 324
 325         if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
 326             return (wantarray)
 327               ? @{ $self->uploads->{$upload} }
 328               : $self->uploads->{$upload}->[0];
 329         }
 330         else {
 331             return (wantarray)
 332                ? ( $self->uploads->{$upload} )
 333                : $self->uploads->{$upload};
 334         }
 335     }
 336
 337     if ( @_ > 1 ) {
 338
 339         while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
 340
 341             if ( exists $self->uploads->{$field} ) {
 342                 for ( $self->uploads->{$field} ) {
 343                     $_ = [$_] unless ref($_) eq "ARRAY";
 344                     push( @$_, $upload );
 345                 }
 346             }
 347             else {
 348                 $self->uploads->{$field} = $upload;
 349             }
 350         }
 351     }
 352 }
 353
 354 =item $req->uploads
 355
 356 Returns a reference to a hash containing uploads. Values can be either a
 357 hashref or a arrayref containing C<Catalyst::Request::Upload> objects.
 358
 359     my $upload = $c->request->uploads->{field};
 360     my $upload = $c->request->uploads->{field}->[0];
 361
 362 =item $req->uri
 363
 364 Shortcut for C<< $req->base . $req->path >>.
 365
 366 =cut
 367
 368 sub uri {
 369     my $self = shift;
 370     my $path = shift || $self->path || '';
 371     return $self->base . $path;
 372 }
 373
 374 =item $req->user
 375
 376 Contains the user name of user if authentication check was successful.
 377
 378 =item $req->user_agent
 379
 380 Shortcut to $req->headers->user_agent. User Agent version string.
 381
 382 =back
 383
 384 =head1 AUTHOR
 385
 386 Sebastian Riedel, C<sri@cpan.org>
 387 Marcus Ramberg, C<mramberg@cpan.org>
 388
 389 =head1 COPYRIGHT
 390
 391 This program is free software, you can redistribute it and/or modify
 392 it under the same terms as Perl itself.
 393
 394 =cut
 395
 396 1;