The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
Changes 022
META.json 23
META.yml 23
Makefile.PL 02
lib/Mojo/Collection.pm 33
lib/Mojo/DOM.pm 440
lib/Mojo/Reactor.pm 103
lib/Mojo/UserAgent/Proxy.pm 55
lib/Mojo/UserAgent/Transactor.pm 41
lib/Mojo/UserAgent.pm 11
lib/Mojolicious/Plugin/PODRenderer.pm 3522
lib/Mojolicious/templates/perldoc.html.ep 410
lib/Mojolicious.pm 33
t/mojo/dom.t 040
t/mojolicious/pod_renderer_lite_app.t 56
t/mojolicious/twinkle_lite_app.t 33
16 files changed (This is a version diff) 81167
@@ -1,4 +1,26 @@
 
+5.21  2014-07-27
+  - Improved handling of Pod::Simple::XHTML 3.09 dependency.
+  - Improved documentation browser CSS.
+
+5.20  2014-07-27
+  - Fixed a few bugs in Mojolicious::Plugin::PODRenderer by switching from
+    Pod::Simple::HTML to Pod::Simple::XHTML.
+  - Fixed Perl 5.18.x compatibility.
+
+5.19  2014-07-26
+  - Improved support for Unicode anchors in Mojolicious::Plugin::PODRenderer.
+  - Fixed is_readable scalability problems in Mojo::Reactor.
+
+5.18  2014-07-25
+  - Improved is_readable performance in Mojo::Reactor.
+
+5.17  2014-07-24
+  - Welcome to the Mojolicious core team Jan Henning Thorsen.
+  - Added val method to Mojo::DOM. (batman, sri)
+  - Improved Mojo::Collection performance.
+  - Fixed support for Unicode anchors in Mojolicious::Plugin::PODRenderer.
+
 5.16  2014-07-21
   - Improved Mojo::Asset::File to allow appending data to existing files.
     (iakuf, sri)
@@ -4,7 +4,7 @@
       "Sebastian Riedel <sri@cpan.org>"
    ],
    "dynamic_config" : 1,
-   "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141520",
+   "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060",
    "license" : [
       "artistic_2"
    ],
@@ -33,6 +33,7 @@
       },
       "runtime" : {
          "requires" : {
+            "Pod::Simple" : "3.09",
             "perl" : "5.010001"
          }
       }
@@ -51,5 +52,5 @@
       },
       "x_MailingList" : "http://groups.google.com/group/mojolicious"
    },
-   "version" : "5.16"
+   "version" : "5.21"
 }
@@ -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.141520'
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060'
 license: artistic_2
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -19,6 +19,7 @@ no_index:
     - inc
     - t
 requires:
+  Pod::Simple: '3.09'
   perl: '5.010001'
 resources:
   MailingList: http://groups.google.com/group/mojolicious
@@ -26,4 +27,4 @@ resources:
   homepage: http://mojolicio.us
   license: http://www.opensource.org/licenses/artistic-license-2.0
   repository: http://github.com/kraih/mojo
-version: '5.16'
+version: '5.21'
@@ -5,6 +5,7 @@ use warnings;
 
 use ExtUtils::MakeMaker;
 
+# Pod::Simple 3.09 first shipped with Perl 5.11.2
 WriteMakefile(
   NAME         => 'Mojolicious',
   VERSION_FROM => 'lib/Mojolicious.pm',
@@ -22,6 +23,7 @@ WriteMakefile(
     },
     no_index => {directory => ['t']}
   },
+  PREREQ_PM => {'Pod::Simple' => '3.09'},
   EXE_FILES => ['script/hypnotoad', 'script/mojo', 'script/morbo'],
   test => {TESTS => 't/*.t t/*/*.t'}
 );
