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