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