r62715 - in /branches/upstream/libplack-perl/current: ./ inc/Module/Install/ lib/ lib/Plack/ lib/Plack/App/ lib/Plack/Handler/ lib/Plack/Handler/Apache2/ lib/Plack/Loader/ lib/Plack/Middleware/ lib/Plack/Middleware/Auth/ lib/Plack/Server/ t/Plack-Handler/ t/Plack-Middleware/ t/Plack-Request/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Mon Sep 20 13:12:43 UTC 2010
Author: eloy
Date: Mon Sep 20 13:12:02 2010
New Revision: 62715
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=62715
Log:
[svn-upgrade] new version libplack-perl (0.9949)
Added:
branches/upstream/libplack-perl/current/t/Plack-Middleware/access_log_value_zero.t
branches/upstream/libplack-perl/current/t/Plack-Middleware/auth_basic_env.t
Modified:
branches/upstream/libplack-perl/current/Changes
branches/upstream/libplack-perl/current/MANIFEST
branches/upstream/libplack-perl/current/META.yml
branches/upstream/libplack-perl/current/inc/Module/Install/ReadmeFromPod.pm
branches/upstream/libplack-perl/current/lib/Plack.pm
branches/upstream/libplack-perl/current/lib/Plack/App/CGIBin.pm
branches/upstream/libplack-perl/current/lib/Plack/App/Directory.pm
branches/upstream/libplack-perl/current/lib/Plack/Handler/Apache2.pm
branches/upstream/libplack-perl/current/lib/Plack/Handler/Apache2/Registry.pm
branches/upstream/libplack-perl/current/lib/Plack/Handler/FCGI.pm
branches/upstream/libplack-perl/current/lib/Plack/Loader.pm
branches/upstream/libplack-perl/current/lib/Plack/Loader/Restarter.pm
branches/upstream/libplack-perl/current/lib/Plack/Middleware/AccessLog.pm
branches/upstream/libplack-perl/current/lib/Plack/Middleware/Auth/Basic.pm
branches/upstream/libplack-perl/current/lib/Plack/Request.pm
branches/upstream/libplack-perl/current/lib/Plack/Response.pm
branches/upstream/libplack-perl/current/lib/Plack/Server/ServerSimple.pm
branches/upstream/libplack-perl/current/t/Plack-Handler/net_fastcgi.t
branches/upstream/libplack-perl/current/t/Plack-Middleware/wrapcgi.t
branches/upstream/libplack-perl/current/t/Plack-Request/upload.t
Modified: branches/upstream/libplack-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/Changes?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/Changes (original)
+++ branches/upstream/libplack-perl/current/Changes Mon Sep 20 13:12:02 2010
@@ -1,6 +1,26 @@
Revision history for Perl extension Plack
Take a look at http://github.com/miyagawa/Plack/issues for the planned changes before 1.0 release.
+
+0.9949 Tue Sep 14 11:59:36 PDT 2010
+ - Fixed FCGI handler docs
+ - Auth::Basic: PAss $env to the callback so .htpasswd based auth can be implemented with PATH_INFO (doy)
+
+0.9948 Thu Sep 9 16:01:53 PDT 2010
+ - Fixed a bug introduced in 0.9947 where $req->upload loses the temporary files when
+ Plack::Request object is instantiated multiple times. It could happen if one of the
+ pre-processing middleware uses Plack::Request and then again in the application or
+ frameworks.
+
+0.9947 Thu Sep 9 02:26:14 PDT 2010
+ - Plack::Loader: Fixed a typo in ENV that prevents warnings messages in development
+ - Added flymake temporary file in Restarter (hirose31)
+ - Plack::Request: Fixed a bug that HTTP::Body temporary files were not cleaned up (plu)
+ - Middleware::AccessLog: Fixed a bug where %{key}i ignores the value '0' (nekoya)
+
+0.9946 Sat Aug 28 22:32:16 PDT 2010
+ - Fixes UUV warnings in Apache2 handler RT:60472
+ - Fixed various test failures due to dependencies
0.9945 Thu Aug 19 16:24:30 PDT 2010
- Support executing (non-perl) CGI scripts in CGIBin and WrapCGI
Modified: branches/upstream/libplack-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/MANIFEST?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/MANIFEST (original)
+++ branches/upstream/libplack-perl/current/MANIFEST Mon Sep 20 13:12:02 2010
@@ -155,7 +155,9 @@
t/Plack-Loader/shotgun.t
t/Plack-Middleware/access_log.t
t/Plack-Middleware/access_log_timed.t
+t/Plack-Middleware/access_log_value_zero.t
t/Plack-Middleware/auth_basic.t
+t/Plack-Middleware/auth_basic_env.t
t/Plack-Middleware/auth_basic_simple.t
t/Plack-Middleware/bufferedstreaming.t
t/Plack-Middleware/cascade.t
Modified: branches/upstream/libplack-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/META.yml?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/META.yml (original)
+++ branches/upstream/libplack-perl/current/META.yml Mon Sep 20 13:12:02 2010
@@ -38,4 +38,4 @@
resources:
license: http://dev.perl.org/licenses/
repository: git://github.com/miyagawa/Plack.git
-version: 0.9945
+version: 0.9949
Modified: branches/upstream/libplack-perl/current/inc/Module/Install/ReadmeFromPod.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/inc/Module/Install/ReadmeFromPod.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/inc/Module/Install/ReadmeFromPod.pm (original)
+++ branches/upstream/libplack-perl/current/inc/Module/Install/ReadmeFromPod.pm Mon Sep 20 13:12:02 2010
@@ -1,36 +1,48 @@
#line 1
package Module::Install::ReadmeFromPod;
+use 5.006;
use strict;
use warnings;
use base qw(Module::Install::Base);
use vars qw($VERSION);
-$VERSION = '0.10';
+$VERSION = '0.12';
sub readme_from {
my $self = shift;
- return unless $Module::Install::AUTHOR;
- my $file = shift || return;
+ return unless $self->is_admin;
+
+ my $file = shift || $self->_all_from
+ or die "Can't determine file to make readme_from";
my $clean = shift;
+
+ print "Writing README from $file\n";
+
require Pod::Text;
my $parser = Pod::Text->new();
open README, '> README' or die "$!\n";
$parser->output_fh( *README );
$parser->parse_file( $file );
- return 1 unless $clean;
- $self->postamble(<<"END");
-distclean :: license_clean
+ if ($clean) {
+ $self->clean_files('README');
+ }
+ return 1;
+}
-license_clean:
-\t\$(RM_F) README
-END
- return 1;
+sub _all_from {
+ my $self = shift;
+ return unless $self->admin->{extensions};
+ my ($metadata) = grep {
+ ref($_) eq 'Module::Install::Metadata';
+ } @{$self->admin->{extensions}};
+ return unless $metadata;
+ return $metadata->{values}{all_from} || '';
}
'Readme!';
__END__
-#line 94
+#line 112
Modified: branches/upstream/libplack-perl/current/lib/Plack.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack.pm Mon Sep 20 13:12:02 2010
@@ -3,7 +3,7 @@
use strict;
use warnings;
use 5.008_001;
-our $VERSION = '0.9945';
+our $VERSION = '0.9949';
$VERSION = eval $VERSION;
1;
Modified: branches/upstream/libplack-perl/current/lib/Plack/App/CGIBin.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/App/CGIBin.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/App/CGIBin.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/App/CGIBin.pm Mon Sep 20 13:12:02 2010
@@ -107,13 +107,13 @@
takes a file path to its first argument.
For example, if your perl-based CGI script uses lots of global
-variables and such and are not ready to run on a persisten
+variables and such and are not ready to run on a persistent
environment, you can do:
my $app = Plack::App::CGIBin->new(
root => "/path/to/cgi-bin",
exec_cb => sub { 1 },
- );
+ )->to_app;
to always force the execute option for any files.
Modified: branches/upstream/libplack-perl/current/lib/Plack/App/Directory.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/App/Directory.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/App/Directory.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/App/Directory.pm Mon Sep 20 13:12:02 2010
@@ -58,7 +58,9 @@
for my $basename (sort { $a cmp $b } @children) {
my $file = "$dir/$basename";
- my $url = $env->{SCRIPT_NAME} . $env->{PATH_INFO} . $basename;
+ my $url = $env->{SCRIPT_NAME} . $env->{PATH_INFO};
+ $url .= '/' unless $url =~ m{/$};
+ $url .= $basename;
my $is_dir = -d $file;
my @stat = stat _;
Modified: branches/upstream/libplack-perl/current/lib/Plack/Handler/Apache2.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Handler/Apache2.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Handler/Apache2.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Handler/Apache2.pm Mon Sep 20 13:12:02 2010
@@ -48,7 +48,7 @@
'psgi.nonblocking' => Plack::Util::FALSE,
};
- $class->_recalc_paths($r, $env);
+ $class->fixup_path($r, $env);
my $res = $app->($env);
@@ -75,9 +75,9 @@
}
# The method for PH::Apache2::Regitsry to override.
-sub _recalc_paths {
+sub fixup_path {
my ($class, $r, $env) = @_;
- my $vpath = $env->{SCRIPT_NAME} . $env->{PATH_INFO};
+ my $vpath = $env->{SCRIPT_NAME} . ($env->{PATH_INFO} || '');
my $location = $r->location || "/";
$location =~ s{/$}{};
(my $path_info = $vpath) =~ s/^\Q$location\E//;
Modified: branches/upstream/libplack-perl/current/lib/Plack/Handler/Apache2/Registry.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Handler/Apache2/Registry.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Handler/Apache2/Registry.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Handler/Apache2/Registry.pm Mon Sep 20 13:12:02 2010
@@ -25,7 +25,7 @@
}
# Overriding
-sub _recalc_paths {}
+sub fixup_path {}
1;
Modified: branches/upstream/libplack-perl/current/lib/Plack/Handler/FCGI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Handler/FCGI.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Handler/FCGI.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Handler/FCGI.pm Mon Sep 20 13:12:02 2010
@@ -196,7 +196,7 @@
# Roll your own
my $server = Plack::Handler::FCGI->new(
nproc => $num_proc,
- listen => $listen,
+ listen => [ $port_or_socket ],
detach => 1,
);
$server->run($app);
@@ -213,8 +213,8 @@
=item listen
- listen => '/path/to/socket'
- listen => ':8080'
+ listen => [ '/path/to/socket' ]
+ listen => [ ':8080' ]
Listen on a socket path, hostname:port, or :port.
Modified: branches/upstream/libplack-perl/current/lib/Plack/Loader.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Loader.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Loader.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Loader.pm Mon Sep 20 13:12:02 2010
@@ -24,7 +24,7 @@
} catch {
warn "Autoloading '$backend' backend failed. Falling back to the Standalone. ",
"(You might need to install Plack::Handler::$backend from CPAN. Caught error was: $_)\n"
- if $ENV{PLACK_DEV} && $ENV{PLACK_DEV} eq 'development';
+ if $ENV{PLACK_ENV} && $ENV{PLACK_ENV} eq 'development';
$class->load('Standalone' => @args);
};
Modified: branches/upstream/libplack-perl/current/lib/Plack/Loader/Restarter.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Loader/Restarter.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Loader/Restarter.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Loader/Restarter.pm Mon Sep 20 13:12:02 2010
@@ -47,7 +47,7 @@
sub valid_file {
my($self, $file) = @_;
- $file->{path} !~ m![/\\][\._]|\.bak$|~$!;
+ $file->{path} !~ m![/\\][\._]|\.bak$|~$|_flymake\.p[lm]!;
}
sub run {
Modified: branches/upstream/libplack-perl/current/lib/Plack/Middleware/AccessLog.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Middleware/AccessLog.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Middleware/AccessLog.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Middleware/AccessLog.pm Mon Sep 20 13:12:02 2010
@@ -46,7 +46,8 @@
my($block, $type) = @_;
if ($type eq 'i') {
$block =~ s/-/_/;
- return _safe($env->{"HTTP_" . uc($block)}) || "-";
+ my $val = _safe($env->{"HTTP_" . uc($block)});
+ return defined $val ? $val : "-";
} elsif ($type eq 'o') {
return scalar $h->get($block) || "-";
} elsif ($type eq 't') {
Modified: branches/upstream/libplack-perl/current/lib/Plack/Middleware/Auth/Basic.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Middleware/Auth/Basic.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Middleware/Auth/Basic.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Middleware/Auth/Basic.pm Mon Sep 20 13:12:02 2010
@@ -10,7 +10,7 @@
my $auth = $self->authenticator or die 'authenticator is not set';
if (Scalar::Util::blessed($auth) && $auth->can('authenticate')) {
- $self->authenticator(sub { $auth->authenticate(@_) });
+ $self->authenticator(sub { $auth->authenticate(@_[0,1]) }); # because Authen::Simple barfs on 3 params
} elsif (ref $auth ne 'CODE') {
die 'authenticator should be a code reference or an object that responds to authenticate()';
}
@@ -25,7 +25,7 @@
if ($auth =~ /^Basic (.*)$/) {
my($user, $pass) = split /:/, (MIME::Base64::decode($1) || ":");
$pass = '' unless defined $pass;
- if ($self->authenticator->($user, $pass)) {
+ if ($self->authenticator->($user, $pass, $env)) {
$env->{REMOTE_USER} = $user;
return $self->app->($env);
}
Modified: branches/upstream/libplack-perl/current/lib/Plack/Request.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Request.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Request.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Request.pm Mon Sep 20 13:12:02 2010
@@ -2,7 +2,7 @@
use strict;
use warnings;
use 5.008_001;
-our $VERSION = '0.9945';
+our $VERSION = '0.9949';
$VERSION = eval $VERSION;
use HTTP::Headers;
@@ -264,6 +264,14 @@
my $body = HTTP::Body->new($ct, $cl);
+ # HTTP::Body will create temporary files in case there was an
+ # upload. Those temporary files can be cleaned up by telling
+ # HTTP::Body to do so. It will run the cleanup when the request
+ # env is destroyed. That the object will not go out of scope by
+ # the end of this sub we will store a reference here.
+ $self->env->{'plack.request.http.body'} = $body;
+ $body->cleanup(1);
+
my $input = $self->input;
my $buffer;
Modified: branches/upstream/libplack-perl/current/lib/Plack/Response.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Response.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Response.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Response.pm Mon Sep 20 13:12:02 2010
@@ -1,7 +1,7 @@
package Plack::Response;
use strict;
use warnings;
-our $VERSION = '0.9945';
+our $VERSION = '0.9949';
$VERSION = eval $VERSION;
use Plack::Util::Accessor qw(body status);
Modified: branches/upstream/libplack-perl/current/lib/Plack/Server/ServerSimple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Server/ServerSimple.pm?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Server/ServerSimple.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Server/ServerSimple.pm Mon Sep 20 13:12:02 2010
@@ -1,6 +1,6 @@
package Plack::Server::ServerSimple;
use strict;
-our $VERSION = '0.9945';
+our $VERSION = '0.9949';
$VERSION = eval $VERSION;
use parent qw(Plack::Handler::HTTP::Server::Simple);
Modified: branches/upstream/libplack-perl/current/t/Plack-Handler/net_fastcgi.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/t/Plack-Handler/net_fastcgi.t?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/t/Plack-Handler/net_fastcgi.t (original)
+++ branches/upstream/libplack-perl/current/t/Plack-Handler/net_fastcgi.t Mon Sep 20 13:12:02 2010
@@ -1,7 +1,7 @@
use strict;
use warnings;
use Test::More;
-use Test::Requires { 'Net::FastCGI' => 0.11, 'FCGI::Client' => 0.04 };
+use Test::Requires { 'Net::FastCGI' => 0.12, 'FCGI::Client' => 0.04 };
use Plack::Handler::Net::FastCGI;
use Test::TCP;
use Plack::Test::Suite;
Added: branches/upstream/libplack-perl/current/t/Plack-Middleware/access_log_value_zero.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/t/Plack-Middleware/access_log_value_zero.t?rev=62715&op=file
==============================================================================
--- branches/upstream/libplack-perl/current/t/Plack-Middleware/access_log_value_zero.t (added)
+++ branches/upstream/libplack-perl/current/t/Plack-Middleware/access_log_value_zero.t Mon Sep 20 13:12:02 2010
@@ -1,0 +1,40 @@
+use strict;
+use warnings;
+use Test::More;
+use HTTP::Request::Common;
+use Plack::Test;
+use Plack::Builder;
+use POSIX;
+
+my $log;
+
+my $test = sub {
+ my $format = shift;
+ return sub {
+ my $req = shift;
+ my $app = builder {
+ enable "Plack::Middleware::AccessLog",
+ logger => sub { $log = "@_" }, format => $format;
+ sub { [ 200, [ 'Content-Type' => 'text/plain' ], [ 'OK' ] ] };
+ };
+ test_psgi $app, sub { $_[0]->($req) };
+ };
+};
+
+{
+ my $req = GET "http://example.com/";
+ $req->header("Zero" => "0");
+
+ my $fmt = "%{zero}i %{undef}i";
+ $test->($fmt)->($req);
+ chomp $log;
+ is $log, "0 -";
+}
+
+{
+ $test->("%D")->(GET "/");
+ chomp $log;
+ is $log, '-';
+}
+
+done_testing;
Added: branches/upstream/libplack-perl/current/t/Plack-Middleware/auth_basic_env.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/t/Plack-Middleware/auth_basic_env.t?rev=62715&op=file
==============================================================================
--- branches/upstream/libplack-perl/current/t/Plack-Middleware/auth_basic_env.t (added)
+++ branches/upstream/libplack-perl/current/t/Plack-Middleware/auth_basic_env.t Mon Sep 20 13:12:02 2010
@@ -1,0 +1,59 @@
+use Test::More;
+use Plack::Test;
+use Plack::Builder;
+use Plack::Request;
+use HTTP::Request::Common;
+
+my $app = sub { return [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hello $_[0]->{REMOTE_USER}" ] ] };
+$app = builder {
+ enable "Auth::Basic", authenticator => \&cb;
+ $app;
+};
+
+sub cb {
+ my($username, $password, $env) = @_;
+ my $req = Plack::Request->new($env);
+ if ($req->path eq '/') {
+ return $username eq 'admin' && $password eq 's3cr3t';
+ }
+ else {
+ return $username eq 'user' && $password eq 's0m3th1ngel5e';
+ }
+}
+
+test_psgi app => $app, client => sub {
+ my $cb = shift;
+
+ {
+ my $res = $cb->(GET "http://localhost/");
+ is $res->code, 401;
+ }
+
+ {
+ my $req = GET "http://localhost/", "Authorization" => "Basic YWRtaW46czNjcjN0";
+ my $res = $cb->($req);
+ is $res->code, 200;
+ is $res->content, "Hello admin";
+ }
+
+ {
+ my $req = GET "http://localhost/", "Authorization" => "Basic dXNlcjpzMG0zdGgxbmdlbDVl";
+ my $res = $cb->($req);
+ is $res->code, 401;
+ }
+
+ {
+ my $req = GET "http://localhost/foo", "Authorization" => "Basic YWRtaW46czNjcjN0";
+ my $res = $cb->($req);
+ is $res->code, 401;
+ }
+
+ {
+ my $req = GET "http://localhost/foo", "Authorization" => "Basic dXNlcjpzMG0zdGgxbmdlbDVl";
+ my $res = $cb->($req);
+ is $res->code, 200;
+ is $res->content, "Hello user";
+ }
+};
+done_testing;
+
Modified: branches/upstream/libplack-perl/current/t/Plack-Middleware/wrapcgi.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/t/Plack-Middleware/wrapcgi.t?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/t/Plack-Middleware/wrapcgi.t (original)
+++ branches/upstream/libplack-perl/current/t/Plack-Middleware/wrapcgi.t Mon Sep 20 13:12:02 2010
@@ -1,6 +1,6 @@
use strict;
use Test::More;
-use Test::Requires { 'CGI::Emulate::PSGI' => 0, 'CGI::Compile' => 0.03 };
+use Test::Requires { 'CGI::Emulate::PSGI' => 0.06, 'CGI::Compile' => 0.03 };
use Plack::Test;
use HTTP::Request::Common;
use Plack::App::WrapCGI;
Modified: branches/upstream/libplack-perl/current/t/Plack-Request/upload.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/t/Plack-Request/upload.t?rev=62715&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/t/Plack-Request/upload.t (original)
+++ branches/upstream/libplack-perl/current/t/Plack-Request/upload.t Mon Sep 20 13:12:02 2010
@@ -5,8 +5,11 @@
use Plack::Test;
use HTTP::Request::Common;
+my @temp_files = ();
+
my $app = sub {
- my $req = Plack::Request->new(shift);
+ my $env = shift;
+ my $req = Plack::Request->new($env);
isa_ok $req->uploads->{foo}, 'HASH';
is $req->uploads->{foo}->{filename}, 'foo2.txt';
@@ -15,10 +18,28 @@
is scalar(@files), 2;
is $files[0]->filename, 'foo1.txt';
is $files[1]->filename, 'foo2.txt';
+ ok -e $files[0]->tempname;
is join(', ', sort { $a cmp $b } $req->upload()), 'bar, foo';
- $req->new_response(200)->finalize;
+ for (qw(foo bar)) {
+ my $temp_file = $req->upload($_)->path;
+ ok -f $temp_file;
+ push @temp_files, $temp_file;
+ }
+
+ my $res = $req->new_response(200);
+
+ undef $req; # Simulate when we instantiate Plack::Request multiple times
+
+ # redo the test with the same $env
+ $req = Plack::Request->new($env);
+ @files = $req->upload('foo');
+ is scalar(@files), 2;
+ is $files[0]->filename, 'foo1.txt';
+ ok -e $files[0]->tempname;
+
+ $res->finalize;
};
test_psgi $app, sub {
@@ -31,5 +52,8 @@
]);
};
+# Check if the temp files got cleaned up properly
+ok !-f $_ for @temp_files;
+
done_testing;
More information about the Pkg-perl-cvs-commits
mailing list