X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FRequest.pm;h=b38b693e1e0904f7057fa0757e9ccfcaab694c5f;hb=79f8efb873b3bb1d33f156969a5ce5c95d28f4cf;hp=db1ed87b5004da6c1d3d11e6d37856654c58ee4d;hpb=6bd2b72cca4b754f154ed1eca98151ac390d9cb5;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm index db1ed87..b38b693 100644 --- a/lib/Catalyst/Request.pm +++ b/lib/Catalyst/Request.pm @@ -3,21 +3,26 @@ 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 base cookies headers match method + protocol query_parameters secure snippets uri user/ ); -*args = \&arguments; -*input = \&body; -*params = \¶meters; +*args = \&arguments; +*body_params = \&body_parameters; +*input = \&body; +*params = \¶meters; +*query_params = \&query_parameters; +*path_info = \&path; sub content_encoding { shift->headers->content_encoding(@_) } -sub content_length { shift->headers->content_length(@_) } -sub content_type { shift->headers->content_type(@_) } -sub header { shift->headers->header(@_) } -sub referer { shift->headers->referer(@_) } -sub user_agent { shift->headers->user_agent(@_) } +sub content_length { shift->headers->content_length(@_) } +sub content_type { shift->headers->content_type(@_) } +sub header { shift->headers->header(@_) } +sub referer { shift->headers->referer(@_) } +sub user_agent { shift->headers->user_agent(@_) } =head1 NAME @@ -33,9 +38,11 @@ Catalyst::Request - Catalyst Request Class $req->arguments; $req->base; $req->body; + $req->body_parameters; $req->content_encoding; $req->content_length; $req->content_type; + $req->cookie; $req->cookies; $req->header; $req->headers; @@ -47,11 +54,17 @@ Catalyst::Request - Catalyst Request Class $req->params; $req->parameters; $req->path; + $req->protocol; + $req->query_parameters; + $req->read; $req->referer; + $req->secure; $req->snippets; $req->upload; $req->uploads; - $req->user_agent + $req->uri; + $req->user; + $req->user_agent; See also L. @@ -99,6 +112,35 @@ C or C. print $c->request->body +=cut + +sub body { + my ( $self, $body ) = @_; + $self->{_context}->prepare_body; + return $self->{_body}->body; +} + +=item $req->body_parameters + +Returns a reference to a hash containing body parameters. Values can +be either a scalar or an arrayref containing scalars. + + print $c->request->body_parameters->{field}; + print $c->request->body_parameters->{field}->[0]; + +=item $req->body_params + +An alias for body_parameters. + +=cut + +sub body_parameters { + my ( $self, $params ) = @_; + $self->{_context}->prepare_body; + $self->{body_parameters} = $params if $params; + return $self->{body_parameters}; +} + =item $req->content_encoding Shortcut to $req->headers->content_encoding @@ -111,6 +153,34 @@ 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. @@ -129,9 +199,26 @@ 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 +226,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 +239,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 +255,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 +273,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,21 +301,80 @@ 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]; +=cut + +sub parameters { + my ( $self, $params ) = @_; + $self->{_context}->prepare_body; + $self->{parameters} = $params if $params; + return $self->{parameters}; +} + =item $req->path Contains the path. print $c->request->path; +=item $req->path_info + +alias for path, added for compability with L + +=cut + +sub path { + my ( $self, $params ) = @_; + + if ($params) { + $self->uri->path($params); + } + + my $path = $self->uri->path; + my $location = $self->base->path; + $path =~ s/^(\Q$location\E)?//; + $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; + $path =~ s/^\///; + + return $path; +} + +=item $req->protocol + +Contains the protocol. + +=item $req->query_parameters + +Returns a reference to a hash containing query parameters. Values can +be either a scalar or an arrayref containing scalars. + + print $c->request->query_parameters->{field}; + print $c->request->query_parameters->{field}->[0]; + +=item $req->read( [$maxlength] ) + +Read a chunk of data from the request body. This method is designed to be +used in a while loop, reading $maxlength bytes on every call. $maxlength +defaults to the size of the request if not specified. + +You have to set MyApp->config->{parse_on_demand} to use this directly. + +=cut + +sub read { shift->{_context}->read(@_); } + =item $req->referer Shortcut to $req->headers->referer. Referring page. +=item $req->secure + +Contains a boolean denoting whether the communication is secure. + =item $req->snippets Returns a reference to an array containing regex snippets. @@ -253,22 +402,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; @@ -284,8 +417,24 @@ sub upload { } else { return (wantarray) - ? ( $self->uploads->{$upload} ) - : $self->uploads->{$upload}; + ? ( $self->uploads->{$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; + } } } } @@ -298,6 +447,23 @@ hashref or a arrayref containing C objects. my $upload = $c->request->uploads->{field}; my $upload = $c->request->uploads->{field}->[0]; +=cut + +sub uploads { + my ( $self, $uploads ) = @_; + $self->{_context}->prepare_body; + $self->{uploads} = $uploads if $uploads; + return $self->{uploads}; +} + +=item $req->uri + +Returns a URI object for the request. + +=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.