X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FRequest.pm;h=a8b98699d1093adf2ac0832b8521e0ad6064a26b;hb=21465c884872c1ec8c30acd72796445f9eaacb31;hp=db1ed87b5004da6c1d3d11e6d37856654c58ee4d;hpb=6bd2b72cca4b754f154ed1eca98151ac390d9cb5;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm index db1ed87..a8b9869 100644 --- a/lib/Catalyst/Request.pm +++ b/lib/Catalyst/Request.pm @@ -3,9 +3,11 @@ package Catalyst::Request; use strict; use base 'Class::Accessor::Fast'; +use IO::Socket qw[AF_INET inet_aton]; + __PACKAGE__->mk_accessors( - qw/action address arguments body base cookies headers hostname match - method parameters path snippets uploads/ + qw/action address arguments body base cookies headers match method + parameters path protocol secure snippets uploads user/ ); *args = \&arguments; @@ -36,7 +38,9 @@ Catalyst::Request - Catalyst Request Class $req->content_encoding; $req->content_length; $req->content_type; + $req->cookie; $req->cookies; + $req->full_uri; $req->header; $req->headers; $req->hostname; @@ -47,11 +51,15 @@ Catalyst::Request - Catalyst Request Class $req->params; $req->parameters; $req->path; + $req->protocol; $req->referer; + $req->secure; $req->snippets; $req->upload; $req->uploads; - $req->user_agent + $req->uri; + $req->user; + $req->user_agent; See also L. @@ -111,12 +119,65 @@ Shortcut to $req->headers->content_length Shortcut to $req->headers->content_type +=item $req->cookie + +A convenient method to $req->cookies. + + $cookie = $c->request->cookie('name'); + @cookies = $c->request->cookie; + +=cut + +sub cookie { + my $self = shift; + + if ( @_ == 0 ) { + return keys %{ $self->cookies }; + } + + if ( @_ == 1 ) { + + my $name = shift; + + unless ( exists $self->cookies->{$name} ) { + return undef; + } + + return $self->cookies->{$name}; + } +} + =item $req->cookies Returns a reference to a hash containing the cookies. print $c->request->cookies->{mycookie}->value; +=item $req->full_uri + +Returns the complete URI, with the parameter query string. + +=cut + +sub full_uri { + my $self = shift; + my $full_uri = $self->uri; + + if ( scalar $self->param ) { + my @params; + foreach my $arg ( sort keys %{ $self->params } ) { + if ( ref $self->params->{$arg} ) { + my $list = $self->params->{$arg}; + push @params, map { "$arg=" . $_ } sort @{$list}; + } else { + push @params, "$arg=" . $self->params->{$arg}; + } + } + $full_uri .= '?' . join( '&', @params ); + } + return $full_uri; +} + =item $req->header Shortcut to $req->headers->header @@ -129,9 +190,25 @@ Returns an L object containing the headers. =item $req->hostname -Contains the hostname of the remote user. +Lookup the current users DNS hostname. print $c->request->hostname + +=cut + +sub hostname { + my $self = shift; + + if ( @_ == 0 && not $self->{hostname} ) { + $self->{hostname} = gethostbyaddr( inet_aton( $self->address ), AF_INET ); + } + + if ( @_ == 1 ) { + $self->{hostname} = shift; + } + + return $self->{hostname}; +} =item $req->input @@ -139,8 +216,8 @@ Shortcut for $req->body. =item $req->match -This contains be the matching part of a regexp action. otherwise it -returns the same as 'action'. +This contains the matching part of a regexp action. Otherwise +it returns the same as 'action'. print $c->request->match; @@ -152,7 +229,8 @@ Contains the request method (C, C, C, etc). =item $req->param -Get request parameters with a CGI.pm like param method. +Get request parameters with a CGI.pm-compatible param method. This +is a method for accessing parameters in $c->req->parameters. $value = $c->request->param('foo'); @values = $c->request->param('foo'); @@ -167,22 +245,6 @@ sub param { return keys %{ $self->parameters }; } - if ( @_ == 1 and ref( $_[0] ) eq 'ARRAY' ) { - - while ( my ( $field, $value ) = splice( @{ $_[0] }, 0, 2 ) ) { - - if ( exists $self->parameters->{$field} ) { - for ( $self->parameters->{$field} ) { - $_ = [$_] unless ref($_) eq "ARRAY"; - push( @$_, $value ); - } - } - else { - $self->parameters->{$field} = $value; - } - } - } - if ( @_ == 1 ) { my $param = shift; @@ -201,7 +263,25 @@ sub param { ? ( $self->parameters->{$param} ) : $self->parameters->{$param}; } - } + } + + if ( @_ > 1 ) { + + while ( my ( $field, $value ) = splice( @_, 0, 2 ) ) { + + next unless defined $field; + + if ( exists $self->parameters->{$field} ) { + for ( $self->parameters->{$field} ) { + $_ = [$_] unless ref($_) eq "ARRAY"; + push( @$_, $value ); + } + } + else { + $self->parameters->{$field} = $value; + } + } + } } =item $req->params @@ -211,7 +291,7 @@ Shortcut for $req->parameters. =item $req->parameters Returns a reference to a hash containing parameters. Values can -be either a scalar or a arrayref containing scalars. +be either a scalar or an arrayref containing scalars. print $c->request->parameters->{field}; print $c->request->parameters->{field}->[0]; @@ -222,10 +302,18 @@ Contains the path. print $c->request->path; +=item $req->protocol + +Contains the protocol. + =item $req->referer Shortcut to $req->headers->referer. Referring page. +=item $req->secure + +Contains a boolean whether the communciation is secure. + =item $req->snippets Returns a reference to an array containing regex snippets. @@ -253,22 +341,6 @@ sub upload { return keys %{ $self->uploads }; } - if ( @_ == 1 and ref( $_[0] ) eq 'ARRAY' ) { - - while ( my ( $field, $upload ) = splice( @{ $_[0] }, 0, 2 ) ) { - - if ( exists $self->uploads->{$field} ) { - for ( $self->uploads->{$field} ) { - $_ = [$_] unless ref($_) eq "ARRAY"; - push( @$_, $upload ); - } - } - else { - $self->uploads->{$field} = $upload; - } - } - } - if ( @_ == 1 ) { my $upload = shift; @@ -288,6 +360,22 @@ sub upload { : $self->uploads->{$upload}; } } + + if ( @_ > 1 ) { + + while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) { + + if ( exists $self->uploads->{$field} ) { + for ( $self->uploads->{$field} ) { + $_ = [$_] unless ref($_) eq "ARRAY"; + push( @$_, $upload ); + } + } + else { + $self->uploads->{$field} = $upload; + } + } + } } =item $req->uploads @@ -298,6 +386,22 @@ hashref or a arrayref containing C objects. my $upload = $c->request->uploads->{field}; my $upload = $c->request->uploads->{field}->[0]; +=item $req->uri + +Shortcut for C<< $req->base . $req->path >>. + +=cut + +sub uri { + my $self = shift; + my $path = shift || $self->path || ''; + return $self->base . $path; +} + +=item $req->user + +Contains the user name of user if authentication check was successful. + =item $req->user_agent Shortcut to $req->headers->user_agent. User Agent version string.