diff options
-rw-r--r-- | lib/Web/Request.pm | 78 | ||||
-rw-r--r-- | lib/Web/Response.pm | 29 |
2 files changed, 88 insertions, 19 deletions
diff --git a/lib/Web/Request.pm b/lib/Web/Request.pm index 905d1d7..3830344 100644 --- a/lib/Web/Request.pm +++ b/lib/Web/Request.pm @@ -377,17 +377,14 @@ has all_uploads => ( ); has encoding => ( - is => 'rw', - isa => 'Str', - builder => 'default_encoding', - trigger => sub { + accessor => '_encoding', + isa => 'Str', + predicate => 'has_encoding', + clearer => '_clear_encoding', + builder => 'default_encoding', + trigger => sub { my $self = shift; - $self->_clear_encoding_obj; - $self->_clear_content; - $self->_clear_query_parameters; - $self->_clear_all_query_parameters; - $self->_clear_body_parameters; - $self->_clear_all_body_parameters; + $self->_clear_encoded_data; }, ); @@ -397,9 +394,15 @@ has _encoding_obj => ( lazy => 1, clearer => '_clear_encoding_obj', default => sub { Encode::find_encoding(shift->encoding) }, - handles => ['decode', 'encode'], ); +sub BUILDARGS { + my $class = shift; + my $params = $class->SUPER::BUILDARGS(@_); + delete $params->{encoding} unless defined $params->{encoding}; + return $params; +} + sub new_from_env { my $class = shift; my ($env) = @_; @@ -418,7 +421,7 @@ sub new_response { my $self = shift; Class::Load::load_class($self->response_class); - $self->response_class->new(@_); + $self->response_class->new(_encoding_obj => $self->_encoding_obj, @_); } sub _new_upload { @@ -465,6 +468,39 @@ sub param { $self->parameters->{$key}; } +sub decode { + my $self = shift; + my ($content) = @_; + return $content unless $self->has_encoding; + return $self->_encoding_obj->decode($content); +} + +sub encoding { + my $self = shift; + my ($encoding) = @_; + + return $self->_encoding unless @_; + + if (defined($encoding)) { + return $self->_encoding($encoding); + } + else { + $self->_clear_encoding; + $self->_clear_encoded_data; + return; + } +} + +sub _clear_encoded_data { + my $self = shift; + $self->_clear_encoding_obj; + $self->_clear_content; + $self->_clear_query_parameters; + $self->_clear_all_query_parameters; + $self->_clear_body_parameters; + $self->_clear_all_body_parameters; +} + sub response_class { 'Web::Response' } sub upload_class { 'Web::Request::Upload' } sub default_encoding { 'iso8859-1' } @@ -494,8 +530,9 @@ A L<PSGI> environment hashref. Required. =item encoding -The encoding to use for decoding all input in the request. Defaults to -the value of C<default_encoding>. +The encoding to use for decoding all input in the request and encoding all +output in the response. Defaults to the value of C<default_encoding>. If +C<undef> is passed, no encoding or decoding will be done. =back @@ -669,9 +706,14 @@ Returns a new response object, passing C<@params> to its constructor. Returns the L<PSGI> environment that was provided in the constructor (or generated from the L<HTTP::Request>, if C<new_from_request> was used). -=method encoding +=method encoding($enc) -Returns the encoding that was provided in the constructor. +Returns the encoding that was provided in the constructor. You can also pass an +encoding name to this method to set the encoding that will be used to decode +the content and encode the response. For instance, you can set the encoding to +UTF-8 in order to read the body content and parameters, and then set the +encoding to C<undef> at the end of the handler in order to indicate that the +response should not be encoded (for instance, if it is a binary file). =method response_class @@ -687,8 +729,8 @@ overridden in a subclass. =method default_encoding -Returns the name of the default encoding to use for C<encode> and C<decode>. -Defaults to iso8859-1. This can be overridden in a subclass. +Returns the name of the default encoding to use for C<decode>. Defaults to +iso8859-1. This can be overridden in a subclass. =head1 BUGS diff --git a/lib/Web/Response.pm b/lib/Web/Response.pm index bc82526..89c0e26 100644 --- a/lib/Web/Response.pm +++ b/lib/Web/Response.pm @@ -3,6 +3,7 @@ use Moose; # ABSTRACT: common response class for web frameworks use HTTP::Headers (); +use Plack::Util (); use URI::Escape (); use Web::Request::Types (); @@ -69,6 +70,15 @@ has cookies => ( default => sub { +{} }, ); +has _encoding_obj => ( + is => 'ro', + isa => 'Object', + predicate => 'has_encoding', + handles => { + encoding => 'name', + }, +); + sub redirect { my $self = shift; my ($url, $status) = @_; @@ -82,7 +92,7 @@ sub finalize { $self->_finalize_cookies; - return [ + my $res = [ $self->status, [ map { @@ -99,6 +109,23 @@ sub finalize { ], $self->content ]; + + return $res unless $self->has_encoding; + + return Plack::Util::response_cb($res, sub { + return sub { + my $chunk = shift; + return unless defined $chunk; + return $self->encode($chunk); + }; + }); +} + +sub encode { + my $self = shift; + my ($content) = @_; + return $content unless $self->has_encoding; + return $self->_encoding_obj->encode($content); } sub _finalize_cookies { |