r73908 - in /branches/upstream/libplack-perl/current: ./ inc/Module/ inc/Module/Install/ lib/ lib/HTTP/Message/ lib/Plack/ lib/Plack/Handler/ lib/Plack/Middleware/ lib/Plack/Server/ lib/Plack/Test/ t/Plack-Handler/ t/Plack-Middleware/
ghedo-guest at users.alioth.debian.org
ghedo-guest at users.alioth.debian.org
Mon May 2 17:32:44 UTC 2011
Author: ghedo-guest
Date: Mon May 2 17:32:28 2011
New Revision: 73908
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=73908
Log:
[svn-upgrade] new version libplack-perl (0.9977)
Added:
branches/upstream/libplack-perl/current/t/Plack-Handler/output_encoding.t
branches/upstream/libplack-perl/current/t/Plack-Handler/try_mangle.pl
branches/upstream/libplack-perl/current/t/Plack-Middleware/conditionalget_writer.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.pm
branches/upstream/libplack-perl/current/inc/Module/Install/AutoInstall.pm
branches/upstream/libplack-perl/current/inc/Module/Install/Base.pm
branches/upstream/libplack-perl/current/inc/Module/Install/Can.pm
branches/upstream/libplack-perl/current/inc/Module/Install/Fetch.pm
branches/upstream/libplack-perl/current/inc/Module/Install/Include.pm
branches/upstream/libplack-perl/current/inc/Module/Install/Makefile.pm
branches/upstream/libplack-perl/current/inc/Module/Install/Metadata.pm
branches/upstream/libplack-perl/current/inc/Module/Install/Scripts.pm
branches/upstream/libplack-perl/current/inc/Module/Install/Share.pm
branches/upstream/libplack-perl/current/inc/Module/Install/Win32.pm
branches/upstream/libplack-perl/current/inc/Module/Install/WriteAll.pm
branches/upstream/libplack-perl/current/lib/HTTP/Message/PSGI.pm
branches/upstream/libplack-perl/current/lib/Plack.pm
branches/upstream/libplack-perl/current/lib/Plack/Handler/CGI.pm
branches/upstream/libplack-perl/current/lib/Plack/Handler/FCGI.pm
branches/upstream/libplack-perl/current/lib/Plack/Middleware/ConditionalGET.pm
branches/upstream/libplack-perl/current/lib/Plack/Middleware/JSONP.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/Runner.pm
branches/upstream/libplack-perl/current/lib/Plack/Server/ServerSimple.pm
branches/upstream/libplack-perl/current/lib/Plack/Test/Suite.pm
branches/upstream/libplack-perl/current/lib/Plack/Util.pm
branches/upstream/libplack-perl/current/t/Plack-Middleware/jsonp.t
Modified: branches/upstream/libplack-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/Changes?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/Changes (original)
+++ branches/upstream/libplack-perl/current/Changes Mon May 2 17:32:28 2011
@@ -1,6 +1,17 @@
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.9977 Sun May 1 12:16:08 PDT 2011
+ [BUG FIXES]
+ - Fixed ConditionalGET to not die with streaming interface (reported by Paul Ervamaa)
+ - Add a reason string to CGI/FastCGI Status header to comply with RFC 3875 (Stephen Clouse)
+ - Fixed a CGI/FastCGI handler to ensure newlines are not mangled on Win32 platforms (Christian Walde)
+
+ [IMPROVEMENTS]
+ - localize @ARGV to empty when evaluating a PSGI application (https://github.com/sukria/Dancer/issues/473)
+ - Fixed the use of Getopt::Long to make the pass_through flag local
+ - Middleware::JSONP now supports more response types such as IO::Handle (reported by Theory)
0.9976 Fri Apr 8 18:07:11 PDT 2011
[NEW FEATURES]
Modified: branches/upstream/libplack-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/MANIFEST?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/MANIFEST (original)
+++ branches/upstream/libplack-perl/current/MANIFEST Mon May 2 17:32:28 2011
@@ -151,7 +151,9 @@
t/Plack-Handler/fcgi.t
t/Plack-Handler/fcgi_client.t
t/Plack-Handler/http_server_simple.t
+t/Plack-Handler/output_encoding.t
t/Plack-Handler/standalone.t
+t/Plack-Handler/try_mangle.pl
t/Plack-HTTPParser-PP/simple.t
t/Plack-Loader/auto.t
t/Plack-Loader/auto_fallback.t
@@ -178,6 +180,7 @@
t/Plack-Middleware/component.t
t/Plack-Middleware/conditional.t
t/Plack-Middleware/conditionalget.t
+t/Plack-Middleware/conditionalget_writer.t
t/Plack-Middleware/content_length.t
t/Plack-Middleware/directory.t
t/Plack-Middleware/error_document.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=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/META.yml (original)
+++ branches/upstream/libplack-perl/current/META.yml Mon May 2 17:32:28 2011
@@ -9,7 +9,7 @@
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 1.00'
+generated_by: 'Module::Install version 1.01'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -40,4 +40,4 @@
homepage: http://plackperl.org
license: http://dev.perl.org/licenses/
repository: git://github.com/miyagawa/Plack.git
-version: 0.9976
+version: 0.9977
Modified: branches/upstream/libplack-perl/current/inc/Module/Install.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/inc/Module/Install.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/inc/Module/Install.pm (original)
+++ branches/upstream/libplack-perl/current/inc/Module/Install.pm Mon May 2 17:32:28 2011
@@ -31,7 +31,7 @@
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '1.00';
+ $VERSION = '1.01';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -467,4 +467,4 @@
1;
-# Copyright 2008 - 2010 Adam Kennedy.
+# Copyright 2008 - 2011 Adam Kennedy.
Modified: branches/upstream/libplack-perl/current/inc/Module/Install/AutoInstall.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/inc/Module/Install/AutoInstall.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/inc/Module/Install/AutoInstall.pm (original)
+++ branches/upstream/libplack-perl/current/inc/Module/Install/AutoInstall.pm Mon May 2 17:32:28 2011
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.01';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libplack-perl/current/inc/Module/Install/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/inc/Module/Install/Base.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/inc/Module/Install/Base.pm (original)
+++ branches/upstream/libplack-perl/current/inc/Module/Install/Base.pm Mon May 2 17:32:28 2011
@@ -4,7 +4,7 @@
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.01';
}
# Suspend handler for "redefined" warnings
Modified: branches/upstream/libplack-perl/current/inc/Module/Install/Can.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/inc/Module/Install/Can.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/inc/Module/Install/Can.pm (original)
+++ branches/upstream/libplack-perl/current/inc/Module/Install/Can.pm Mon May 2 17:32:28 2011
@@ -9,7 +9,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.01';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libplack-perl/current/inc/Module/Install/Fetch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/inc/Module/Install/Fetch.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/inc/Module/Install/Fetch.pm (original)
+++ branches/upstream/libplack-perl/current/inc/Module/Install/Fetch.pm Mon May 2 17:32:28 2011
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.01';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libplack-perl/current/inc/Module/Install/Include.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/inc/Module/Install/Include.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/inc/Module/Install/Include.pm (original)
+++ branches/upstream/libplack-perl/current/inc/Module/Install/Include.pm Mon May 2 17:32:28 2011
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.01';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libplack-perl/current/inc/Module/Install/Makefile.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/inc/Module/Install/Makefile.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/inc/Module/Install/Makefile.pm (original)
+++ branches/upstream/libplack-perl/current/inc/Module/Install/Makefile.pm Mon May 2 17:32:28 2011
@@ -8,7 +8,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.01';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libplack-perl/current/inc/Module/Install/Metadata.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/inc/Module/Install/Metadata.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/inc/Module/Install/Metadata.pm (original)
+++ branches/upstream/libplack-perl/current/inc/Module/Install/Metadata.pm Mon May 2 17:32:28 2011
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.01';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -515,6 +515,7 @@
'GNU Free Documentation license' => 'unrestricted', 1,
'GNU Affero General Public License' => 'open_source', 1,
'(?:Free)?BSD license' => 'bsd', 1,
+ 'Artistic license 2\.0' => 'artistic_2', 1,
'Artistic license' => 'artistic', 1,
'Apache (?:Software )?license' => 'apache', 1,
'GPL' => 'gpl', 1,
@@ -550,9 +551,9 @@
sub _extract_bugtracker {
my @links = $_[0] =~ m#L<(
- \Qhttp://rt.cpan.org/\E[^>]+|
- \Qhttp://github.com/\E[\w_]+/[\w_]+/issues|
- \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list
+ https?\Q://rt.cpan.org/\E[^>]+|
+ https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
+ https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
)>#gx;
my %links;
@links{@links}=();
Modified: branches/upstream/libplack-perl/current/inc/Module/Install/Scripts.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/inc/Module/Install/Scripts.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/inc/Module/Install/Scripts.pm (original)
+++ branches/upstream/libplack-perl/current/inc/Module/Install/Scripts.pm Mon May 2 17:32:28 2011
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.01';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libplack-perl/current/inc/Module/Install/Share.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/inc/Module/Install/Share.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/inc/Module/Install/Share.pm (original)
+++ branches/upstream/libplack-perl/current/inc/Module/Install/Share.pm Mon May 2 17:32:28 2011
@@ -8,7 +8,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.01';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -22,7 +22,7 @@
}
unless ( defined $dir and -d $dir ) {
require Carp;
- Carp::croak("Illegal or missing directory install_share param");
+ Carp::croak("Illegal or missing directory install_share param: '$dir'");
}
# Split by type
Modified: branches/upstream/libplack-perl/current/inc/Module/Install/Win32.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/inc/Module/Install/Win32.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/inc/Module/Install/Win32.pm (original)
+++ branches/upstream/libplack-perl/current/inc/Module/Install/Win32.pm Mon May 2 17:32:28 2011
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.01';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libplack-perl/current/inc/Module/Install/WriteAll.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/inc/Module/Install/WriteAll.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/inc/Module/Install/WriteAll.pm (original)
+++ branches/upstream/libplack-perl/current/inc/Module/Install/WriteAll.pm Mon May 2 17:32:28 2011
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.01';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
Modified: branches/upstream/libplack-perl/current/lib/HTTP/Message/PSGI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/HTTP/Message/PSGI.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/HTTP/Message/PSGI.pm (original)
+++ branches/upstream/libplack-perl/current/lib/HTTP/Message/PSGI.pm Mon May 2 17:32:28 2011
@@ -5,6 +5,7 @@
our @EXPORT = qw( req_to_psgi res_from_psgi );
use Carp ();
+use HTTP::Status qw(status_message);
use URI::Escape ();
use Plack::Util;
use Try::Tiny;
@@ -112,6 +113,7 @@
my $convert_resp = sub {
my $res = HTTP::Response->new($status);
+ $res->message(status_message($status));
$res->headers->header(@$headers) if @$headers;
if (ref $body eq 'ARRAY') {
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=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack.pm Mon May 2 17:32:28 2011
@@ -3,7 +3,7 @@
use strict;
use warnings;
use 5.008_001;
-our $VERSION = '0.9976';
+our $VERSION = '0.9977';
$VERSION = eval $VERSION;
1;
Modified: branches/upstream/libplack-perl/current/lib/Plack/Handler/CGI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Handler/CGI.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Handler/CGI.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Handler/CGI.pm Mon May 2 17:32:28 2011
@@ -2,6 +2,62 @@
use strict;
use warnings;
use IO::Handle;
+
+# copied from HTTP::Status
+my %StatusCode = (
+ 100 => 'Continue',
+ 101 => 'Switching Protocols',
+ 102 => 'Processing', # RFC 2518 (WebDAV)
+ 200 => 'OK',
+ 201 => 'Created',
+ 202 => 'Accepted',
+ 203 => 'Non-Authoritative Information',
+ 204 => 'No Content',
+ 205 => 'Reset Content',
+ 206 => 'Partial Content',
+ 207 => 'Multi-Status', # RFC 2518 (WebDAV)
+ 300 => 'Multiple Choices',
+ 301 => 'Moved Permanently',
+ 302 => 'Found',
+ 303 => 'See Other',
+ 304 => 'Not Modified',
+ 305 => 'Use Proxy',
+ 307 => 'Temporary Redirect',
+ 400 => 'Bad Request',
+ 401 => 'Unauthorized',
+ 402 => 'Payment Required',
+ 403 => 'Forbidden',
+ 404 => 'Not Found',
+ 405 => 'Method Not Allowed',
+ 406 => 'Not Acceptable',
+ 407 => 'Proxy Authentication Required',
+ 408 => 'Request Timeout',
+ 409 => 'Conflict',
+ 410 => 'Gone',
+ 411 => 'Length Required',
+ 412 => 'Precondition Failed',
+ 413 => 'Request Entity Too Large',
+ 414 => 'Request-URI Too Large',
+ 415 => 'Unsupported Media Type',
+ 416 => 'Request Range Not Satisfiable',
+ 417 => 'Expectation Failed',
+ 422 => 'Unprocessable Entity', # RFC 2518 (WebDAV)
+ 423 => 'Locked', # RFC 2518 (WebDAV)
+ 424 => 'Failed Dependency', # RFC 2518 (WebDAV)
+ 425 => 'No code', # WebDAV Advanced Collections
+ 426 => 'Upgrade Required', # RFC 2817
+ 449 => 'Retry with', # unofficial Microsoft
+ 500 => 'Internal Server Error',
+ 501 => 'Not Implemented',
+ 502 => 'Bad Gateway',
+ 503 => 'Service Unavailable',
+ 504 => 'Gateway Timeout',
+ 505 => 'HTTP Version Not Supported',
+ 506 => 'Variant Also Negotiates', # RFC 2295
+ 507 => 'Insufficient Storage', # RFC 2518 (WebDAV)
+ 509 => 'Bandwidth Limit Exceeded', # unofficial
+ 510 => 'Not Extended', # RFC 2774
+);
sub new { bless {}, shift }
@@ -52,9 +108,11 @@
my ($self, $res) = @_;
*STDOUT->autoflush(1);
+ binmode STDOUT;
my $hdrs;
- $hdrs = "Status: $res->[0]\015\012";
+ my $message = $StatusCode{$res->[0]};
+ $hdrs = "Status: $res->[0] $message\015\012";
my $headers = $res->[1];
while (my ($k, $v) = splice(@$headers, 0, 2)) {
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=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Handler/FCGI.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Handler/FCGI.pm Mon May 2 17:32:28 2011
@@ -6,6 +6,7 @@
use Scalar::Util qw(blessed);
use Plack::Util;
use FCGI;
+use HTTP::Status qw(status_message);
use URI;
use URI::Escape;
@@ -152,9 +153,11 @@
my ($self, $res) = @_;
*STDOUT->autoflush(1);
+ binmode STDOUT;
my $hdrs;
- $hdrs = "Status: $res->[0]\015\012";
+ my $message = status_message($res->[0]);
+ $hdrs = "Status: $res->[0] $message\015\012";
my $headers = $res->[1];
while (my ($k, $v) = splice @$headers, 0, 2) {
Modified: branches/upstream/libplack-perl/current/lib/Plack/Middleware/ConditionalGET.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Middleware/ConditionalGET.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Middleware/ConditionalGET.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Middleware/ConditionalGET.pm Mon May 2 17:32:28 2011
@@ -12,6 +12,8 @@
$self->response_cb($res, sub {
my $res = shift;
+ return unless $res->[2]; # do not support streaming interface
+
my $h = Plack::Util::headers($res->[1]);
if ( $self->etag_matches($h, $env) || $self->not_modified_since($h, $env) ) {
$res->[0] = 304;
Modified: branches/upstream/libplack-perl/current/lib/Plack/Middleware/JSONP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Middleware/JSONP.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Middleware/JSONP.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Middleware/JSONP.pm Mon May 2 17:32:28 2011
@@ -18,14 +18,16 @@
my $res = $self->app->($env);
$self->response_cb($res, sub {
my $res = shift;
- if (defined $res->[2] && ref $res->[2] eq 'ARRAY' && @{$res->[2]} == 1) {
+ if (defined $res->[2]) {
my $h = Plack::Util::headers($res->[1]);
my $callback_key = $self->callback_key;
if ($h->get('Content-Type') =~ m!/(?:json|javascript)! &&
$env->{QUERY_STRING} =~ /(?:^|&)$callback_key=([^&]+)/) {
my $cb = URI::Escape::uri_unescape($1);
if ($cb =~ /^[\w\.\[\]]+$/) {
- my $jsonp = "$cb($res->[2][0])";
+ my $body;
+ Plack::Util::foreach($res->[2], sub { $body .= $_[0] });
+ my $jsonp = "$cb($body)";
$res->[2] = [ $jsonp ];
$h->set('Content-Length', length $jsonp);
$h->set('Content-Type', 'text/javascript');
@@ -51,12 +53,11 @@
Plack::Middleware::JSONP wraps JSON response, which has Content-Type
value either C<text/javascript> or C<application/json> as a JSONP
-response which is specified with the C<callback> query parameter. The
+response which is specified with the C<callback> query parameter. The
name of the parameter can be set while enabling the middleware.
-This middleware only works with an application response with content
-body set as a single element array ref and doesn't touch the response
-otherwise.
+This middleware only works with a non-streaming response, and doesn't
+touch the response otherwise.
=head1 AUTHOR
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=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Request.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Request.pm Mon May 2 17:32:28 2011
@@ -2,7 +2,7 @@
use strict;
use warnings;
use 5.008_001;
-our $VERSION = '0.9976';
+our $VERSION = '0.9977';
$VERSION = eval $VERSION;
use HTTP::Headers;
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=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Response.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Response.pm Mon May 2 17:32:28 2011
@@ -1,7 +1,7 @@
package Plack::Response;
use strict;
use warnings;
-our $VERSION = '0.9976';
+our $VERSION = '0.9977';
$VERSION = eval $VERSION;
use Plack::Util::Accessor qw(body status);
@@ -220,6 +220,10 @@
Gets and sets HTTP response body. Setter can take either a string, an
array ref, or an IO::Handle-like object. C<content> is an alias.
+Note that this method doesn't automatically set I<Content-Length> for
+the response. You have to set it manually if you want, with the
+C<content_length> method (see below).
+
=item header
$res->header('X-Foo' => 'bar');
Modified: branches/upstream/libplack-perl/current/lib/Plack/Runner.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Runner.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Runner.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Runner.pm Mon May 2 17:32:28 2011
@@ -34,8 +34,11 @@
my($host, $port, $socket, @listen);
require Getopt::Long;
- Getopt::Long::Configure("no_ignore_case", "pass_through");
- Getopt::Long::GetOptions(
+ my $parser = Getopt::Long::Parser->new(
+ config => [ "no_ignore_case", "pass_through" ],
+ );
+
+ $parser->getoptions(
"a|app=s" => \$self->{app},
"o|host=s" => \$host,
"p|port=i" => \$port,
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=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Server/ServerSimple.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Server/ServerSimple.pm Mon May 2 17:32:28 2011
@@ -1,6 +1,6 @@
package Plack::Server::ServerSimple;
use strict;
-our $VERSION = '0.9976';
+our $VERSION = '0.9977';
$VERSION = eval $VERSION;
use parent qw(Plack::Handler::HTTP::Server::Simple);
Modified: branches/upstream/libplack-perl/current/lib/Plack/Test/Suite.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Test/Suite.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Test/Suite.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Test/Suite.pm Mon May 2 17:32:28 2011
@@ -41,6 +41,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1/?name=miyagawa");
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('content_type'), 'text/plain';
is $res->content, 'Hello, name=miyagawa';
},
@@ -59,6 +60,7 @@
my $cb = shift;
my $res = $cb->(POST "http://127.0.0.1/", [name => 'tatsuhiko']);
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('Client-Content-Length'), 14;
is $res->header('Client-Content-Type'), 'application/x-www-form-urlencoded';
is $res->header('content_type'), 'text/plain';
@@ -90,6 +92,7 @@
my $res = $cb->($req);
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('Client-Content-Length'), length $chunk;
is length $res->content, length $chunk;
is Digest::MD5::md5_hex($res->content), Digest::MD5::md5_hex($chunk);
@@ -120,6 +123,7 @@
my $cb = shift;
my $res = $cb->(POST "http://127.0.0.1/");
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('content_type'), 'text/plain';
is $res->content, 'http';
},
@@ -138,6 +142,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1/");
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('content_type'), 'text/plain';
like $res->content, qr/^package /;
like $res->content, qr/END_MARK_FOR_TESTING$/;
@@ -158,6 +163,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1/foo.jpg");
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('content_type'), 'image/jpeg';
is length $res->content, 4745;
},
@@ -177,6 +183,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1/baybridge.jpg");
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('content_type'), 'image/jpeg';
is length $res->content, 79838;
is Digest::MD5::md5_hex($res->content), '983726ae0e4ce5081bef5fb2b7216950';
@@ -198,6 +205,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan", Foo => "Bar");
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('content_type'), 'text/plain';
is $res->content, 'Bar';
},
@@ -216,6 +224,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan", Cookie => "foo");
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('content_type'), 'text/plain';
is $res->content, 'foo';
},
@@ -234,6 +243,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan");
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('content_type'), 'text/plain';
is $res->content, join("\n",
'REQUEST_METHOD:GET',
@@ -308,6 +318,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1/foo/?dankogai=kogaidan");
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('content_type'), 'text/plain';
like $res->content, qr{^HTTP/1\.[01]$};
},
@@ -402,6 +413,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1/");
is $res->code, 500;
+ is $res->message, 'Internal Server Error';
},
sub {
my $env = shift;
@@ -475,6 +487,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1/");
is $res->code, 304;
+ is $res->message, 'Not Modified';
is $res->content, '';
ok ! defined $res->header('content_type'), "No Content-Type";
ok ! defined $res->header('content_length'), "No Content-Length";
@@ -503,6 +516,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1/foo.jpg");
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('content_type'), 'image/jpeg';
is length $res->content, 4745;
},
@@ -526,6 +540,7 @@
$req->header('X-Foo' => $v);
my $res = $cb->($req);
is $res->code, 200;
+ is $res->message, 'OK';
is $res->content, $v;
},
sub {
@@ -545,6 +560,7 @@
return if $res->code == 501;
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('content_type'), 'text/plain';
is $res->content, 'Hello, name=miyagawa';
},
@@ -569,6 +585,7 @@
return if $res->code == 501;
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('content_type'), 'text/plain';
is $res->content, 'Hello, name=miyagawa';
},
@@ -609,6 +626,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1/");
is $res->code, 404;
+ is $res->message, 'Not Found';
is $res->content, 'Not Found';
},
sub {
@@ -650,6 +668,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1/");
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('Client-Transfer-Encoding'), undef;
is $res->content, '';
},
@@ -704,6 +723,7 @@
my $cb = shift;
my $res = $cb->(GET "http://127.0.0.1//foo///bar/baz");
is $res->code, 200;
+ is $res->message, 'OK';
is $res->header('content_type'), 'text/plain';
is $res->content, '//foo///bar/baz';
},
Modified: branches/upstream/libplack-perl/current/lib/Plack/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/lib/Plack/Util.pm?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/lib/Plack/Util.pm (original)
+++ branches/upstream/libplack-perl/current/lib/Plack/Util.pm Mon May 2 17:32:28 2011
@@ -108,6 +108,7 @@
_file_zero_check($_file) if $ENV{PLACK_ENV} eq 'development';
local $0 = $_file; # so FindBin etc. works
+ local @ARGV = (); # Some frameworks might try to parse @ARGV
return eval sprintf <<'END_EVAL', $_package;
package Plack::Sandbox::%s;
Added: branches/upstream/libplack-perl/current/t/Plack-Handler/output_encoding.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/t/Plack-Handler/output_encoding.t?rev=73908&op=file
==============================================================================
--- branches/upstream/libplack-perl/current/t/Plack-Handler/output_encoding.t (added)
+++ branches/upstream/libplack-perl/current/t/Plack-Handler/output_encoding.t Mon May 2 17:32:28 2011
@@ -1,0 +1,36 @@
+use strict;
+use warnings;
+
+package output_encoding;
+
+use Test::More;
+
+run();
+done_testing;
+
+sub read_file {
+ open my $fh, "<", shift;
+ return join '', <$fh>;
+}
+
+sub run {
+ my $mangler = 'try_mangle.pl';
+ $mangler = 't/Plack-Handler/try_mangle.pl' if !-f $mangler;
+
+ my $mangle_file = 'mangle_test.txt';
+
+ test_handler( 'CGI', $mangler, $mangle_file );
+ test_handler( 'FCGI', $mangler, $mangle_file );
+
+ return;
+}
+
+sub test_handler {
+ my ( $handler, $mangler, $mangle_file ) = @_;
+
+ system( "$^X $mangler Plack::Handler::$handler > $mangle_file" );
+ like read_file( $mangle_file, binmode => ':raw' ), qr/test\ntest/, '\n is not converted';
+ unlink $mangle_file;
+
+ return;
+}
Added: branches/upstream/libplack-perl/current/t/Plack-Handler/try_mangle.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/t/Plack-Handler/try_mangle.pl?rev=73908&op=file
==============================================================================
--- branches/upstream/libplack-perl/current/t/Plack-Handler/try_mangle.pl (added)
+++ branches/upstream/libplack-perl/current/t/Plack-Handler/try_mangle.pl Mon May 2 17:32:28 2011
@@ -1,0 +1,15 @@
+use strict;
+use warnings;
+
+package try_mangle;
+
+my $module = $ARGV[0];
+
+$module ||= 'Plack::Handler::CGI';
+
+eval "require $module";
+
+my $res = [200,[],["test\ntest"]];
+$module->_handle_response( $res );
+
+exit;
Added: branches/upstream/libplack-perl/current/t/Plack-Middleware/conditionalget_writer.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/t/Plack-Middleware/conditionalget_writer.t?rev=73908&op=file
==============================================================================
--- branches/upstream/libplack-perl/current/t/Plack-Middleware/conditionalget_writer.t (added)
+++ branches/upstream/libplack-perl/current/t/Plack-Middleware/conditionalget_writer.t Mon May 2 17:32:28 2011
@@ -1,0 +1,46 @@
+use strict;
+use warnings;
+use Test::More;
+use Plack::Builder;
+use HTTP::Request::Common;
+use Plack::Test;
+
+my $handler = builder {
+ enable 'ConditionalGET';
+
+ sub {
+ my $env = shift;
+ return sub {
+ my $writer = shift->( [ 200, [
+ 'Content-Type' => 'text/plain',
+ 'ETag' => 'DEADBEEF',
+ ] ] );
+ $writer->write($_) for ( qw( kling klang klong ) );
+ $writer->close;
+ };
+
+ };
+};
+
+test_psgi $handler, sub {
+ my $cb = shift;
+
+ subtest 'streaming' => sub {
+ my $res = $cb->( GET "http://localhost/streaming-klingklangklong" );
+ is $res->code, 200, 'Response HTTP status';
+ is $res->content, 'klingklangklong', 'Response content';
+ };
+
+ subtest 'streaming not modified' => sub {
+ # the middleware does not support streaming interface but make it at least not die
+ my $res = $cb->( GET
+ "http://localhost/streaming-klingklangklong",
+ 'If-None-Match' => 'DEADBEEF'
+ );
+ is $res->code, 200, 'Response HTTP status';
+ is $res->content, 'klingklangklong', 'Response content';
+ };
+};
+
+done_testing;
+
Modified: branches/upstream/libplack-perl/current/t/Plack-Middleware/jsonp.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libplack-perl/current/t/Plack-Middleware/jsonp.t?rev=73908&op=diff
==============================================================================
--- branches/upstream/libplack-perl/current/t/Plack-Middleware/jsonp.t (original)
+++ branches/upstream/libplack-perl/current/t/Plack-Middleware/jsonp.t Mon May 2 17:32:28 2011
@@ -3,13 +3,14 @@
use Plack::Test;
use Plack::Builder;
-my $json = '{"foo":"bar"}';
+my @json = ('{"foo":', '"bar"}');
+my $json = join '', @json;
my @tests = (
{
callback_key => 'json.p',
app => sub {
- return [ 200, [ 'Content-Type' => 'application/json' ], [$json] ];
+ return [ 200, [ 'Content-Type' => 'application/json' ], [@json] ];
},
},
{
More information about the Pkg-perl-cvs-commits
mailing list