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