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