X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FRequest.pm;h=e134fbebc0eea2e625f9cc20aaee79cdac115011;hp=763c3ef700b82e9c5920cf41006cbfb1d62f598a;hb=059c085bfcead450e70ace9ef193aa99ac2ab37d;hpb=3b4d12511c59793e85feca1ac1b4a8c2c5f1a6ae diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm index 763c3ef..e134fbe 100644 --- a/lib/Catalyst/Request.pm +++ b/lib/Catalyst/Request.pm @@ -1,32 +1,121 @@ package Catalyst::Request; -use strict; -use base 'Class::Accessor::Fast'; - use IO::Socket qw[AF_INET inet_aton]; use Carp; use utf8; +use URI::http; +use URI::https; use URI::QueryParam; -__PACKAGE__->mk_accessors( - qw/action address arguments cookies headers query_keywords match method - protocol query_parameters secure captures uri user/ +use Moose; + +has action => (is => 'rw'); +has address => (is => 'rw'); +has arguments => (is => 'rw', default => sub { [] }); +has cookies => (is => 'rw', default => sub { {} }); +has query_keywords => (is => 'rw'); +has match => (is => 'rw'); +has method => (is => 'rw'); +has protocol => (is => 'rw'); +has query_parameters => (is => 'rw', default => sub { {} }); +has secure => (is => 'rw', default => 0); +has captures => (is => 'rw', default => sub { [] }); +has uri => (is => 'rw'); +has user => (is => 'rw'); +has headers => ( + is => 'rw', + isa => 'HTTP::Headers', + handles => [qw(content_encoding content_length content_type header referer user_agent)], +); + +has _context => ( + is => 'rw', + weak_ref => 1, +); + +has body_parameters => ( + is => 'rw', + required => 1, + lazy => 1, + default => sub { {} }, ); -*args = \&arguments; -*body_params = \&body_parameters; -*input = \&body; -*params = \¶meters; -*query_params = \&query_parameters; -*path_info = \&path; -*snippets = \&captures; - -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(@_) } +before body_parameters => sub { + my ($self) = @_; + $self->_context->prepare_body(); +}; + +has uploads => ( + is => 'rw', + required => 1, + lazy => 1, + default => sub { {} }, +); + +before uploads => sub { + my ($self) = @_; + $self->_context->prepare_body; +}; + +has parameters => ( + is => 'rw', + required => 1, + lazy => 1, + default => sub { {} }, +); + +before parameters => sub { + my ($self, $params) = @_; + $self->_context->prepare_body(); + if ( $params && !ref $params ) { + $self->_context->log->warn( + "Attempt to retrieve '$params' with req->params(), " . + "you probably meant to call req->param('$params')" ); + $params = undef; + } + +}; + +has base => ( + is => 'rw', + required => 1, + lazy => 1, + default => sub { + my $self = shift; + if( $self->uri ){ + return $self->path; + } + }, +); + +has body => ( + is => 'rw' +); + +before body => sub { + my ($self) = @_; + $self->_context->prepare_body(); +}; + +has hostname => ( + is => 'rw', + required => 1, + lazy => 1, + default => sub { + my ($self) = @_; + gethostbyaddr( inet_aton( $self->address ), AF_INET ) + }, +); + +no Moose; + +sub args { shift->arguments(@_) } +sub body_params { shift->body_parameters(@_) } +sub input { shift->body(@_) } +sub params { shift->parameters(@_) } +sub query_params { shift->query_parameters(@_) } +sub path_info { shift->path(@_) } +sub snippets { shift->captures(@_) } =head1 NAME @@ -120,39 +209,11 @@ Contains the URI base. This will always have a trailing slash. If your application was queried with the URI C then C is C. -=cut - -sub base { - my ( $self, $base ) = @_; - - return $self->{base} unless $base; - - $self->{base} = $base; - - # set the value in path for backwards-compat - if ( $self->uri ) { - $self->path; - } - - return $self->{base}; -} - =head2 $req->body Returns the message body of the request, unless Content-Type is C or C. -=cut - -sub body { - my $self = shift; - $self->{_context}->prepare_body; - - return unless $self->{_body}; - - return $self->{_body}->body; -} - =head2 $req->body_parameters Returns a reference to a hash containing body (POST) parameters. Values can @@ -167,15 +228,6 @@ These are the parameters from the POST part of the request, if any. Shortcut for body_parameters. -=cut - -sub body_parameters { - my ( $self, $params ) = @_; - $self->{_context}->prepare_body; - $self->{body_parameters} = $params if $params; - return $self->{body_parameters}; -} - =head2 $req->content_encoding Shortcut for $req->headers->content_encoding. @@ -239,23 +291,6 @@ Returns an L object containing the headers for the current reques Returns the hostname of the client. -=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}; -} - =head2 $req->input Alias for $req->body. @@ -346,24 +381,6 @@ This is the combination of C and C. Shortcut for $req->parameters. -=cut - -sub parameters { - my ( $self, $params ) = @_; - $self->{_context}->prepare_body; - if ( $params ) { - if ( ref $params ) { - $self->{parameters} = $params; - } - else { - $self->{_context}->log->warn( - "Attempt to retrieve '$params' with req->params(), " . - "you probably meant to call req->param('$params')" ); - } - } - return $self->{parameters}; -} - =head2 $req->path Returns the path, i.e. the part of the URI after $req->base, for the current request. @@ -401,6 +418,8 @@ Returns the protocol (HTTP/1.0 or HTTP/1.1) used for the current request. =head2 $req->query_parameters +=head2 $req->query_params + Returns a reference to a hash containing query string (GET) parameters. Values can be either a scalar or an arrayref containing scalars. @@ -417,7 +436,7 @@ You have to set MyApp->config->{parse_on_demand} to use this directly. =cut -sub read { shift->{_context}->read(@_); } +sub read { shift->_context->read(@_); } =head2 $req->referer @@ -505,15 +524,6 @@ L 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}; -} - =head2 $req->uri Returns a URI object for the current request. Stringifies to the URI text. @@ -535,7 +545,7 @@ sub uri_with { next unless defined $value; for ( ref $value eq 'ARRAY' ? @$value : $value ) { $_ = "$_"; - utf8::encode( $_ ); + utf8::encode( $_ ) if utf8::is_utf8($_); } }; @@ -558,6 +568,10 @@ newer plugins is $c->user. Shortcut to $req->headers->user_agent. Returns the user agent (browser) version string. +=head2 meta + +Provided by Moose + =head1 AUTHORS Sebastian Riedel, C