[libmojolicious-perl] 01/03: Imported Upstream version 5.54+dfsg
Tamas Csillag
cstamas-guest at moszumanska.debian.org
Sun Oct 26 12:47:57 UTC 2014
This is an automated email from the git hooks/post-receive script.
cstamas-guest pushed a commit to branch master
in repository libmojolicious-perl.
commit ab041f40b5d62905f2c2bdbe66ebee00dbff00aa
Author: CSILLAG Tamas <cstamas at cstamas.hu>
Date: Sun Oct 26 13:25:50 2014 +0100
Imported Upstream version 5.54+dfsg
---
Changes | 35 ++++++++++
MANIFEST | 1 +
META.json | 4 +-
META.yml | 4 +-
README.md | 10 ++-
examples/connect-proxy.pl | 86 +++++++++++++++++++++++
examples/entities.pl | 10 +++
examples/fast.pl | 10 +++
examples/hello-template.pl | 10 +++
lib/Mojo/Asset/File.pm | 3 +-
lib/Mojo/Base.pm | 18 ++---
lib/Mojo/ByteStream.pm | 8 ++-
lib/Mojo/Collection.pm | 7 +-
lib/Mojo/Content.pm | 90 ++++++++++++------------
lib/Mojo/DOM/HTML.pm | 53 +++++---------
lib/Mojo/JSON.pm | 64 +++++------------
lib/Mojo/Message.pm | 20 +++---
lib/Mojo/Message/Request.pm | 16 ++---
lib/Mojo/Message/Response.pm | 2 +-
lib/Mojo/Parameters.pm | 14 ++--
lib/Mojo/Server.pm | 7 +-
lib/Mojo/UserAgent.pm | 8 ++-
lib/Mojo/UserAgent/Transactor.pm | 21 +++---
lib/Mojolicious.pm | 8 ++-
lib/Mojolicious/Command/cpanify.pm | 2 +-
lib/Mojolicious/Command/get.pm | 2 +-
lib/Mojolicious/Command/inflate.pm | 2 +-
lib/Mojolicious/Controller.pm | 36 +++++-----
lib/Mojolicious/Guides.pod | 4 +-
lib/Mojolicious/Guides/Contributing.pod | 10 ---
lib/Mojolicious/Guides/Cookbook.pod | 2 +-
lib/Mojolicious/Plugin/JSONConfig.pm | 16 ++---
lib/Mojolicious/Plugin/PODRenderer.pm | 6 +-
lib/Mojolicious/Routes/Route.pm | 3 +-
lib/Mojolicious/Static.pm | 4 +-
lib/Mojolicious/Validator/Validation.pm | 7 +-
lib/Mojolicious/templates/mojobar.html.ep | 8 +--
lib/Test/Mojo.pm | 16 ++---
lib/ojo.pm | 2 +-
script/hypnotoad | 3 -
script/mojo | 3 -
script/morbo | 3 -
t/mojo/asset.t | 12 ----
t/mojo/bytestream.t | 4 --
t/mojo/collection.t | 6 --
t/mojo/daemon.t | 6 ++
t/mojo/dom.t | 16 +++++
t/mojo/json.t | 111 +++++++++++++++---------------
t/mojo/lib/myapp.pl | 5 ++
t/mojo/parameters.t | 1 +
t/mojo/response.t | 21 +++++-
t/mojo/transactor.t | 28 +++++---
t/mojo/user_agent.t | 16 +++++
t/mojolicious/dispatch.t | 1 +
t/mojolicious/embedded_lite_app.t | 5 +-
t/mojolicious/external/myapp.pl | 2 +-
t/mojolicious/external_lite_app.t | 2 +-
t/mojolicious/json_config_lite_app.t | 8 ++-
t/mojolicious/static_lite_app.t | 6 ++
t/mojolicious/validation_lite_app.t | 2 +
t/mojolicious/websocket_lite_app.t | 2 +-
t/pod_coverage.t | 3 +-
62 files changed, 531 insertions(+), 364 deletions(-)
diff --git a/Changes b/Changes
index e13da5b..327c658 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,39 @@
+5.54 2014-10-23
+ - Deprecated Object-Oriented Mojo::JSON API.
+ - Added auto_decompress attribute to Mojo::Content.
+ - Improved Mojo::Content to parse content more defensively.
+ - Fixed chunked transfer encoding bug in Mojo::Content.
+ - Fixed bug where Mojo::UserAgent would try to follow redirects for
+ protocols other than HTTP and HTTPS.
+
+5.53 2014-10-20
+ - Fixed bug in Mojo::Server where secondary groups were not reassigned
+ correctly. (ksm, sri)
+
+5.52 2014-10-18
+ - Fixed read-only file system compatibility of Mojo::Asset::File.
+
+5.51 2014-10-17
+ - Fixed bug in Mojolicious::Validator::Validation where every_param would
+ sometimes return an array reference containing an undef value.
+ - Fixed Mojo::ByteStream and Mojo::Collection to always return true in
+ boolean context.
+
+5.50 2014-10-15
+ - Improved Mojo::DOM::HTML performance slightly.
+ - Fixed description list parsing bug in Mojo::DOM::HTML. (Trelane)
+
+5.49 2014-10-10
+ - Improved form content generator to allow custom content types.
+ - Improved Mojo::Server to load applications consistently for all servers.
+ (tianon, sri)
+ - Fixed Mojolicious::Static to hide files without extensions in DATA
+ sections.
+ - Fixed inflate command to ignore files without extensions.
+ - Fixed bug in Mojolicious::Routes::Route where formats could be rendered
+ twice for embedded applications.
+
5.48 2014-10-07
- Emergency release for a serious security issue that can result in
parameter injection attacks, everybody should update!
diff --git a/MANIFEST b/MANIFEST
index 42c8587..96fff71 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -218,6 +218,7 @@ t/mojo/lib/Mojo/LoaderException2.pm
t/mojo/lib/Mojo/LoaderTest/A.pm
t/mojo/lib/Mojo/LoaderTest/B.pm
t/mojo/lib/Mojo/LoaderTest/C.pm
+t/mojo/lib/myapp.pl
t/mojo/loader.t
t/mojo/log.t
t/mojo/morbo.t
diff --git a/META.json b/META.json
index 3e845cc..4ef4cdf 100644
--- a/META.json
+++ b/META.json
@@ -4,7 +4,7 @@
"Sebastian Riedel <sri at cpan.org>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690",
+ "generated_by" : "ExtUtils::MakeMaker version 7, CPAN::Meta::Converter version 2.142690",
"license" : [
"artistic_2"
],
@@ -53,5 +53,5 @@
},
"x_IRC" : "irc://irc.perl.org/#mojo"
},
- "version" : "5.48"
+ "version" : "5.54"
}
diff --git a/META.yml b/META.yml
index 00f1ae4..9b28f5c 100644
--- a/META.yml
+++ b/META.yml
@@ -7,7 +7,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690'
+generated_by: 'ExtUtils::MakeMaker version 7, CPAN::Meta::Converter version 2.142690'
license: artistic_2
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -28,4 +28,4 @@ resources:
homepage: http://mojolicio.us
license: http://www.opensource.org/licenses/artistic-license-2.0
repository: https://github.com/kraih/mojo.git
-version: '5.48'
+version: '5.54'
diff --git a/README.md b/README.md
index 5db8490..54b6111 100644
--- a/README.md
+++ b/README.md
@@ -2,7 +2,7 @@
# Mojolicious [](https://travis-ci.org/kraih/mojo)
Back in the early days of the web, many people learned Perl because of a
- wonderful Perl library called [CGI](http://metacpan.org/module/CGI). It was
+ wonderful Perl library called [CGI](https://metacpan.org/module/CGI). It was
simple enough to get started without knowing much about the language and
powerful enough to keep you going, learning by doing was much fun. While
most of the techniques used are outdated now, the idea behind it is not.
@@ -17,7 +17,7 @@
templates, content negotiation, session management, form validation,
testing framework, static file server, first class Unicode support and
much more for you to discover.
- * Very clean, portable and Object Oriented pure-Perl API with no hidden
+ * Very clean, portable and Object-Oriented pure-Perl API with no hidden
magic and no requirements besides Perl 5.18.0 (versions as old as 5.10.1
can be used too, but may require additional CPAN modules to be installed)
* Full stack HTTP and WebSocket client/server implementation with IPv6, TLS,
@@ -34,7 +34,11 @@
All you need is a one-liner, it takes less than a minute.
- $ curl get.mojolicio.us | sh
+ $ curl -L cpanmin.us | perl - -n Mojolicious
+
+ And if you already have `cpanm` installed with a secure toolchain.
+
+ $ cpanm --mirror https://cpan.metacpan.org --mirror-only --verify -n Mojolicious
We recommend the use of a [Perlbrew](http://perlbrew.pl) environment.
diff --git a/examples/connect-proxy.pl b/examples/connect-proxy.pl
new file mode 100644
index 0000000..94c7df2
--- /dev/null
+++ b/examples/connect-proxy.pl
@@ -0,0 +1,86 @@
+use Mojo::Base -strict;
+use Mojo::IOLoop;
+
+# Minimal CONNECT proxy server to test TLS tunneling
+my %buffer;
+Mojo::IOLoop->server(
+ {port => 3000} => sub {
+ my ($loop, $stream, $client) = @_;
+
+ # Connection to client
+ $stream->on(
+ read => sub {
+ my ($stream, $chunk) = @_;
+
+ # Write chunk from client to server
+ my $server = $buffer{$client}{connection};
+ return Mojo::IOLoop->stream($server)->write($chunk) if $server;
+
+ # Read connect request from client
+ my $buffer = $buffer{$client}{client} .= $chunk;
+ if ($buffer =~ /\x0d?\x0a\x0d?\x0a$/) {
+ $buffer{$client}{client} = '';
+ if ($buffer =~ /CONNECT (\S+):(\d+)?/) {
+ my $address = $1;
+ my $port = $2 || 80;
+
+ # Connection to server
+ $buffer{$client}{connection} = Mojo::IOLoop->client(
+ {address => $address, port => $port} => sub {
+ my ($loop, $err, $stream) = @_;
+
+ # Connection to server failed
+ if ($err) {
+ say "Connection error for $address:$port: $err";
+ Mojo::IOLoop->remove($client);
+ return delete $buffer{$client};
+ }
+
+ # Start forwarding data in both directions
+ say "Forwarding to $address:$port.";
+ Mojo::IOLoop->stream($client)
+ ->write("HTTP/1.1 200 OK\x0d\x0a"
+ . "Connection: keep-alive\x0d\x0a\x0d\x0a");
+ $stream->on(
+ read => sub {
+ my ($stream, $chunk) = @_;
+ Mojo::IOLoop->stream($client)->write($chunk);
+ }
+ );
+
+ # Server closed connection
+ $stream->on(
+ close => sub {
+ Mojo::IOLoop->remove($client);
+ delete $buffer{$client};
+ }
+ );
+ }
+ );
+ }
+ }
+
+ # Invalid request from client
+ else { Mojo::IOLoop->remove($client) }
+ }
+ );
+
+ # Client closed connection
+ $stream->on(
+ close => sub {
+ my $buffer = delete $buffer{$client};
+ Mojo::IOLoop->remove($buffer->{connection}) if $buffer->{connection};
+ }
+ );
+ }
+);
+
+print <<'EOF';
+Starting CONNECT proxy on port 3000.
+For testing use something like "HTTPS_PROXY=http://127.0.0.1:3000".
+EOF
+
+# Start event loop
+Mojo::IOLoop->start;
+
+1;
diff --git a/examples/entities.pl b/examples/entities.pl
new file mode 100644
index 0000000..e405da8
--- /dev/null
+++ b/examples/entities.pl
@@ -0,0 +1,10 @@
+use Mojo::Base -strict;
+use Mojo::ByteStream 'b';
+use Mojo::UserAgent;
+
+# Extract named character references from HTML spec
+my $tx = Mojo::UserAgent->new->get('https://html.spec.whatwg.org');
+b($_->at('td > code')->text . ' ' . $_->children('td')->[1]->text)->trim->say
+ for $tx->res->dom('#named-character-references-table tbody > tr')->each;
+
+1;
diff --git a/examples/fast.pl b/examples/fast.pl
new file mode 100644
index 0000000..886210f
--- /dev/null
+++ b/examples/fast.pl
@@ -0,0 +1,10 @@
+use Mojo::Base 'Mojolicious';
+
+sub handler {
+ my $tx = pop;
+ $tx->res->code(200)->body('Hello World!');
+ $tx->resume;
+}
+
+# Fast "Hello World" application for profiling the HTTP stack
+__PACKAGE__->new->start;
diff --git a/examples/hello-template.pl b/examples/hello-template.pl
new file mode 100644
index 0000000..818f27b
--- /dev/null
+++ b/examples/hello-template.pl
@@ -0,0 +1,10 @@
+use Mojolicious::Lite;
+
+get '/hello';
+
+# Minimal "Hello World" application with template for profiling
+app->start;
+__DATA__
+
+@@ hello.html.ep
+Hello World!
diff --git a/lib/Mojo/Asset/File.pm b/lib/Mojo/Asset/File.pm
index 851c058..1ad8a88 100644
--- a/lib/Mojo/Asset/File.pm
+++ b/lib/Mojo/Asset/File.pm
@@ -17,8 +17,7 @@ has handle => sub {
my $handle = IO::File->new;
my $path = $self->path;
if (defined $path && -f $path) {
- $handle->open($path, -w _ ? O_APPEND | O_RDWR : O_RDONLY)
- or croak qq{Can't open file "$path": $!};
+ $handle->open($path, O_RDONLY) or croak qq{Can't open file "$path": $!};
return $handle;
}
diff --git a/lib/Mojo/Base.pm b/lib/Mojo/Base.pm
index f98fd4f..7d6af42 100644
--- a/lib/Mojo/Base.pm
+++ b/lib/Mojo/Base.pm
@@ -183,12 +183,12 @@ L<Mojo::Base> implements the following methods.
=head2 attr
$object->attr('name');
- BaseSubClass->attr('name');
- BaseSubClass->attr([qw(name1 name2 name3)]);
- BaseSubClass->attr(name => 'foo');
- BaseSubClass->attr(name => sub {...});
- BaseSubClass->attr([qw(name1 name2 name3)] => 'foo');
- BaseSubClass->attr([qw(name1 name2 name3)] => sub {...});
+ SubClass->attr('name');
+ SubClass->attr([qw(name1 name2 name3)]);
+ SubClass->attr(name => 'foo');
+ SubClass->attr(name => sub {...});
+ SubClass->attr([qw(name1 name2 name3)] => 'foo');
+ SubClass->attr([qw(name1 name2 name3)] => sub {...});
Create attribute accessor for hash-based objects, an array reference can be
used to create more than one at a time. Pass an optional second argument to
@@ -199,9 +199,9 @@ argument.
=head2 new
- my $object = BaseSubClass->new;
- my $object = BaseSubClass->new(name => 'value');
- my $object = BaseSubClass->new({name => 'value'});
+ my $object = SubClass->new;
+ my $object = SubClass->new(name => 'value');
+ my $object = SubClass->new({name => 'value'});
This base class provides a basic constructor for hash-based objects. You can
pass it either a hash or a hash reference with attribute values.
diff --git a/lib/Mojo/ByteStream.pm b/lib/Mojo/ByteStream.pm
index c2995e8..a12d362 100644
--- a/lib/Mojo/ByteStream.pm
+++ b/lib/Mojo/ByteStream.pm
@@ -1,6 +1,6 @@
package Mojo::ByteStream;
use Mojo::Base -strict;
-use overload '""' => sub { ${$_[0]} }, fallback => 1;
+use overload bool => sub {1}, '""' => sub { ${$_[0]} }, fallback => 1;
use Exporter 'import';
use Mojo::Collection;
@@ -11,8 +11,8 @@ our @EXPORT_OK = ('b');
# Turn most functions from Mojo::Util into methods
my @UTILS = (
qw(b64_decode b64_encode camelize decamelize hmac_sha1_sum html_unescape),
- qw(md5_bytes md5_sum punycode_decode punycode_encode quote secure_compare),
- qw(sha1_bytes sha1_sum slurp spurt squish trim unindent unquote url_escape),
+ qw(md5_bytes md5_sum punycode_decode punycode_encode quote sha1_bytes),
+ qw(sha1_sum slurp spurt squish trim unindent unquote url_escape),
qw(url_unescape xml_escape xor_encode)
);
for my $name (@UTILS) {
@@ -43,6 +43,8 @@ sub say {
return $self;
}
+sub secure_compare { Mojo::Util::secure_compare ${shift()}, shift }
+
sub size { length ${$_[0]} }
sub split {
diff --git a/lib/Mojo/Collection.pm b/lib/Mojo/Collection.pm
index ad39dfc..6cacfac 100644
--- a/lib/Mojo/Collection.pm
+++ b/lib/Mojo/Collection.pm
@@ -1,9 +1,6 @@
package Mojo::Collection;
use Mojo::Base -strict;
-use overload
- bool => sub { !!@{shift()} },
- '""' => sub { shift->join("\n") },
- fallback => 1;
+use overload bool => sub {1}, '""' => sub { shift->join("\n") }, fallback => 1;
use Carp 'croak';
use Exporter 'import';
@@ -353,7 +350,7 @@ L<Mojo::Collection> overloads the following operators.
my $bool = !!$collection;
-True or false, depending on if the collection is empty.
+Always true.
=head2 stringify
diff --git a/lib/Mojo/Content.pm b/lib/Mojo/Content.pm
index 26ae190..50255e8 100644
--- a/lib/Mojo/Content.pm
+++ b/lib/Mojo/Content.pm
@@ -4,8 +4,9 @@ use Mojo::Base 'Mojo::EventEmitter';
use Carp 'croak';
use Compress::Raw::Zlib qw(WANT_GZIP Z_STREAM_END);
use Mojo::Headers;
+use Scalar::Util 'looks_like_number';
-has [qw(auto_relax expect_close relaxed skip_body)];
+has [qw(auto_decompress auto_relax expect_close relaxed skip_body)];
has headers => sub { Mojo::Headers->new };
has max_buffer_size => sub { $ENV{MOJO_MAX_BUFFER_SIZE} || 262144 };
has max_leftover_size => sub { $ENV{MOJO_MAX_LEFTOVER_SIZE} || 262144 };
@@ -88,7 +89,6 @@ sub parse {
# Headers
$self->_parse_until_body(@_);
return $self if $self->{state} eq 'headers';
- $self->emit('body') unless $self->{body}++;
# Chunked content
$self->{real_size} //= 0;
@@ -123,22 +123,21 @@ sub parse {
# Chunked or relaxed content
if ($self->is_chunked || $self->relaxed) {
- $self->{size} += length($self->{buffer} //= '');
- $self->_uncompress($self->{buffer});
+ $self->_decompress($self->{buffer} //= '');
+ $self->{size} += length $self->{buffer};
$self->{buffer} = '';
+ return $self;
}
# Normal content
- else {
- $self->{size} ||= 0;
- if ((my $need = ($len ||= 0) - $self->{size}) > 0) {
- my $len = length $self->{buffer};
- my $chunk = substr $self->{buffer}, 0, $need > $len ? $len : $need, '';
- $self->_uncompress($chunk);
- $self->{size} += length $chunk;
- }
- $self->{state} = 'finished' if $len <= $self->progress;
+ $len = 0 unless looks_like_number $len;
+ if ((my $need = $len - ($self->{size} ||= 0)) > 0) {
+ my $len = length $self->{buffer};
+ my $chunk = substr $self->{buffer}, 0, $need > $len ? $len : $need, '';
+ $self->_decompress($chunk);
+ $self->{size} += length $chunk;
}
+ $self->{state} = 'finished' if $len <= $self->progress;
return $self;
}
@@ -206,6 +205,29 @@ sub _build_chunk {
return $crlf . sprintf('%x', length $chunk) . "\x0d\x0a$chunk";
}
+sub _decompress {
+ my ($self, $chunk) = @_;
+
+ # No compression
+ return $self->emit(read => $chunk)
+ unless $self->auto_decompress && $self->is_compressed;
+
+ # Decompress
+ $self->{post_buffer} .= $chunk;
+ my $gz = $self->{gz}
+ //= Compress::Raw::Zlib::Inflate->new(WindowBits => WANT_GZIP);
+ my $status = $gz->inflate(\$self->{post_buffer}, my $out);
+ $self->emit(read => $out) if defined $out;
+
+ # Replace Content-Encoding with Content-Length
+ $self->headers->content_length($gz->total_out)->remove('Content-Encoding')
+ if $status == Z_STREAM_END;
+
+ # Check buffer size
+ @$self{qw(state limit)} = ('finished', 1)
+ if length($self->{post_buffer} // '') > $self->max_buffer_size;
+}
+
sub _parse_chunked {
my $self = shift;
@@ -249,7 +271,8 @@ sub _parse_chunked_trailing_headers {
return unless $headers->is_finished;
$self->{chunk_state} = 'finished';
- # Replace Transfer-Encoding with Content-Length
+ # Take care of leftover and replace Transfer-Encoding with Content-Length
+ $self->{buffer} .= $headers->leftovers;
$headers->remove('Transfer-Encoding');
$headers->content_length($self->{real_size}) unless $headers->content_length;
}
@@ -264,7 +287,6 @@ sub _parse_headers {
# Take care of leftovers
my $leftovers = $self->{pre_buffer} = $headers->leftovers;
$self->{header_size} = $self->{raw_size} - length $leftovers;
- $self->emit('body') unless $self->{body}++;
}
sub _parse_until_body {
@@ -272,35 +294,8 @@ sub _parse_until_body {
$self->{raw_size} += length($chunk //= '');
$self->{pre_buffer} .= $chunk;
-
- unless ($self->{state}) {
- $self->{header_size} = $self->{raw_size} - length $self->{pre_buffer};
- $self->{state} = 'headers';
- }
- $self->_parse_headers if ($self->{state} // '') eq 'headers';
-}
-
-sub _uncompress {
- my ($self, $chunk) = @_;
-
- # No compression
- return $self->emit(read => $chunk)
- unless $self->is_compressed && $self->auto_relax;
-
- # Uncompress
- $self->{post_buffer} .= $chunk;
- my $gz = $self->{gz}
- //= Compress::Raw::Zlib::Inflate->new(WindowBits => WANT_GZIP);
- my $status = $gz->inflate(\$self->{post_buffer}, my $out);
- $self->emit(read => $out) if defined $out;
-
- # Replace Content-Encoding with Content-Length
- $self->headers->content_length($gz->total_out)->remove('Content-Encoding')
- if $status == Z_STREAM_END;
-
- # Check buffer size
- @$self{qw(state limit)} = ('finished', 1)
- if length($self->{post_buffer} // '') > $self->max_buffer_size;
+ $self->_parse_headers if ($self->{state} ||= 'headers') eq 'headers';
+ $self->emit('body') if $self->{state} ne 'headers' && !$self->{body}++;
}
1;
@@ -378,6 +373,13 @@ Emitted when a new chunk of content arrives.
L<Mojo::Content> implements the following attributes.
+=head2 auto_decompress
+
+ my $bool = $content->auto_decompress;
+ $content = $content->auto_decompress($bool);
+
+Decompress content automatically if L</"is_compressed"> is true.
+
=head2 auto_relax
my $bool = $content->auto_relax;
diff --git a/lib/Mojo/DOM/HTML.pm b/lib/Mojo/DOM/HTML.pm
index eb4f992..709c930 100644
--- a/lib/Mojo/DOM/HTML.pm
+++ b/lib/Mojo/DOM/HTML.pm
@@ -54,17 +54,10 @@ my %RAW = map { $_ => 1 } qw(script style);
my %RCDATA = map { $_ => 1 } qw(title textarea);
# HTML elements with optional end tags
-my %END = (
- body => ['head'],
- dd => [qw(dt dd)],
- dt => [qw(dt dd)],
- rp => [qw(rt rp)],
- rt => [qw(rt rp)]
-);
-$END{$_} = [$_] for qw(optgroup option);
+my %END = (body => 'head', optgroup => 'optgroup', option => 'option');
# HTML elements that break paragraphs
-map { $END{$_} = ['p'] } (
+map { $END{$_} = 'p' } (
qw(address article aside blockquote dir div dl fieldset footer form h1 h2),
qw(h3 h4 h5 h6 header hr main menu nav ol p pre section table ul)
);
@@ -72,6 +65,14 @@ map { $END{$_} = ['p'] } (
# HTML table elements with optional end tags
my %TABLE = map { $_ => 1 } qw(colgroup tbody td tfoot th thead tr);
+# HTML elements with optional end tags and scoping rules
+my %CLOSE
+ = (li => [{li => 1}, {ul => 1, ol => 1}], tr => [{tr => 1}, {table => 1}]);
+$CLOSE{$_} = [\%TABLE, {table => 1}] for qw(colgroup tbody tfoot thead);
+$CLOSE{$_} = [{dd => 1, dt => 1}, {dl => 1}] for qw(dd dt);
+$CLOSE{$_} = [{rp => 1, rt => 1}, {ruby => 1}] for qw(rp rt);
+$CLOSE{$_} = [{th => 1, td => 1}, {table => 1}] for qw(td th);
+
# HTML elements without end tags
my %EMPTY = map { $_ => 1 } (
qw(area base br col embed hr img input keygen link menuitem meta param),
@@ -171,17 +172,6 @@ sub parse {
sub render { _render($_[0]->tree, $_[0]->xml) }
-sub _close {
- my ($current, $allowed, $scope) = @_;
-
- # Close allowed parent elements in scope
- my $parent = $$current;
- while ($parent->[0] ne 'root' && !$scope->{$parent->[1]}) {
- _end($parent->[1], 0, $current) if $allowed->{$parent->[1]};
- $parent = $parent->[3];
- }
-}
-
sub _end {
my ($end, $xml, $current) = @_;
@@ -273,22 +263,17 @@ sub _start {
# Autoclose optional HTML elements
if (!$xml && $$current->[0] ne 'root') {
- if (my $end = $END{$start}) { _end($_, 0, $current) for @$end }
-
- # "li"
- elsif ($start eq 'li') { _close($current, {li => 1}, {ul => 1, ol => 1}) }
+ if (my $end = $END{$start}) { _end($end, 0, $current) }
- # "colgroup", "thead", "tbody" and "tfoot"
- elsif ($start eq 'colgroup' || $start =~ /^t(?:head|body|foot)$/) {
- _close($current, \%TABLE, {table => 1});
- }
+ elsif (my $close = $CLOSE{$start}) {
+ my ($allowed, $scope) = @$close;
- # "tr"
- elsif ($start eq 'tr') { _close($current, {tr => 1}, {table => 1}) }
-
- # "th" and "td"
- elsif ($start eq 'th' || $start eq 'td') {
- _close($current, {$_ => 1}, {table => 1}) for qw(th td);
+ # Close allowed parent elements in scope
+ my $parent = $$current;
+ while ($parent->[0] ne 'root' && !$scope->{$parent->[1]}) {
+ _end($parent->[1], 0, $current) if $allowed->{$parent->[1]};
+ $parent = $parent->[3];
+ }
}
}
diff --git a/lib/Mojo/JSON.pm b/lib/Mojo/JSON.pm
index 8280ef1..804f08c 100644
--- a/lib/Mojo/JSON.pm
+++ b/lib/Mojo/JSON.pm
@@ -4,12 +4,13 @@ use Mojo::Base -base;
use B;
use Carp 'croak';
use Exporter 'import';
-use Mojo::Util;
+use Mojo::Util 'deprecated';
use Scalar::Util 'blessed';
+# DEPRECATED in Tiger Face!
has 'error';
-our @EXPORT_OK = qw(decode_json encode_json from_json j to_json);
+our @EXPORT_OK = qw(decode_json encode_json false from_json j to_json true);
# Literal names
my $FALSE = bless \(my $false = 0), 'Mojo::JSON::_Bool';
@@ -31,6 +32,7 @@ my %ESCAPE = (
my %REVERSE = map { $ESCAPE{$_} => "\\$_" } keys %ESCAPE;
for (0x00 .. 0x1f) { $REVERSE{pack 'C', $_} //= sprintf '\u%.4X', $_ }
+# DEPRECATED in Tiger Face!
sub decode {
shift->error(my $err = _catch(\my $value, pop));
return defined $err ? undef : $value;
@@ -41,6 +43,7 @@ sub decode_json {
return defined $err ? croak $err : $value;
}
+# DEPRECATED in Tiger Face!
sub encode { encode_json($_[1]) }
sub encode_json { Mojo::Util::encode 'UTF-8', _encode_value(shift) }
@@ -57,6 +60,12 @@ sub j {
return eval { _decode($_[0]) };
}
+# DEPRECATED in Tiger Face!
+sub new {
+ deprecated 'Object-Oriented Mojo::JSON API is DEPRECATED';
+ return shift->SUPER::new(@_);
+}
+
sub to_json { _encode_value(shift) }
sub true {$TRUE}
@@ -306,16 +315,9 @@ Mojo::JSON - Minimalistic JSON
use Mojo::JSON qw(decode_json encode_json);
- # Encode and decode JSON (die on errors)
my $bytes = encode_json {foo => [1, 2], bar => 'hello!', baz => \1};
my $hash = decode_json $bytes;
- # Handle errors
- my $json = Mojo::JSON->new;
- my $hash = $json->decode($bytes);
- my $err = $json->error;
- say $err ? "Error: $err" : $hash->{message};
-
=head1 DESCRIPTION
L<Mojo::JSON> is a minimalistic and possibly the fastest pure-Perl
@@ -364,6 +366,12 @@ Decode JSON to Perl value and die if decoding fails.
Encode Perl value to JSON.
+=head2 false
+
+ my $false = false;
+
+False value, used because Perl has no native equivalent.
+
=head2 from_json
my $value = from_json $chars;
@@ -387,45 +395,9 @@ or that decoding failed.
Encode Perl value to JSON text without C<UTF-8> encoding it.
-=head1 ATTRIBUTES
-
-L<Mojo::JSON> implements the following attributes.
-
-=head2 error
-
- my $err = $json->error;
- $json = $json->error('Parser error');
-
-Parser error.
-
-=head1 METHODS
-
-L<Mojo::JSON> inherits all methods from L<Mojo::Base> and implements the
-following new ones.
-
-=head2 decode
-
- my $value = $json->decode($bytes);
-
-Decode JSON to Perl value and set L</"error"> if decoding failed.
-
-=head2 encode
-
- my $bytes = $json->encode({i => '♥ mojolicious'});
-
-Encode Perl value to JSON.
-
-=head2 false
-
- my $false = Mojo::JSON->false;
- my $false = $json->false;
-
-False value, used because Perl has no native equivalent.
-
=head2 true
- my $true = Mojo::JSON->true;
- my $true = $json->true;
+ my $true = true;
True value, used because Perl has no native equivalent.
diff --git a/lib/Mojo/Message.pm b/lib/Mojo/Message.pm
index e975f82..434a000 100644
--- a/lib/Mojo/Message.pm
+++ b/lib/Mojo/Message.pm
@@ -461,9 +461,10 @@ Render start line.
my ($foo, $bar) = $msg->cookie(['foo', 'bar']);
Access message cookies, usually L<Mojo::Cookie::Request> or
-L<Mojo::Cookie::Response> objects. To access multiple cookies sharing the same
-name you can also use L</"every_cookie">. Note that this method caches all
-data, so it should not be called before all headers have been received.
+L<Mojo::Cookie::Response> objects. If there are multiple cookies sharing the
+same name, and you want to access more than just the last one, you can use
+L</"every_cookie">. Note that this method caches all data, so it should not be
+called before all headers have been received.
# Get cookie value
say $msg->cookie('foo')->value;
@@ -506,8 +507,7 @@ error.
my $cookies = $msg->every_cookie('foo');
Similar to L</"cookie">, but returns all message cookies sharing the same name
-as an array reference. Note that this method caches all data, so it should not
-be called before all headers have been received.
+as an array reference.
# Get first cookie value
say $msg->every_cookie('foo')->[0]->value;
@@ -517,8 +517,7 @@ be called before all headers have been received.
my $uploads = $msg->every_upload('foo');
Similar to L</"upload">, but returns all file uploads sharing the same name as
-an array reference. Note that this method caches all data, so it should not be
-called before the entire message body has been received.
+an array reference.
# Get content of first uploaded file
say $msg->every_upload('foo')->[0]->asset->slurp;
@@ -632,9 +631,10 @@ Render whole message.
my ($foo, $bar) = $msg->upload(['foo', 'bar']);
Access C<multipart/form-data> file uploads, usually L<Mojo::Upload> objects.
-To access multiple uploads sharing the same name you can also use
-L</"every_upload">. Note that this method caches all data, so it should not be
-called before the entire message body has been received.
+If there are multiple uploads sharing the same name, and you want to access
+more than just the last one, you can use L</"every_upload">. Note that this
+method caches all data, so it should not be called before the entire message
+body has been received.
# Get content of uploaded file
say $msg->upload('foo')->asset->slurp;
diff --git a/lib/Mojo/Message/Request.pm b/lib/Mojo/Message/Request.pm
index 94e39c6..bd98319 100644
--- a/lib/Mojo/Message/Request.pm
+++ b/lib/Mojo/Message/Request.pm
@@ -358,10 +358,7 @@ Access request cookies, usually L<Mojo::Cookie::Request> objects.
my $values = $req->every_param('foo');
Similar to L</"param">, but returns all values sharing the same name as an
-array reference. Note that this method caches all data, so it should not be
-called before the entire request body has been received. Parts of the request
-body need to be loaded into memory to parse C<POST> parameters, so you have to
-make sure it is not excessively large, there's a 10MB limit by default.
+array reference.
# Get first value
say $req->every_param('foo')->[0];
@@ -410,11 +407,12 @@ Check C<X-Requested-With> header for C<XMLHttpRequest> value.
Access C<GET> and C<POST> parameters extracted from the query string and
C<application/x-www-form-urlencoded> or C<multipart/form-data> message body.
-To access multiple values sharing the same name you can also use
-L</"every_param">. Note that this method caches all data, so it should not be
-called before the entire request body has been received. Parts of the request
-body need to be loaded into memory to parse C<POST> parameters, so you have to
-make sure it is not excessively large, there's a 10MB limit by default.
+If there are multiple values sharing the same name, and you want to access
+more than just the last one, you can use L</"every_param">. Note that this
+method caches all data, so it should not be called before the entire request
+body has been received. Parts of the request body need to be loaded into
+memory to parse C<POST> parameters, so you have to make sure it is not
+excessively large, there's a 10MB limit by default.
=head2 params
diff --git a/lib/Mojo/Message/Response.pm b/lib/Mojo/Message/Response.pm
index 7ba1e89..00490d1 100644
--- a/lib/Mojo/Message/Response.pm
+++ b/lib/Mojo/Message/Response.pm
@@ -99,7 +99,7 @@ sub extract_start_line {
my $content = $self->content;
$content->skip_body(1) if $self->code($2)->is_empty;
- $content->auto_relax(1) unless defined $content->auto_relax;
+ defined $content->$_ or $content->$_(1) for qw(auto_decompress auto_relax);
$content->expect_close(1) if $1 eq '1.0';
return !!$self->version($1)->message($3);
}
diff --git a/lib/Mojo/Parameters.pm b/lib/Mojo/Parameters.pm
index c9b9a09..9497456 100644
--- a/lib/Mojo/Parameters.pm
+++ b/lib/Mojo/Parameters.pm
@@ -56,11 +56,12 @@ sub param {
# Multiple names
return map { $self->param($_) } @$name if ref $name eq 'ARRAY';
+ # Last value
+ return $self->_param($name)->[-1] unless @_;
+
# Replace values
$self->remove($name) if defined $_[0];
- return $self->append($name => ref $_[0] eq 'ARRAY' ? $_[0] : [@_]) if @_;
-
- return $self->_param($name)->[-1];
+ return $self->append($name => ref $_[0] eq 'ARRAY' ? $_[0] : [@_]);
}
sub params {
@@ -173,7 +174,6 @@ sub to_string {
sub _param {
my ($self, $name) = @_;
- # List values
my @values;
my $params = $self->params;
for (my $i = 0; $i < @$params; $i += 2) {
@@ -289,9 +289,9 @@ necessary.
$params = $params->param(foo => qw(ba&r baz));
$params = $params->param(foo => ['ba;r', 'baz']);
-Access parameter values. To access multiple values sharing the same name you
-can also use L</"every_param">. Note that this method will normalize the
-parameters.
+Access parameter values. If there are multiple values sharing the same name,
+and you want to access more than just the last one, you can use
+L</"every_param">. Note that this method will normalize the parameters.
=head2 params
diff --git a/lib/Mojo/Server.pm b/lib/Mojo/Server.pm
index db71a57..a378f6e 100644
--- a/lib/Mojo/Server.pm
+++ b/lib/Mojo/Server.pm
@@ -2,6 +2,7 @@ package Mojo::Server;
use Mojo::Base 'Mojo::EventEmitter';
use Carp 'croak';
+use Cwd 'abs_path';
use Mojo::Loader;
use Mojo::Util 'md5_sum';
use POSIX;
@@ -43,7 +44,7 @@ sub load_app {
# Clean environment (reset FindBin defensively)
{
- local $0 = $path;
+ local $0 = $path = abs_path $path;
require FindBin;
FindBin->again;
local $ENV{MOJO_APP_LOADER} = 1;
@@ -73,12 +74,12 @@ sub run { croak 'Method "run" not implemented by subclass' }
sub setuidgid {
my $self = shift;
- # Group
+ # Group (make sure secondary groups are reassigned too)
if (my $group = $self->group) {
return $self->_log(qq{Group "$group" does not exist.})
unless defined(my $gid = getgrnam $group);
return $self->_log(qq{Can't switch to group "$group": $!})
- unless POSIX::setgid($gid);
+ unless ($( = $) = "$gid $gid") && $) eq "$gid $gid" && $( eq "$gid $gid";
}
# User
diff --git a/lib/Mojo/UserAgent.pm b/lib/Mojo/UserAgent.pm
index 61507d0..941b11f 100644
--- a/lib/Mojo/UserAgent.pm
+++ b/lib/Mojo/UserAgent.pm
@@ -393,7 +393,8 @@ Mojo::UserAgent - Non-blocking I/O HTTP and WebSocket user agent
= $ua->put('[::1]:3000' => {'Content-Type' => 'text/plain'} => 'Hello!');
# Follow redirects to grab the latest Mojolicious release :)
- $ua->max_redirects(5)->get('latest.mojolicio.us')
+ $ua->max_redirects(5)
+ ->get('https://www.github.com/kraih/mojo/tarball/master')
->res->content->asset->move_to('/Users/sri/mojo.tar.gz');
# TLS certificate authentication and JSON POST
@@ -812,8 +813,9 @@ implied). You can also append a callback to perform requests non-blocking.
my $tx = $ua->start(Mojo::Transaction::HTTP->new);
-Perform blocking request. You can also append a callback to perform requests
-non-blocking.
+Perform blocking request for a custom L<Mojo::Transaction::HTTP> object, which
+can be prepared manually or with L</"build_tx">. You can also append a
+callback to perform requests non-blocking.
my $tx = $ua->build_tx(GET => 'http://example.com');
$ua->start($tx => sub {
diff --git a/lib/Mojo/UserAgent/Transactor.pm b/lib/Mojo/UserAgent/Transactor.pm
index e9d41ca..f46d211 100644
--- a/lib/Mojo/UserAgent/Transactor.pm
+++ b/lib/Mojo/UserAgent/Transactor.pm
@@ -75,9 +75,11 @@ sub redirect {
return undef unless grep { $_ == $code } 301, 302, 303, 307, 308;
# Fix location without authority and/or scheme
- return unless my $location = $res->headers->location;
+ return undef unless my $location = $res->headers->location;
$location = Mojo::URL->new($location);
$location = $location->base($old->req->url)->to_abs unless $location->is_abs;
+ my $proto = $location->protocol;
+ return undef unless $proto eq 'http' || $proto eq 'https';
# Clone request if necessary
my $new = Mojo::Transaction::HTTP->new;
@@ -155,19 +157,19 @@ sub _form {
my ($self, $tx, $form, %options) = @_;
# Check for uploads and force multipart if necessary
- my $multipart;
+ my $req = $tx->req;
+ my $headers = $req->headers;
+ my $multipart = ($headers->content_type // '') =~ m!multipart/form-data!i;
for my $value (map { ref $_ eq 'ARRAY' ? @$_ : $_ } values %$form) {
++$multipart and last if ref $value eq 'HASH';
}
- my $req = $tx->req;
- my $headers = $req->headers;
- $headers->content_type('multipart/form-data') if $multipart;
# Multipart
- if (($headers->content_type // '') eq 'multipart/form-data') {
+ if ($multipart) {
my $parts = $self->_multipart($options{charset}, $form);
$req->content(
Mojo::Content::MultiPart->new(headers => $headers, parts => $parts));
+ _type($headers, 'multipart/form-data');
return $tx;
}
@@ -178,15 +180,14 @@ sub _form {
if ($method eq 'GET' || $method eq 'HEAD') { $req->url->query->merge($p) }
else {
$req->body($p->to_string);
- $headers->content_type('application/x-www-form-urlencoded');
+ _type($headers, 'application/x-www-form-urlencoded');
}
return $tx;
}
sub _json {
my ($self, $tx, $data) = @_;
- my $headers = $tx->req->body(encode_json($data))->headers;
- $headers->content_type('application/json') unless $headers->content_type;
+ _type($tx->req->body(encode_json $data)->headers, 'application/json');
return $tx;
}
@@ -254,6 +255,8 @@ sub _proxy {
return $proto, $host, $port;
}
+sub _type { $_[0]->content_type($_[1]) unless $_[0]->content_type }
+
1;
=encoding utf8
diff --git a/lib/Mojolicious.pm b/lib/Mojolicious.pm
index 8d64fcb..b954ada 100644
--- a/lib/Mojolicious.pm
+++ b/lib/Mojolicious.pm
@@ -43,7 +43,7 @@ has types => sub { Mojolicious::Types->new };
has validator => sub { Mojolicious::Validator->new };
our $CODENAME = 'Tiger Face';
-our $VERSION = '5.48';
+our $VERSION = '5.54';
sub AUTOLOAD {
my $self = shift;
@@ -887,6 +887,8 @@ Kevin Old
Kitamura Akatsuki
+Klaus S. Madsen
+
Lars Balker Rasmussen
Leon Brocard
@@ -895,6 +897,8 @@ Magnus Holm
Maik Fischer
+Mark Fowler
+
Mark Grimes
Mark Stosberg
@@ -981,6 +985,8 @@ Tatsuhiko Miyagawa
Terrence Brannon
+Tianon Gravi
+
Tomas Znamenacek
Ulrich Habel
diff --git a/lib/Mojolicious/Command/cpanify.pm b/lib/Mojolicious/Command/cpanify.pm
index 3970c06..3cc6bc1 100644
--- a/lib/Mojolicious/Command/cpanify.pm
+++ b/lib/Mojolicious/Command/cpanify.pm
@@ -32,7 +32,7 @@ sub run {
my $msg = $tx->error->{message};
if ($code == 401) { $msg = 'Wrong username or password.' }
elsif ($code == 409) { $msg = 'File already exists on CPAN.' }
- die qq{Problem uploading file "$file". ($msg)\n};
+ die qq{Problem uploading file "$file": $msg\n};
}
say 'Upload successful!';
diff --git a/lib/Mojolicious/Command/get.pm b/lib/Mojolicious/Command/get.pm
index 0d3fbf3..1bc8c09 100644
--- a/lib/Mojolicious/Command/get.pm
+++ b/lib/Mojolicious/Command/get.pm
@@ -65,7 +65,7 @@ sub run {
STDOUT->autoflush(1);
my $tx = $ua->start($ua->build_tx($method, $url, \%headers, $content));
my $err = $tx->error;
- warn qq{Problem loading URL "@{[$tx->req->url]}". ($err->{message})\n}
+ warn qq{Problem loading URL "@{[$tx->req->url]}": $err->{message}\n}
if $err && !$err->{code};
# JSON Pointer
diff --git a/lib/Mojolicious/Command/inflate.pm b/lib/Mojolicious/Command/inflate.pm
index cc5400f..5655239 100644
--- a/lib/Mojolicious/Command/inflate.pm
+++ b/lib/Mojolicious/Command/inflate.pm
@@ -23,7 +23,7 @@ sub run {
}
# Turn them into real files
- for my $name (keys %all) {
+ for my $name (grep {/\.\w+$/} keys %all) {
my $prefix = $name =~ /\.\w+\.\w+$/ ? 'templates' : 'public';
$self->write_file($self->rel_file("$prefix/$name"), $all{$name});
}
diff --git a/lib/Mojolicious/Controller.pm b/lib/Mojolicious/Controller.pm
index 53ac654..2ce7e09 100644
--- a/lib/Mojolicious/Controller.pm
+++ b/lib/Mojolicious/Controller.pm
@@ -365,12 +365,10 @@ sub _param {
return ref $value eq 'ARRAY' ? $value : [$value];
}
- # Uploads
- my $req = $self->req;
- if (my $uploads = $req->every_upload($name)) { return $uploads if @$uploads }
-
- # Param values
- return $req->every_param($name);
+ # Uploads or param values
+ my $req = $self->req;
+ my $uploads = $req->every_upload($name);
+ return @$uploads ? $uploads : $req->every_param($name);
}
sub _signed_cookie {
@@ -498,8 +496,9 @@ Continue dispatch chain with L<Mojolicious::Routes/"continue">.
$c = $c->cookie(foo => 'bar');
$c = $c->cookie(foo => 'bar', {path => '/'});
-Access request cookie values and create new response cookies. To access
-multiple values sharing the same name you can also use L</"every_cookie">.
+Access request cookie values and create new response cookies. If there are
+multiple values sharing the same name, and you want to access more than just
+the last one, you can use L</"every_cookie">.
# Create response cookie with domain and expiration date
$c->cookie(user => 'sri', {domain => 'example.com', expires => time + 60});
@@ -519,9 +518,7 @@ same name as an array reference.
my $values = $c->every_param('foo');
Similar to L</"param">, but returns all values sharing the same name as an
-array reference. Parts of the request body need to be loaded into memory to
-parse C<POST> parameters, so you have to make sure it is not excessively
-large, there's a 10MB limit by default.
+array reference.
# Get first value
my $first = $c->every_param('foo')->[0];
@@ -615,10 +612,11 @@ status.
Access route placeholder values that are not reserved stash values, file
uploads as well as C<GET> and C<POST> parameters extracted from the query
string and C<application/x-www-form-urlencoded> or C<multipart/form-data>
-message body, in that order. To access multiple values sharing the same name
-you can also use L</"every_param">. Parts of the request body need to be
-loaded into memory to parse C<POST> parameters, so you have to make sure it is
-not excessively large, there's a 10MB limit by default.
+message body, in that order. If there are multiple values sharing the same
+name, and you want to access more than just the last one, you can use
+L</"every_param">. Parts of the request body need to be loaded into memory to
+parse C<POST> parameters, so you have to make sure it is not excessively
+large, there's a 10MB limit by default.
# Get first value
my $first = $c->every_param('foo')->[0];
@@ -882,10 +880,10 @@ on browser.
$c = $c->signed_cookie(foo => 'bar');
$c = $c->signed_cookie(foo => 'bar', {path => '/'});
-Access signed request cookie values and create new signed response cookies. To
-access multiple values sharing the same name you can also use
-L</"every_signed_cookie">. Cookies failing HMAC-SHA1 signature verification
-will be automatically discarded.
+Access signed request cookie values and create new signed response cookies. If
+there are multiple values sharing the same name, and you want to access more
+than just the last one, you can use L</"every_signed_cookie">. Cookies failing
+HMAC-SHA1 signature verification will be automatically discarded.
=head2 stash
diff --git a/lib/Mojolicious/Guides.pod b/lib/Mojolicious/Guides.pod
index e98a6ee..fa6b86f 100644
--- a/lib/Mojolicious/Guides.pod
+++ b/lib/Mojolicious/Guides.pod
@@ -274,8 +274,6 @@ This is the class hierarchy of the L<Mojolicious> distribution.
=item * L<Mojo::IOLoop>
-=item * L<Mojo::JSON>
-
=item * L<Mojo::JSON::Pointer>
=item * L<Mojo::Loader>
@@ -412,6 +410,8 @@ This is the class hierarchy of the L<Mojolicious> distribution.
=item * L<Mojo::DOM>
+=item * L<Mojo::JSON>
+
=item * L<Mojo::Util>
=item * L<ojo>
diff --git a/lib/Mojolicious/Guides/Contributing.pod b/lib/Mojolicious/Guides/Contributing.pod
index ad4957d..6839a21 100644
--- a/lib/Mojolicious/Guides/Contributing.pod
+++ b/lib/Mojolicious/Guides/Contributing.pod
@@ -38,16 +38,6 @@ Please report security issues directly to the CPAN email address of the
pumpkin-holder, which is currently C<sri at cpan.org>, and give us a few days to
develop and release a proper fix.
-=head2 Feature requests
-
-Please do not open GitHub issues for feature requests, if there's something
-you would like to see in a future version of L<Mojolicious>, you have to write
-the code yourself.
-
-If you're looking for feedback on your ideas, you're welcome to discuss them
-on the L<mailing-list|http://groups.google.com/group/mojolicious> or the
-official IRC channel C<#mojo> on C<irc.perl.org>.
-
=head1 RESOLVING ISSUES
There are many ways in which you can help us resolve existing issues on the
diff --git a/lib/Mojolicious/Guides/Cookbook.pod b/lib/Mojolicious/Guides/Cookbook.pod
index a193267..069d6b2 100644
--- a/lib/Mojolicious/Guides/Cookbook.pod
+++ b/lib/Mojolicious/Guides/Cookbook.pod
@@ -981,7 +981,7 @@ file with L<Mojo::Asset::File/"move_to">.
# Lets fetch the latest Mojolicious tarball
my $ua = Mojo::UserAgent->new(max_redirects => 5);
- my $tx = $ua->get('latest.mojolicio.us');
+ my $tx = $ua->get('https://www.github.com/kraih/mojo/tarball/master');
$tx->res->content->asset->move_to('mojo.tar.gz');
To protect you from excessively large files there is also a limit of 10MB by
diff --git a/lib/Mojolicious/Plugin/JSONConfig.pm b/lib/Mojolicious/Plugin/JSONConfig.pm
index 4a4a548..e3fb25e 100644
--- a/lib/Mojolicious/Plugin/JSONConfig.pm
+++ b/lib/Mojolicious/Plugin/JSONConfig.pm
@@ -1,18 +1,15 @@
package Mojolicious::Plugin::JSONConfig;
use Mojo::Base 'Mojolicious::Plugin::Config';
-use Mojo::JSON;
+use Mojo::JSON 'from_json';
use Mojo::Template;
-use Mojo::Util 'encode';
sub parse {
my ($self, $content, $file, $conf, $app) = @_;
- my $json = Mojo::JSON->new;
- my $config = $json->decode($self->render($content, $file, $conf, $app));
- my $err = $json->error;
- die qq{Can't parse config "$file": $err} if !$config && $err;
- die qq{Invalid config "$file"} if !$config || ref $config ne 'HASH';
+ my $config = eval { from_json $self->render($content, $file, $conf, $app) };
+ die qq{Can't parse config "$file": $@} if !$config && $@;
+ die qq{Invalid config "$file"} unless ref $config eq 'HASH';
return $config;
}
@@ -26,10 +23,9 @@ sub render {
my $prepend = q[my $app = shift; no strict 'refs'; no warnings 'redefine';];
$prepend .= q[sub app; local *app = sub { $app }; use Mojo::Base -strict;];
- # Render and encode for JSON decoding
my $mt = Mojo::Template->new($conf->{template} || {})->name($file);
- my $json = $mt->prepend($prepend . $mt->prepend)->render($content, $app);
- return ref $json ? die $json : encode 'UTF-8', $json;
+ my $output = $mt->prepend($prepend . $mt->prepend)->render($content, $app);
+ return ref $output ? die $output : $output;
}
1;
diff --git a/lib/Mojolicious/Plugin/PODRenderer.pm b/lib/Mojolicious/Plugin/PODRenderer.pm
index 75d3030..3b911a7 100644
--- a/lib/Mojolicious/Plugin/PODRenderer.pm
+++ b/lib/Mojolicious/Plugin/PODRenderer.pm
@@ -40,7 +40,7 @@ sub _html {
# Rewrite links
my $dom = Mojo::DOM->new(_pod_to_html($src));
my $perldoc = $c->url_for('/perldoc/');
- $_->{href} =~ s!^http://metacpan\.org/pod/!$perldoc!
+ $_->{href} =~ s!^https://metacpan\.org/pod/!$perldoc!
and $_->{href} =~ s!::!/!gi
for $dom->find('a[href]')->attr->each;
@@ -83,7 +83,7 @@ sub _perldoc {
my $module = join '::', split '/', scalar $c->param('module');
my $path
= Pod::Simple::Search->new->find($module, map { $_, "$_/pods" } @INC);
- return $c->redirect_to("http://metacpan.org/pod/$module")
+ return $c->redirect_to("https://metacpan.org/pod/$module")
unless $path && -r $path;
my $src = slurp $path;
@@ -94,7 +94,7 @@ sub _pod_to_html {
return '' unless defined(my $pod = ref $_[0] eq 'CODE' ? shift->() : shift);
my $parser = Pod::Simple::XHTML->new;
- $parser->perldoc_url_prefix('http://metacpan.org/pod/');
+ $parser->perldoc_url_prefix('https://metacpan.org/pod/');
$parser->$_('') for qw(html_header html_footer);
$parser->output_string(\(my $output));
return $@ unless eval { $parser->parse_string_document("$pod"); 1 };
diff --git a/lib/Mojolicious/Routes/Route.pm b/lib/Mojolicious/Routes/Route.pm
index 3ac7cc4..ecc7ad6 100644
--- a/lib/Mojolicious/Routes/Route.pm
+++ b/lib/Mojolicious/Routes/Route.pm
@@ -125,7 +125,8 @@ sub remove {
sub render {
my ($self, $values) = @_;
my $path = join '',
- map { $_->pattern->render($values, !@{$_->children}) } @{$self->_chain};
+ map { $_->pattern->render($values, !@{$_->children} && !$_->partial) }
+ @{$self->_chain};
return $path || '/';
}
diff --git a/lib/Mojolicious/Static.pm b/lib/Mojolicious/Static.pm
index 78ba150..813f17e 100644
--- a/lib/Mojolicious/Static.pm
+++ b/lib/Mojolicious/Static.pm
@@ -120,8 +120,8 @@ sub _epoch { Mojo::Date->new(shift)->epoch }
sub _get_data_file {
my ($self, $rel) = @_;
- # Protect templates
- return undef if $rel =~ /\.\w+\.\w+$/;
+ # Protect files without extensions and templates with two extensions
+ return undef if $rel !~ /\.\w+$/ || $rel =~ /\.\w+\.\w+$/;
$self->_warmup unless $self->{index};
diff --git a/lib/Mojolicious/Validator/Validation.pm b/lib/Mojolicious/Validator/Validation.pm
index 749e9e4..57aecb5 100644
--- a/lib/Mojolicious/Validator/Validation.pm
+++ b/lib/Mojolicious/Validator/Validation.pm
@@ -92,7 +92,7 @@ sub required {
}
sub _param {
- my $value = shift->output->{shift()};
+ return [] unless defined(my $value = shift->output->{shift()});
return [ref $value eq 'ARRAY' ? @$value : $value];
}
@@ -232,8 +232,9 @@ Change validation L</"topic">.
my $value = $validation->param('foo');
my ($foo, $bar) = $validation->param(['foo', 'bar']);
-Access validated parameters. To access multiple values sharing the same name
-you can also use L</"every_param">.
+Access validated parameters. If there are multiple values sharing the same
+name, and you want to access more than just the last one, you can use
+L</"every_param">.
=head2 required
diff --git a/lib/Mojolicious/templates/mojobar.html.ep b/lib/Mojolicious/templates/mojobar.html.ep
index b8c49de..f2e7125 100644
--- a/lib/Mojolicious/templates/mojobar.html.ep
+++ b/lib/Mojolicious/templates/mojobar.html.ep
@@ -56,11 +56,11 @@
%= link_to Documentation => 'http://mojolicio.us/perldoc'
%= link_to Wiki => 'https://github.com/kraih/mojo/wiki'
%= link_to GitHub => 'https://github.com/kraih/mojo'
- %= link_to CPAN => 'http://metacpan.org/release/Mojolicious/'
- %= link_to MailingList => 'http://groups.google.com/group/mojolicious'
+ %= link_to CPAN => 'https://metacpan.org/release/Mojolicious/'
+ %= link_to MailingList => 'https://groups.google.com/group/mojolicious'
%= link_to Blog => 'http://blog.kraih.com'
- %= link_to Twitter => 'http://twitter.com/kraih'
- %= form_for 'http://google.com/cse' => (target => '_blank') => begin
+ %= link_to Twitter => 'https://twitter.com/kraih'
+ %= form_for 'https://www.google.com/cse' => (target => '_blank') => begin
%= hidden_field cx => '014527573091551588235:pwfplkjpgbi'
%= hidden_field ie => 'UTF-8'
%= search_field 'q', placeholder => 'Search'
diff --git a/lib/Test/Mojo.pm b/lib/Test/Mojo.pm
index 39cbc3f..c4798a1 100644
--- a/lib/Test/Mojo.pm
+++ b/lib/Test/Mojo.pm
@@ -664,29 +664,29 @@ arguments as L<Mojo::UserAgent/"head">, except for the callback.
=head2 header_is
- $t = $t->header_is(Expect => 'fun');
- $t = $t->header_is(Expect => 'fun', 'right header');
+ $t = $t->header_is(ETag => '"abc321"');
+ $t = $t->header_is(ETag => '"abc321"', 'right header');
Check response header for exact match.
=head2 header_isnt
- $t = $t->header_isnt(Expect => 'fun');
- $t = $t->header_isnt(Expect => 'fun', 'different header');
+ $t = $t->header_isnt(Etag => '"abc321"');
+ $t = $t->header_isnt(ETag => '"abc321"', 'different header');
Opposite of L</"header_is">.
=head2 header_like
- $t = $t->header_like(Expect => qr/fun/);
- $t = $t->header_like(Expect => qr/fun/, 'right header');
+ $t = $t->header_like(ETag => qr/abc/);
+ $t = $t->header_like(ETag => qr/abc/, 'right header');
Check response header for similar match.
=head2 header_unlike
- $t = $t->header_like(Expect => qr/fun/);
- $t = $t->header_like(Expect => qr/fun/, 'different header');
+ $t = $t->header_unlike(ETag => qr/abc/);
+ $t = $t->header_unlike(ETag => qr/abc/, 'different header');
Opposite of L</"header_like">.
diff --git a/lib/ojo.pm b/lib/ojo.pm
index cbf148e..b827bc7 100644
--- a/lib/ojo.pm
+++ b/lib/ojo.pm
@@ -45,7 +45,7 @@ sub _request {
my $tx = $ua->start($ua->build_tx(@_));
my $err = $tx->error;
- warn qq/Problem loading URL "@{[$tx->req->url]}". ($err->{message})\n/
+ warn qq/Problem loading URL "@{[$tx->req->url]}": $err->{message}\n/
if $err && !$err->{code};
return $tx->res;
diff --git a/script/hypnotoad b/script/hypnotoad
index 80148e9..b83f0af 100755
--- a/script/hypnotoad
+++ b/script/hypnotoad
@@ -3,9 +3,6 @@
use strict;
use warnings;
-use FindBin;
-BEGIN { unshift @INC, "$FindBin::Bin/../lib" }
-
use Getopt::Long qw(GetOptions :config no_auto_abbrev no_ignore_case);
GetOptions
diff --git a/script/mojo b/script/mojo
index 11cf678..98f9c28 100755
--- a/script/mojo
+++ b/script/mojo
@@ -3,9 +3,6 @@
use strict;
use warnings;
-use FindBin;
-BEGIN { unshift @INC, "$FindBin::Bin/../lib" }
-
require Mojolicious::Commands;
Mojolicious::Commands->start_app('Mojo::HelloWorld');
diff --git a/script/morbo b/script/morbo
index b199de0..3d3a284 100755
--- a/script/morbo
+++ b/script/morbo
@@ -3,9 +3,6 @@
use strict;
use warnings;
-use FindBin;
-BEGIN { unshift @INC, "$FindBin::Bin/../lib" }
-
use Getopt::Long qw(GetOptions :config no_auto_abbrev no_ignore_case);
GetOptions
diff --git a/t/mojo/asset.t b/t/mojo/asset.t
index f304dbb..b235fa2 100644
--- a/t/mojo/asset.t
+++ b/t/mojo/asset.t
@@ -193,18 +193,6 @@ ok !$asset->is_file, 'stored in memory';
$asset = $asset->add_chunk('lala');
ok !$asset->is_file, 'stored in memory';
-# Append to file asset
-$file = Mojo::Asset::File->new(cleanup => 0);
-is $file->add_chunk('hello')->slurp, 'hello', 'right content';
-$path = $file->path;
-undef $file;
-ok -e $path, 'file still exists';
-$file = Mojo::Asset::File->new(path => $path, cleanup => 1);
-is $file->add_chunk(' world')->slurp, 'hello world', 'right content';
-is $file->add_chunk('!')->slurp, 'hello world!', 'right content';
-undef $file;
-ok !-e $path, 'file has been cleaned up';
-
# Temporary directory
{
my $tmpdir = tempdir CLEANUP => 1;
diff --git a/t/mojo/bytestream.t b/t/mojo/bytestream.t
index e8292f2..d9b8e76 100644
--- a/t/mojo/bytestream.t
+++ b/t/mojo/bytestream.t
@@ -151,8 +151,4 @@ $file = catfile $dir, 'test.txt';
is b("just\nworks!")->spurt($file)->quote, qq{"just\nworks!"}, 'right result';
is b($file)->slurp, "just\nworks!", 'successful roundtrip';
-# Boolean context
-ok !Mojo::ByteStream->new(0), '"0" is falsy';
-ok !!Mojo::ByteStream->new(1), '"1" is truthy';
-
done_testing();
diff --git a/t/mojo/collection.t b/t/mojo/collection.t
index dabd676..2ef3823 100644
--- a/t/mojo/collection.t
+++ b/t/mojo/collection.t
@@ -171,10 +171,4 @@ eval { Mojo::Collection::missing() };
like $@, qr/^Undefined subroutine &Mojo::Collection::missing called/,
'right error';
-# Boolean context
-$collection = Mojo::Collection->new;
-ok !$collection, 'empty collection is falsy';
-$collection = Mojo::Collection->new('wat');
-ok $collection, ' non-empty collection is truthy ';
-
done_testing();
diff --git a/t/mojo/daemon.t b/t/mojo/daemon.t
index 24ee3cf..ac679eb 100644
--- a/t/mojo/daemon.t
+++ b/t/mojo/daemon.t
@@ -6,6 +6,7 @@ BEGIN {
}
use Test::More;
+use Cwd 'abs_path';
use File::Spec::Functions 'catdir';
use FindBin;
use Mojo;
@@ -62,6 +63,11 @@ is $app->config({test => 23})->config->{test}, 23, 'right value';
is_deeply $app->config, {foo => 'bar', baz => 'yada', test => 23},
'right value';
+# Script name
+my $path = "$FindBin::Bin/lib/../lib/myapp.pl";
+is(Mojo::Server::Daemon->new->load_app($path)->config('script'),
+ abs_path($path), 'right script name');
+
# Load broken app
eval {
Mojo::Server::Daemon->new->load_app(
diff --git a/t/mojo/dom.t b/t/mojo/dom.t
index 3a18141..3d2017d 100644
--- a/t/mojo/dom.t
+++ b/t/mojo/dom.t
@@ -2281,6 +2281,22 @@ is "$dom", <<EOF, 'right result';
<bar>after</bar>
EOF
+# Nested description lists
+$dom = Mojo::DOM->new->parse(<<EOF);
+<dl>
+ <dt>A</dt>
+ <DD>
+ <dl>
+ <dt>B
+ <dd>C
+ </dl>
+ </dd>
+</dl>
+EOF
+is $dom->find('dl > dd > dl > dt')->[0]->text, 'B', 'right text';
+is $dom->find('dl > dd > dl > dd')->[0]->text, 'C', 'right text';
+is $dom->find('dl > dt')->[0]->text, 'A', 'right text';
+
# Nested lists
$dom = Mojo::DOM->new(<<EOF);
<div>
diff --git a/t/mojo/json.t b/t/mojo/json.t
index 002d108..481364d 100644
--- a/t/mojo/json.t
+++ b/t/mojo/json.t
@@ -10,7 +10,7 @@ use Mojo::Base -strict;
use Test::More;
use Mojo::ByteStream 'b';
-use Mojo::JSON qw(decode_json encode_json from_json j to_json);
+use Mojo::JSON qw(decode_json encode_json false from_json j to_json true);
use Mojo::Util 'encode';
use Scalar::Util 'dualvar';
@@ -54,8 +54,7 @@ is_deeply $array, [Mojo::JSON->true], 'decode [true]';
$array = decode_json '[null]';
is_deeply $array, [undef], 'decode [null]';
$array = decode_json '[true, false]';
-is_deeply $array, [Mojo::JSON->true, Mojo::JSON->false],
- 'decode [true, false]';
+is_deeply $array, [true, false], 'decode [true, false]';
$value = decode_json 'true';
is $value, Mojo::JSON->true, 'decode true';
$value = decode_json 'false';
@@ -322,70 +321,74 @@ like encode_json({test => -sin(9**9**9)}), qr/^{"test":".*"}$/,
'encode "nan" as string';
# "null"
-my $json = Mojo::JSON->new;
-is $json->decode('null'), undef, 'decode null';
-ok !$json->error, 'no error';
is j('null'), undef, 'decode null';
# Errors
-is $json->decode('test'), undef, 'syntax error';
-is $json->error, 'Malformed JSON: Expected string, array, object, number,'
- . ' boolean or null at line 0, offset 0', 'right error';
-is $json->decode(b('["\\ud800"]')->encode), undef, 'syntax error';
-is $json->error, 'Malformed JSON: Missing low-surrogate at line 1, offset 8',
+eval { decode_json 'test' };
+like $@, qr/Malformed JSON: Expected string, array, object/, 'right error';
+like $@, qr/object, number, boolean or null at line 0, offset 0/,
'right error';
-is $json->decode(b('["\\udf46"]')->encode), undef, 'syntax error';
-is $json->error, 'Malformed JSON: Missing high-surrogate at line 1, offset 8',
+eval { decode_json b('["\\ud800"]')->encode };
+like $@, qr/Malformed JSON: Missing low-surrogate at line 1, offset 8/,
'right error';
-is $json->decode('[[]'), undef, 'syntax error';
-is $json->error, 'Malformed JSON: Expected comma or right square bracket while'
- . ' parsing array at line 1, offset 3', 'right error';
-is $json->decode('{{}'), undef, 'syntax error';
-is $json->error, 'Malformed JSON: Expected string while'
- . ' parsing object at line 1, offset 1', 'right error';
-is $json->decode("[\"foo\x00]"), undef, 'syntax error';
-is $json->error, 'Malformed JSON: Unexpected character or invalid escape while'
- . ' parsing string at line 1, offset 5', 'right error';
-is $json->decode('{"foo":"bar"{'), undef, 'syntax error';
-is $json->error, 'Malformed JSON: Expected comma or right curly bracket while'
- . ' parsing object at line 1, offset 12', 'right error';
-is $json->decode('{"foo""bar"}'), undef, 'syntax error';
-is $json->error,
- 'Malformed JSON: Expected colon while parsing object at line 1, offset 6',
+eval { decode_json b('["\\udf46"]')->encode };
+like $@, qr/Malformed JSON: Missing high-surrogate at line 1, offset 8/,
'right error';
-is $json->decode('[[]...'), undef, 'syntax error';
-is $json->error, 'Malformed JSON: Expected comma or right square bracket while'
- . ' parsing array at line 1, offset 3', 'right error';
-is $json->decode('{{}...'), undef, 'syntax error';
-is $json->error, 'Malformed JSON: Expected string while'
- . ' parsing object at line 1, offset 1', 'right error';
-is $json->decode('[nan]'), undef, 'syntax error';
-is $json->error, 'Malformed JSON: Expected string, array, object, number,'
- . ' boolean or null at line 1, offset 1', 'right error';
-is $json->decode('["foo]'), undef, 'syntax error';
-is $json->error, 'Malformed JSON: Unterminated string at line 1, offset 6',
+eval { decode_json '[[]' };
+like $@, qr/Malformed JSON: Expected comma or right square bracket/,
'right error';
-is $json->decode('{"foo":"bar"}lala'), undef, 'syntax error';
-is $json->error, 'Malformed JSON: Unexpected data at line 1, offset 13',
+like $@, qr/bracket while parsing array at line 1, offset 3/, 'right error';
+eval { decode_json '{{}' };
+like $@,
+ qr/Malformed JSON: Expected string while parsing object at line 1, offset 1/,
'right error';
-is $json->decode(''), undef, 'missing input';
-is $json->error, 'Missing or empty input', 'right error';
-is $json->decode("[\"foo\",\n\"bar\"]lala"), undef, 'syntax error';
-is $json->error, 'Malformed JSON: Unexpected data at line 2, offset 6',
+eval { decode_json "[\"foo\x00]" };
+like $@, qr/Malformed JSON: Unexpected character or invalid escape/,
'right error';
-is $json->decode("[\"foo\",\n\"bar\",\n\"bazra\"]lalala"), undef,
- 'syntax error';
-is $json->error, 'Malformed JSON: Unexpected data at line 3, offset 8',
+like $@, qr/escape while parsing string at line 1, offset 5/, 'right error';
+eval { decode_json '{"foo":"bar"{' };
+like $@, qr/Malformed JSON: Expected comma or right curly bracket/,
'right error';
-is $json->decode('["♥"]'), undef, 'wide character in input';
-is $json->error, 'Input is not UTF-8 encoded', 'right error';
-is $json->decode(encode('Shift_JIS', 'やった')), undef, 'invalid encoding';
-is $json->error, 'Input is not UTF-8 encoded', 'right error';
+like $@, qr/bracket while parsing object at line 1, offset 12/, 'right error';
+eval { decode_json '{"foo""bar"}' };
+like $@,
+ qr/Malformed JSON: Expected colon while parsing object at line 1, offset 6/,
+ 'right error';
+eval { decode_json '[[]...' };
+like $@, qr/Malformed JSON: Expected comma or right square bracket/,
+ 'right error';
+like $@, qr/bracket while parsing array at line 1, offset 3/, 'right error';
+eval { decode_json '{{}...' };
+like $@,
+ qr/Malformed JSON: Expected string while parsing object at line 1, offset 1/,
+ 'right error';
+eval { decode_json '[nan]' };
+like $@, qr/Malformed JSON: Expected string, array, object, number/,
+ 'right error';
+like $@, qr/number, boolean or null at line 1, offset 1/, 'right error';
+eval { decode_json '["foo]' };
+like $@, qr/Malformed JSON: Unterminated string at line 1, offset 6/,
+ 'right error';
+eval { decode_json '{"foo":"bar"}lala' };
+like $@, qr/Malformed JSON: Unexpected data at line 1, offset 13/,
+ 'right error';
+eval { decode_json '' };
+like $@, qr/Missing or empty input/, 'right error';
+eval { decode_json "[\"foo\",\n\"bar\"]lala" };
+like $@, qr/Malformed JSON: Unexpected data at line 2, offset 6/,
+ 'right error';
+eval { decode_json "[\"foo\",\n\"bar\",\n\"bazra\"]lalala" };
+like $@, qr/Malformed JSON: Unexpected data at line 3, offset 8/,
+ 'right error';
+eval { decode_json '["♥"]' };
+like $@, qr/Input is not UTF-8 encoded/, 'right error';
+eval { decode_json encode('Shift_JIS', 'やった') };
+like $@, qr/Input is not UTF-8 encoded/, 'right error';
is j('{'), undef, 'syntax error';
-eval { decode_json("[\"foo\",\n\"bar\",\n\"bazra\"]lalala") };
+eval { decode_json "[\"foo\",\n\"bar\",\n\"bazra\"]lalala" };
like $@, qr/JSON: Unexpected data at line 3, offset 8 at.*json\.t/,
'right error';
-eval { from_json("[\"foo\",\n\"bar\",\n\"bazra\"]lalala") };
+eval { from_json "[\"foo\",\n\"bar\",\n\"bazra\"]lalala" };
like $@, qr/JSON: Unexpected data at line 3, offset 8 at.*json\.t/,
'right error';
diff --git a/t/mojo/lib/myapp.pl b/t/mojo/lib/myapp.pl
new file mode 100644
index 0000000..e6d08cb
--- /dev/null
+++ b/t/mojo/lib/myapp.pl
@@ -0,0 +1,5 @@
+use Mojolicious::Lite;
+
+app->config(script => $0);
+
+app->start;
diff --git a/t/mojo/parameters.t b/t/mojo/parameters.t
index ef663a8..188247a 100644
--- a/t/mojo/parameters.t
+++ b/t/mojo/parameters.t
@@ -67,6 +67,7 @@ is $params->to_string, 'bar=bar&foo=', 'right format';
$params = Mojo::Parameters->new(foo => 0);
is $params->param('foo'), 0, 'right value';
is_deeply $params->every_param('foo'), [0], 'right value';
+is_deeply $params->every_param('bar'), [], 'no values';
is $params->to_string, 'foo=0', 'right format';
$params = Mojo::Parameters->new($params->to_string);
is $params->param('foo'), 0, 'right value';
diff --git a/t/mojo/response.t b/t/mojo/response.t
index 4e94a8e..bfed61d 100644
--- a/t/mojo/response.t
+++ b/t/mojo/response.t
@@ -270,6 +270,7 @@ $res->parse("Hello World!\n1234\nlalalala\n");
ok !$res->is_finished, 'response is not finished';
ok !$res->is_empty, 'response is not empty';
ok !$res->content->skip_body, 'body has not been skipped';
+ok $res->content->relaxed, 'relaxed response';
is $res->code, 500, 'right status';
is $res->message, 'Internal Server Error', 'right message';
is $res->version, '1.1', 'right version';
@@ -277,6 +278,19 @@ is $res->headers->content_type, 'text/plain', 'right "Content-Type" value';
is $res->headers->content_length, undef, 'no "Content-Length" value';
is $res->body, "Hello World!\n1234\nlalalala\n", 'right content';
+# Parse full HTTP 1.1 response (broken Content-Length)
+$res = Mojo::Message::Response->new;
+$res->parse("HTTP/1.1 200 OK\x0d\x0a");
+$res->parse("Content-Length: 123test\x0d\x0a\x0d\x0a");
+$res->parse('Hello World!');
+ok $res->is_finished, 'response is finished';
+is $res->code, 200, 'right status';
+is $res->message, 'OK', 'right message';
+is $res->version, '1.1', 'right version';
+is $res->headers->content_length, '123test', 'right "Content-Length" value';
+is $res->body, '', 'no content';
+is $res->content->leftovers, 'Hello World!', 'content in leftovers';
+
# Parse full HTTP 1.1 response (100 Continue)
$res = Mojo::Message::Response->new;
$res->content->on(body => sub { shift->headers->header('X-Body' => 'one') });
@@ -462,7 +476,7 @@ isa_ok $res->content->parts->[2], 'Mojo::Content::Single', 'right part';
is $res->content->parts->[0]->asset->slurp, "hallo welt test123\n",
'right content';
-# Parse HTTP 1.1 chunked multipart response (at once)
+# Parse HTTP 1.1 chunked multipart response with leftovers (at once)
$res = Mojo::Message::Response->new;
my $multipart
= "HTTP/1.1 200 OK\x0d\x0a"
@@ -484,7 +498,8 @@ my $multipart
. "print \"Hello World :)\\n\"\n"
. "\x0d\x0a------------0xKhTmLbOuNdA"
. "r\x0d\x0a3\x0d\x0aY--\x0d\x0a"
- . "0\x0d\x0a\x0d\x0a";
+ . "0\x0d\x0a\x0d\x0a"
+ . "HTTP/1.0 200 OK\x0d\x0a\x0d\x0a";
$res->parse($multipart);
ok $res->is_finished, 'response is finished';
is $res->code, 200, 'right status';
@@ -506,6 +521,8 @@ isa_ok $res->upload('upload')->asset, 'Mojo::Asset::Memory', 'right file';
is $res->upload('upload')->asset->size, 69, 'right size';
is $res->content->parts->[2]->headers->content_type,
'application/octet-stream', 'right "Content-Type" value';
+is $res->content->leftovers, "HTTP/1.0 200 OK\x0d\x0a\x0d\x0a",
+ 'next response in leftovers';
# Parse HTTP 1.1 chunked multipart response (in multiple small chunks)
$res = Mojo::Message::Response->new;
diff --git a/t/mojo/transactor.t b/t/mojo/transactor.t
index 6a898ed..6c8560a 100644
--- a/t/mojo/transactor.t
+++ b/t/mojo/transactor.t
@@ -151,12 +151,14 @@ is $tx->req->headers->content_type, 'application/x-www-form-urlencoded',
'right "Content-Type" value';
is $tx->req->body, 'test=12345678912', 'right content';
-# UTF-8 form with header
-$tx = $t->tx(POST => 'http://example.com/foo' => {Accept => '*/*'} => form =>
+# UTF-8 form with header and custom content type
+$tx
+ = $t->tx(POST => 'http://example.com/foo' =>
+ {Accept => '*/*', 'Content-Type' => 'application/mojo-form'} => form =>
{test => 123} => charset => 'UTF-8');
is $tx->req->url->to_abs, 'http://example.com/foo', 'right URL';
is $tx->req->method, 'POST', 'right method';
-is $tx->req->headers->content_type, 'application/x-www-form-urlencoded',
+is $tx->req->headers->content_type, 'application/mojo-form',
'right "Content-Type" value';
is $tx->req->headers->accept, '*/*', 'right "Accept" value';
is $tx->req->body, 'test=123', 'right content';
@@ -218,12 +220,14 @@ ok !$tx->req->content->parts->[0]->headers->header('file'), 'no "file" header';
is $tx->req->content->parts->[0]->headers->dnt, 1, 'right "DNT" header';
is $tx->req->content->parts->[1], undef, 'no more parts';
-# Multipart form with asset
-$tx = $t->tx(POST => 'http://example.com/foo' => form =>
+# Multipart form with asset and custom content type
+$tx
+ = $t->tx(POST => 'http://example.com/foo' =>
+ {'Content-Type' => 'multipart/mojo-form'} => form =>
{mytext => {file => Mojo::Asset::File->new(path => $path)}});
is $tx->req->url->to_abs, 'http://example.com/foo', 'right URL';
is $tx->req->method, 'POST', 'right method';
-is $tx->req->headers->content_type, 'multipart/form-data',
+is $tx->req->headers->content_type, 'multipart/mojo-form',
'right "Content-Type" value';
like $tx->req->content->parts->[0]->headers->content_disposition,
qr/"mytext"/, 'right "Content-Disposition" value';
@@ -789,13 +793,13 @@ is $tx->res->headers->location, undef, 'no "Location" value';
$tx = $t->tx(
POST => 'http://mojolicio.us/foo' => {Accept => '*/*'} => 'whatever');
$tx->res->code(308);
-$tx->res->headers->location('http://example.com/bar');
+$tx->res->headers->location('https://example.com/bar');
is $tx->req->headers->accept, '*/*', 'right "Accept" value';
is $tx->req->body, 'whatever', 'right content';
$tx = $t->redirect($tx);
is $tx->req->method, 'POST', 'right method';
-is $tx->req->url->to_abs, 'http://example.com/bar', 'right URL';
-is $tx->req->headers->accept, '*/*', 'right "Accept" value';
+is $tx->req->url->to_abs, 'https://example.com/bar', 'right URL';
+is $tx->req->headers->accept, '*/*', 'right "Accept" value';
is $tx->req->headers->location, undef, 'no "Location" value';
is $tx->req->body, 'whatever', 'right content';
is $tx->res->code, undef, 'no status';
@@ -817,6 +821,12 @@ is $tx->req->headers->accept, 'application/json', 'right "Accept" value';
is $tx->req->body, '', 'no content';
is $t->redirect($tx), undef, 'unsupported redirect';
+# 302 redirect with bad location
+$tx = $t->tx(GET => 'http://mojolicio.us/foo');
+$tx->res->code(302);
+$tx->res->headers->location('data:image/png;base64,helloworld123');
+is $t->redirect($tx), undef, 'unsupported redirect';
+
# 302 redirect (relative path and query)
$tx = $t->tx(
POST => 'http://mojolicio.us/foo/bar?a=b' => {Accept => 'application/json'});
diff --git a/t/mojo/user_agent.t b/t/mojo/user_agent.t
index 157ac83..2666c58 100644
--- a/t/mojo/user_agent.t
+++ b/t/mojo/user_agent.t
@@ -345,6 +345,22 @@ ok !$tx->success, 'not successful';
is $tx->error->{message}, 'Not Found', 'right error';
is $tx->error->{code}, 404, 'right status';
+# Compressed response
+$tx = $ua->build_tx(GET => '/echo' => 'Hello GZip!');
+$tx = $ua->start($ua->build_tx(GET => '/echo' => 'Hello GZip!'));
+ok $tx->success, 'successful';
+is $tx->res->code, 200, 'right status';
+is $tx->res->headers->content_encoding, undef, 'no "Content-Encoding" value';
+is $tx->res->body, 'Hello GZip!', 'right content';
+$tx = $ua->build_tx(GET => '/echo' => 'Hello GZip!');
+$tx->res->content->auto_decompress(0);
+$tx = $ua->start($tx);
+ok $tx->success, 'successful';
+is $tx->res->code, 200, 'right status';
+is $tx->res->headers->content_encoding, 'gzip',
+ 'right "Content-Encoding" value';
+isnt $tx->res->body, 'Hello GZip!', 'different content';
+
# Fork safety
$tx = $ua->get('/');
is $tx->res->body, 'works!', 'right content';
diff --git a/t/mojolicious/dispatch.t b/t/mojolicious/dispatch.t
index 9e0edee..9d7422e 100644
--- a/t/mojolicious/dispatch.t
+++ b/t/mojolicious/dispatch.t
@@ -72,6 +72,7 @@ is $c->param(foo => 'works')->param('foo'), 'works', 'right value';
is $c->param(foo => 'too')->param('foo'), 'too', 'right value';
is $c->param(foo => qw(just works))->param('foo'), 'works', 'right value';
is_deeply $c->every_param('foo'), [qw(just works)], 'right values';
+is_deeply $c->every_param('bar'), [], 'no values';
is $c->param(foo => undef)->param('foo'), undef, 'no value';
is $c->param(foo => Mojo::Upload->new(name => 'bar'))->param('foo')->name,
'bar', 'right value';
diff --git a/t/mojolicious/embedded_lite_app.t b/t/mojolicious/embedded_lite_app.t
index 00f9b7b..40d7adc 100644
--- a/t/mojolicious/embedded_lite_app.t
+++ b/t/mojolicious/embedded_lite_app.t
@@ -194,7 +194,7 @@ $t->get_ok('/x/1/stream')->status_is(200)->content_is('hello!');
# URL from myapp.pl
$t->get_ok('/x/1/url/☃')->status_is(200)
- ->content_is('/x/1/url/%E2%98%83 -> /x/1/%E2%98%83/stream!');
+ ->content_is('/x/1/url/%E2%98%83.json -> /x/1/%E2%98%83/stream!');
# Route to template from myapp.pl
$t->get_ok('/x/1/template/menubar')->status_is(200)
@@ -227,7 +227,8 @@ $t->get_ok('/x/♥/stream')->status_is(200)->content_is('hello!');
# URL from myapp.pl with unicode prefix
$t->get_ok('/x/♥/url/☃')->status_is(200)
- ->content_is('/x/%E2%99%A5/url/%E2%98%83 -> /x/%E2%99%A5/%E2%98%83/stream!');
+ ->content_is(
+ '/x/%E2%99%A5/url/%E2%98%83.json -> /x/%E2%99%A5/%E2%98%83/stream!');
# Route to template from myapp.pl with unicode prefix
$t->get_ok('/x/♥/template/menubar')->status_is(200)
diff --git a/t/mojolicious/external/myapp.pl b/t/mojolicious/external/myapp.pl
index 8e8b5ae..fe2b355 100644
--- a/t/mojolicious/external/myapp.pl
+++ b/t/mojolicious/external/myapp.pl
@@ -37,7 +37,7 @@ get '/stream' => sub {
get '/url/☃' => sub {
my $c = shift;
- my $route = $c->url_for;
+ my $route = $c->url_for({format => 'json'});
my $rel = $c->url_for('/☃/stream');
$c->render(text => "$route -> $rel!");
};
diff --git a/t/mojolicious/external_lite_app.t b/t/mojolicious/external_lite_app.t
index ca340ca..3b8a8c2 100644
--- a/t/mojolicious/external_lite_app.t
+++ b/t/mojolicious/external_lite_app.t
@@ -39,6 +39,6 @@ $t->get_ok('/stream')->status_is(200)->content_is('hello!');
# URL generated by myapp.pl
$t->get_ok('/url/☃')->status_is(200)
- ->content_is('/url/%E2%98%83 -> /%E2%98%83/stream!');
+ ->content_is('/url/%E2%98%83.json -> /%E2%98%83/stream!');
done_testing();
diff --git a/t/mojolicious/json_config_lite_app.t b/t/mojolicious/json_config_lite_app.t
index be49521..7c04097 100644
--- a/t/mojolicious/json_config_lite_app.t
+++ b/t/mojolicious/json_config_lite_app.t
@@ -17,13 +17,17 @@ use Test::Mojo;
app->config(it => 'works');
is_deeply app->config, {it => 'works'}, 'right value';
+# Invalid config file
+my $path = abs_path catfile(dirname(__FILE__), 'public', 'hello.txt');
+eval { plugin JSONConfig => {file => $path}; };
+like $@, qr/Malformed JSON/, 'right error';
+
# Load plugins
my $config
= plugin j_s_o_n_config => {default => {foo => 'baz', hello => 'there'}};
my $log = '';
my $cb = app->log->on(message => sub { $log .= pop });
-my $path
- = abs_path(catfile(dirname(__FILE__), 'json_config_lite_app_abs.json'));
+$path = abs_path catfile(dirname(__FILE__), 'json_config_lite_app_abs.json');
plugin JSONConfig => {file => $path};
like $log, qr/Reading configuration file "\Q$path\E"\./, 'right message';
app->log->unsubscribe(message => $cb);
diff --git a/t/mojolicious/static_lite_app.t b/t/mojolicious/static_lite_app.t
index ce80d4b..8a0af31 100644
--- a/t/mojolicious/static_lite_app.t
+++ b/t/mojolicious/static_lite_app.t
@@ -184,6 +184,9 @@ $t->get_ok('/hello4.txt' => {Range => 'bytes=0-0'})->status_is(416)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('Accept-Ranges' => 'bytes')->content_is('');
+# Hidden inline file
+$t->get_ok('/hidden')->status_is(404)->content_unlike(qr/Unreachable file/);
+
# Base64 static inline file, If-Modified-Since
my $modified = Mojo::Date->new->epoch(time - 3600);
$t->get_ok('/static.txt' => {'If-Modified-Since' => $modified})
@@ -222,5 +225,8 @@ $t->get_ok('/static.txt' => {Range => 'bytes=45-50'})->status_is(416)
done_testing();
__DATA__
+@@ hidden
+Unreachable file.
+
@@ static.txt (base64)
dGVzdCAxMjMKbGFsYWxh
diff --git a/t/mojolicious/validation_lite_app.t b/t/mojolicious/validation_lite_app.t
index a916ff1..74dd82d 100644
--- a/t/mojolicious/validation_lite_app.t
+++ b/t/mojolicious/validation_lite_app.t
@@ -36,6 +36,8 @@ my $t = Test::Mojo->new;
# Required and optional values
my $validation = $t->app->validation->input({foo => 'bar', baz => 'yada'});
is_deeply [$validation->error], [], 'no names';
+is $validation->param('foo'), undef, 'no value';
+is_deeply $validation->every_param('foo'), [], 'no values';
ok $validation->required('foo')->is_valid, 'valid';
is_deeply $validation->output, {foo => 'bar'}, 'right result';
is $validation->param('foo'), 'bar', 'right value';
diff --git a/t/mojolicious/websocket_lite_app.t b/t/mojolicious/websocket_lite_app.t
index f9d239b..ea77c5e 100644
--- a/t/mojolicious/websocket_lite_app.t
+++ b/t/mojolicious/websocket_lite_app.t
@@ -189,7 +189,7 @@ $t->message_ok->message_is({binary => 'a' x 50000});
ok length $payload < 262145, 'message has been compressed';
$t->finish_ok->finished_ok(1005);
-# Compressed message exceeding the limit when uncompressed
+# Compressed message exceeding the limit when decompressed
$t->websocket_ok(
'/echo' => {'Sec-WebSocket-Extensions' => 'permessage-deflate'})
->header_is('Sec-WebSocket-Extensions' => 'permessage-deflate')
diff --git a/t/pod_coverage.t b/t/pod_coverage.t
index 69dcf72..ce1ed37 100644
--- a/t/pod_coverage.t
+++ b/t/pod_coverage.t
@@ -8,7 +8,8 @@ plan skip_all => 'Test::Pod::Coverage 1.04 required for this test!'
unless eval 'use Test::Pod::Coverage 1.04; 1';
# DEPRECATED in Tiger Face!
-my @tiger = (qw(emit_safe has_conditions render_static));
+my @tiger
+ = (qw(decode emit_safe encode error has_conditions new render_static));
# False positive constants
all_pod_coverage_ok({also_private => [qw(IPV6 TLS), @tiger]});
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmojolicious-perl.git
More information about the Pkg-perl-cvs-commits
mailing list