Change log for Web::Simple
+ - Preserve original env in Web::Dispatch so ParamParser can cache in there
+ (stops HTTP::Body object getting destroyed early thereby losing uploads)
+
0.009 - 2011-10-03
- Complete port from HTTP::Request::AsCGI to Plack::Test
- Add experimental upload support
return $try if ref($try) eq 'ARRAY';
if (ref($try) eq 'HASH') {
- $env = { %$env, %$try };
+ $env = { 'Web::Dispatch.original_env' => $env, %$env, %$try };
next;
}
sub UNPACKED_BODY () { __PACKAGE__.'.unpacked_body' }
sub UNPACKED_BODY_OBJECT () { __PACKAGE__.'.unpacked_body_object' }
sub UNPACKED_UPLOADS () { __PACKAGE__.'.unpacked_uploads' }
+sub ORIG_ENV () { 'Web::Dispatch.original_env' }
sub get_unpacked_query_from {
- return $_[0]->{+UNPACKED_QUERY} ||= do {
+ return ($_[0]->{+ORIG_ENV}||$_[0])->{+UNPACKED_QUERY} ||= do {
_unpack_params($_[0]->{QUERY_STRING})
};
}
sub get_unpacked_body_from {
- return $_[0]->{+UNPACKED_BODY} ||= do {
+ return ($_[0]->{+ORIG_ENV}||$_[0])->{+UNPACKED_BODY} ||= do {
my $ct = lc($_[0]->{CONTENT_TYPE}||'');
if (!$_[0]->{CONTENT_LENGTH}) {
{}
sub get_unpacked_body_object_from {
# we may have no object at all - so use a single element arrayref for ||=
- return ($_[0]->{+UNPACKED_BODY_OBJECT} ||= do {
+ return (($_[0]->{+ORIG_ENV}||$_[0])->{+UNPACKED_BODY_OBJECT} ||= do {
if (!$_[0]->{CONTENT_LENGTH}) {
[ undef ]
} elsif (index(lc($_[0]->{CONTENT_TYPE}||''),'multipart/form-data')==-1) {
my @match = @_;
sub {
my ($env) = @_;
- my $my_env = { %$env };
+ my $my_env = { 'Web::Dispatch.original_env' => $env, %$env };
my $new_env;
my @got;
foreach my $match (@match) {
my $request = HTTP::Request->new($method => $path);
- if ($method eq 'POST' or $method eq 'PUT' and @rest) {
+ if (($method eq 'POST' or $method eq 'PUT') and @rest) {
my $content = do {
require URI;
my $url = URI->new('http:');
sub show_landing {
my ($self, @args) = @_;
local $self->{_dispatcher};
+ local $args[-1]->{'Web::Dispatch.original_env'};
return [
200, ['Content-Type' => 'application/perl' ],
[::Dumper \@args],
sub show_users {
my ($self, @args) = @_;
local $self->{_dispatcher};
+ local $args[-1]->{'Web::Dispatch.original_env'};
return [
200, ['Content-Type' => 'application/perl' ],
[::Dumper \@args],
sub show_user {
my ($self, @args) = @_;
local $self->{_dispatcher};
+ local $args[-1]->{'Web::Dispatch.original_env'};
return [
200, ['Content-Type' => 'application/perl' ],
[::Dumper \@args],
sub process_post {
my ($self, @args) = @_;
local $self->{_dispatcher};
+ local $args[-1]->{'Web::Dispatch.original_env'};
return [
200, ['Content-Type' => 'application/perl' ],
[::Dumper \@args],