@@ -26,7 +26,7 @@ sub DESTROY { }
 sub c { __PACKAGE__->new(@_) }
 
 sub compact {
-  shift->grep(sub { length($_ // '') });
+  $_[0]->new(grep { defined $_ && (ref $_ || length $_) } @{$_[0]});
 }
 
 sub each {
@@ -70,7 +70,7 @@ sub new {
 
 sub pluck {
   my ($self, $method, @args) = @_;
-  return $self->map(sub { $_->$method(@args) });
+  return $self->new(map { $_->$method(@args) } @$self);
 }
 
 sub reverse { $_[0]->new(reverse @{$_[0]}) }
@@ -93,7 +93,7 @@ sub tap { shift->Mojo::Base::tap(@_) }
 
 sub uniq {
   my %seen;
-  return shift->grep(sub { !$seen{$_}++ });
+  return $_[0]->new(grep { !$seen{$_}++ } @{$_[0]});
 }
 
 sub _flatten {
@@ -176,6 +176,24 @@ sub type {
   return $self;
 }
 
+sub val {
+  my $self = shift;
+
+  # "option"
+  my $type = $self->type;
+  return Mojo::Collection->new($self->{value} // $self->text)
+    if $type eq 'option';
+
+  # "select"
+  return $self->find('option[selected]')->val->flatten if $type eq 'select';
+
+  # "textarea"
+  return Mojo::Collection->new($self->text) if $type eq 'textarea';
+
+  # "input" or "button"
+  return Mojo::Collection->new($self->{value} // ());
+}
+
 sub wrap         { shift->_wrap(0, @_) }
 sub wrap_content { shift->_wrap(1, @_) }
 
@@ -529,10 +547,10 @@ from L<Mojo::DOM::CSS/"SELECTORS"> are supported.
 
 =head2 attr
 
-  my $attrs = $dom->attr;
-  my $foo   = $dom->attr('foo');
-  $dom      = $dom->attr({foo => 'bar'});
-  $dom      = $dom->attr(foo => 'bar');
+  my $hash = $dom->attr;
+  my $foo  = $dom->attr('foo');
+  $dom     = $dom->attr({foo => 'bar'});
+  $dom     = $dom->attr(foo => 'bar');
 
 This element's attributes.
 
@@ -824,6 +842,24 @@ This element's type.
   # List types of child elements
   say $dom->children->type;
 
+=head2 val
+
+  my $collection = $dom->val;
+
+Extract values from C<button>, C<input>, C<option>, C<select> or C<textarea>
+element and return a L<Mojo::Collection> object containing these values. In
+the case of C<select>, find all C<option> elements it contains that have a
+C<selected> attribute and extract their values.
+
+  # "b"
+  $dom->parse('<input name="a" value="b">')->at('input')->val;
+
+  # "c"
+  $dom->parse('<option value="c">C</option>')->at('option')->val;
+
+  # "d"
+  $dom->parse('<option>d</option>')->at('option')->val;
+
 =head2 wrap
 
   $dom = $dom->wrap('<div></div>');
@@ -2,7 +2,7 @@ package Mojo::Reactor;
 use Mojo::Base 'Mojo::EventEmitter';
 
 use Carp 'croak';
-use IO::Poll qw(POLLERR POLLHUP POLLIN POLLPRI);
+use IO::Poll qw(POLLIN POLLPRI);
 use Mojo::Loader;
 
 sub again { croak 'Method "again" not implemented by subclass' }
@@ -14,16 +14,9 @@ sub detect {
 
 sub io { croak 'Method "io" not implemented by subclass' }
 
+# This may break at some point in the future, but is worth it for performance
 sub is_readable {
-  my ($self, $handle) = @_;
-
-  my $test = $self->{test} ||= IO::Poll->new;
-  $test->mask($handle, POLLIN | POLLPRI);
-  $test->poll(0);
-  my $result = $test->handles(POLLIN | POLLPRI | POLLERR | POLLHUP);
-  $test->remove($handle);
-
-  return !!$result;
+  !(IO::Poll::_poll(0, fileno(pop), my $dummy = POLLIN | POLLPRI) == 0);
 }
 
 sub is_running { croak 'Method "is_running" not implemented by subclass' }
@@ -58,22 +58,22 @@ L<Mojo::UserAgent::Proxy> implements the following attributes.
 
 =head2 http
 
-  my $http = $ua->http;
-  $ua      = $ua->http('http://sri:secret@127.0.0.1:8080');
+  my $http = $proxy->http;
+  $proxy   = $proxy->http('http://sri:secret@127.0.0.1:8080');
 
 Proxy server to use for HTTP and WebSocket requests.
 
 =head2 https
 
-  my $https = $ua->https;
-  $ua       = $ua->https('http://sri:secret@127.0.0.1:8080');
+  my $https = $proxy->https;
+  $proxy    = $proxy->https('http://sri:secret@127.0.0.1:8080');
 
 Proxy server to use for HTTPS and WebSocket requests.
 
 =head2 not
 
   my $not = $proxy->not;
-  $ua     = $proxy->not([qw(localhost intranet.mojolicio.us)]);
+  $proxy  = $proxy->not([qw(localhost intranet.mojolicio.us)]);
 
 Domains that don't require a proxy server to be used.
 
@@ -39,10 +39,7 @@ sub endpoint {
   return $proto, $host, $port;
 }
 
-sub peer {
-  my ($self, $tx) = @_;
-  return $self->_proxy($tx, $self->endpoint($tx));
-}
+sub peer { $_[0]->_proxy($_[1], $_[0]->endpoint($_[1])) }
 
 sub proxy_connect {
   my ($self, $old) = @_;
@@ -239,7 +239,7 @@ sub _finish {
   my ($self, $id, $close) = @_;
 
   # Remove request timeout
-  my $c = $self->{connections}{$id};
+  return unless my $c    = $self->{connections}{$id};
   return unless my $loop = $self->_loop($c->{nb});
   $loop->remove($c->{timeout}) if $c->{timeout};
 
@@ -6,7 +6,7 @@ use Mojo::ByteStream 'b';
 use Mojo::DOM;
 use Mojo::URL;
 use Mojo::Util qw(slurp unindent url_escape);
-use Pod::Simple::HTML;
+use Pod::Simple::XHTML 3.09;
 use Pod::Simple::Search;
 
 sub register {
@@ -35,19 +35,19 @@ sub register {
 }
 
 sub _html {
-  my ($self, $src) = @_;
+  my ($c, $src) = @_;
 
   # Rewrite links
   my $dom     = Mojo::DOM->new(_pod_to_html($src));
-  my $perldoc = $self->url_for('/perldoc/');
+  my $perldoc = $c->url_for('/perldoc/');
   for my $e ($dom->find('a[href]')->each) {
     my $attrs = $e->attr;
-    $attrs->{href} =~ s!%3A%3A!/!gi
-      if $attrs->{href} =~ s!^http://search\.cpan\.org/perldoc\?!$perldoc!;
+    $attrs->{href} =~ s!::!/!gi
+      if $attrs->{href} =~ s!^http://metacpan\.org/pod/!$perldoc!;
   }
 
   # Rewrite code blocks for syntax highlighting and correct indentation
-  for my $e ($dom->find('pre')->each) {
+  for my $e ($dom->find('pre > code')->each) {
     $e->content(my $str = unindent $e->content);
     next if $str =~ /^\s*(?:\$|Usage:)\s+/m || $str !~ /[\$\@\%]\w|-&gt;\w/m;
     my $attrs = $e->attr;
@@ -57,23 +57,15 @@ sub _html {
 
   # Rewrite headers
   my $toc = Mojo::URL->new->fragment('toc');
-  my (%anchors, @parts);
+  my @parts;
   for my $e ($dom->find('h1, h2, h3')->each) {
 
-    # Anchor and text
-    my $name = my $text = $e->all_text;
-    $name =~ s/\s+/_/g;
-    $name =~ s/[^\w\-]//g;
-    my $anchor = $name;
-    my $i      = 1;
-    $anchor = $name . $i++ while $anchors{$anchor}++;
-
-    # Rewrite
     push @parts, [] if $e->type eq 'h1' || !@parts;
-    my $link = Mojo::URL->new->fragment($anchor);
-    push @{$parts[-1]}, $text, $link;
-    my $permalink = $self->link_to('#' => $link, class => 'permalink');
-    $e->content($permalink . $self->link_to($text => $toc, id => $anchor));
+    my $anchor = $e->{id};
+    my $link   = Mojo::URL->new->fragment($anchor);
+    push @{$parts[-1]}, my $text = $e->all_text, $link;
+    my $permalink = $c->link_to('#' => $link, class => 'permalink');
+    $e->content($permalink . $c->link_to($text => $toc, id => $anchor));
   }
 
   # Try to find a title
@@ -81,39 +73,34 @@ sub _html {
   $dom->find('h1 + p')->first(sub { $title = shift->text });
 
   # Combine everything to a proper response
-  $self->content_for(perldoc => "$dom");
-  my $template = $self->app->renderer->_bundled('perldoc');
-  $self->render(inline => $template, title => $title, parts => \@parts);
+  $c->content_for(perldoc => "$dom");
+  my $template = $c->app->renderer->_bundled('perldoc');
+  $c->render(inline => $template, title => $title, parts => \@parts);
 }
 
 sub _perldoc {
-  my $self = shift;
+  my $c = shift;
 
   # Find module or redirect to CPAN
-  my $module = $self->param('module');
-  $module =~ s!/!::!g;
+  my $module = join '::', split '/', scalar $c->param('module');
   my $path
     = Pod::Simple::Search->new->find($module, map { $_, "$_/pods" } @INC);
-  return $self->redirect_to("http://metacpan.org/module/$module")
+  return $c->redirect_to("http://metacpan.org/pod/$module")
     unless $path && -r $path;
 
   my $src = slurp $path;
-  $self->respond_to(txt => {data => $src}, html => sub { _html($self, $src) });
+  $c->respond_to(txt => {data => $src}, html => sub { _html($c, $src) });
 }
 
 sub _pod_to_html {
   return '' unless defined(my $pod = ref $_[0] eq 'CODE' ? shift->() : shift);
 
-  my $parser = Pod::Simple::HTML->new;
-  $parser->$_('') for qw(force_title html_header_before_title);
-  $parser->$_('') for qw(html_header_after_title html_footer);
+  my $parser = Pod::Simple::XHTML->new;
+  $parser->perldoc_url_prefix('http://metacpan.org/pod/');
+  $parser->$_('') for qw(html_header html_footer);
   $parser->output_string(\(my $output));
   return $@ unless eval { $parser->parse_string_document("$pod"); 1 };
 
-  # Filter
-  $output =~ s!<a name='___top' class='dummyTopAnchor'\s*?></a>\n!!g;
-  $output =~ s!<a class='u'.*?name=".*?"\s*>(.*?)</a>!$1!sg;
-
   return $output;
 }
 
@@ -16,7 +16,7 @@
         line-height: 1.5em;
         margin: 0;
       }
-      code {
+      :not(pre) > code {
         background-color: rgba(0, 0, 0, 0.04);
         border-radius: 3px;
         font: 0.9em Consolas, Menlo, Monaco, Courier, monospace;
@@ -30,17 +30,23 @@
         position: relative;
       }
       h1 a, h2 a, h3 a { text-decoration: none }
+      li > p {
+        margin-bottom: 0;
+        margin-top: 0;
+      }
       pre {
         background: url(<%= url_for '/mojo/stripes.png' %>);
         border: 1px solid #d1d1d1;
         border-radius: 3px;
         box-shadow: 0 1px #fff, inset -1px 1px 4px rgba(0, 0, 0, 0.1);
-        color: #4d4d4c;
-        font: 0.9em Consolas, Menlo, Monaco, Courier, monospace;
-        line-height: 1.5em;
         padding: 1em;
         padding-bottom: 1.5em;
         padding-top: 1.5em;
+      }
+      pre, pre > code {
+        color: #4d4d4c;
+        font: 0.9em Consolas, Menlo, Monaco, Courier, monospace;
+        line-height: 1.5em;
         text-align: left;
         text-shadow: #eee 0 1px 0;
         white-space: pre-wrap;
@@ -43,7 +43,7 @@ has types     => sub { Mojolicious::Types->new };
 has validator => sub { Mojolicious::Validator->new };
 
 our $CODENAME = 'Tiger Face';
-our $VERSION  = '5.16';
+our $VERSION  = '5.21';
 
 sub AUTOLOAD {
   my $self = shift;
@@ -737,6 +737,8 @@ Abhijit Menon-Sen, C<ams@cpan.org>
 
 Glen Hinkle, C<tempire@cpan.org>
 
+Jan Henning Thorsen, C<jhthorsen@cpan.org>
+
 Joel Berger, C<jberger@cpan.org>
 
 Marcus Ramberg, C<mramberg@cpan.org>
@@ -853,8 +855,6 @@ Ilya Chesnokov
 
 James Duncan
 
-Jan Henning Thorsen
-
 Jan Jona Javorsek
 
 Jan Schmidt
@@ -2303,6 +2303,46 @@ is $dom->find('div > ul li')->[2], undef, 'no result';
 is $dom->find('div > ul ul')->[0]->text, 'C', 'right text';
 is $dom->find('div > ul ul')->[1], undef, 'no result';
 
+# Form values
+$dom = Mojo::DOM->new(<<EOF);
+<form action="/foo">
+  <p>Test</p>
+  <input type="text" name="a" value="A" />
+  <input type="checkbox" checked name="b" value="B">
+  <input type="radio" checked name="c" value="C">
+  <select name="f">
+    <option value="F">G</option>
+    <optgroup>
+      <option>H</option>
+      <option selected>I</option>
+    </optgroup>
+    <option value="J" selected>K</option>
+  </select>
+  <select name="n"><option>N</option></select>
+  <select name="d"><option selected>D</option></select>
+  <textarea name="m">M</textarea>
+  <button name="o" value="O">No!</button>
+  <input type="submit" name="p" value="P" />
+</form>
+EOF
+is_deeply [$dom->at('p')->val->each], [], 'no values';
+is $dom->at('input')->val->size, 1, 'one value';
+is $dom->at('input')->val,                     'A', 'right value';
+is $dom->at('input:checked')->val,             'B', 'right value';
+is $dom->at('input:checked[type=radio]')->val, 'C', 'right value';
+is $dom->find('select')->first->val->join(':'), 'I:J', 'right value';
+is_deeply [$dom->find('select')->first->val->each], ['I', 'J'], 'right values';
+is $dom->at('select option')->val->size, 1, 'one value';
+is $dom->at('select option')->val,                          'F', 'right value';
+is $dom->at('select optgroup option:not([selected])')->val, 'H', 'right value';
+is $dom->find('select')->[1]->val->size, 0, 'no values';
+is $dom->find('select')->[1]->at('option')->val, 'N', 'right value';
+is $dom->find('select')->last->val, 'D', 'right value';
+is $dom->at('textarea')->val->size, 1,   'one value';
+is $dom->at('textarea')->val, 'M', 'right value';
+is $dom->at('button')->val,   'O', 'right value';
+is $dom->find('form input')->last->val, 'P', 'right value';
+
 # Slash between attributes
 $dom = Mojo::DOM->new('<input /type=checkbox / value="/a/" checked/><br/>');
 is_deeply $dom->at('input')->attr,
@@ -31,17 +31,18 @@ my $t = Test::Mojo->new;
 
 # Simple POD template
 $t->get_ok('/')->status_is(200)
-  ->content_like(qr|<h1>Test123</h1>\s+<p>It <code>works</code>!</p>|);
+  ->content_like(qr!<h1 id="Test123">Test123</h1>!)
+  ->content_like(qr|<p>It <code>works</code>!</p>|);
 
 # POD helper
-$t->post_ok('/')->status_is(200)
-  ->content_like(qr!test123\s+<h1>A</h1>\s+<h1>B</h1>!)
+$t->post_ok('/')->status_is(200)->content_like(qr!test123<h1 id="A">A</h1>!)
+  ->content_like(qr!<h1 id="B">B</h1>!)
   ->content_like(qr!\s+<p><code>test</code></p>!)->content_like(qr/Gray/);
 
 # POD filter
 $t->post_ok('/block')->status_is(200)
-  ->content_like(qr!test321\s+<h2>lalala</h2>\s+<p><code>test</code></p>!)
-  ->content_like(qr/Gray/);
+  ->content_like(qr!test321<h2 id="lalala">lalala</h2>!)
+  ->content_like(qr!<p><code>test</code></p>!)->content_like(qr/Gray/);
 
 # Empty
 $t->get_ok('/empty')->status_is(200)->content_is('');
@@ -87,13 +87,13 @@ $t->get_ok('/advanced')->status_is(200)->header_is('X-Append' => 'bar')
   ->content_is("&LT;escape me>\n123423");
 
 # Normal "pod" template
-$t->get_ok('/docs')->status_is(200)->content_like(qr!<h3>snowman</h3>!);
+$t->get_ok('/docs')->status_is(200)->content_like(qr!<h3.*>snowman</h3>!);
 
 # Template in "teapod" format
-$t->get_ok('/docs2')->status_is(200)->content_like(qr!<h2>snowman</h2>!);
+$t->get_ok('/docs2')->status_is(200)->content_like(qr!<h2.*>snowman</h2>!);
 
 # Empty stash value
-$t->get_ok('/docs3')->status_is(200)->content_like(qr!<h3></h3>!);
+$t->get_ok('/docs3')->status_is(200)->content_like(qr!<h3.*></h3>!);
 
 # REST request for "foo" format
 $t->get_ok('/rest')->status_is(200)->header_is('X-Rest' => 1)