added pluck method to Mojo::Collection

mojolicious · Jul 3, 2012 · 71031e5 · 71031e5
1 parent 40aa2e1
commit 71031e5
Show file tree

Hide file tree

Showing 10 changed files with 156 additions and 137 deletions.
diff --git a/Changes b/Changes
@@ -1,5 +1,6 @@
 
 3.02  2012-07-03
+  - Added pluck method to Mojo::Collection.
   - Added regular expression support to first and grep methods in
     Mojo::Collection.
   - Improved documentation.

diff --git a/lib/Mojo/Collection.pm b/lib/Mojo/Collection.pm
@@ -49,6 +49,11 @@ sub map {
   return $self->new(map { $_->$cb } @$self);
 }
 
+sub pluck {
+  my ($self, $method, @args) = @_;
+  return $self->map(sub { $_->$method(@args) });
+}
+
 sub reverse {
   my $self = shift;
   return $self->new(reverse @$self);
@@ -169,6 +174,14 @@ from the results.
 
   my $doubled = $collection->map(sub { $_ * 2 });
 
+=head2 C<pluck>
+
+  my $new = $collection->pluck($method);
+  my $new = $collection->pluck($method, @args);
+
+Call method on each element in collection and create a new collection from the
+results.
+
 =head2 C<reverse>
 
   my $new = $collection->reverse;

diff --git a/lib/Mojo/DOM/CSS.pm b/lib/Mojo/DOM/CSS.pm
@@ -133,7 +133,7 @@ sub _compile {
 
     # Empty combinator
     push @$part, [combinator => ' ']
-      if $part->[-1] && $part->[-1]->[0] ne 'combinator';
+      if $part->[-1] && $part->[-1][0] ne 'combinator';
 
     # Selector
     push @$part, ['element'];
@@ -161,7 +161,7 @@ sub _compile {
 
       # "not"
       if ($1 eq 'not') {
-        my $subpattern = $self->_compile($2)->[-1]->[-1];
+        my $subpattern = $self->_compile($2)->[-1][-1];
         push @$selector, ['pc', 'not', $subpattern];
       }
 

diff --git a/lib/Mojo/Exception.pm b/lib/Mojo/Exception.pm
@@ -55,7 +55,7 @@ sub _context {
   my ($self, $line, $lines) = @_;
 
   # Wrong file
-  return unless defined $lines->[0]->[$line - 1];
+  return unless defined $lines->[0][$line - 1];
 
   # Line
   $self->line([$line]);
@@ -67,7 +67,7 @@ sub _context {
   # Before
   for my $i (2 .. 6) {
     last if ((my $previous = $line - $i) < 0);
-    if (defined($lines->[0]->[$previous])) {
+    if (defined($lines->[0][$previous])) {
       unshift @{$self->lines_before}, [$previous + 1];
       for my $l (@$lines) {
         chomp(my $code = $l->[$previous]);
@@ -79,7 +79,7 @@ sub _context {
   # After
   for my $i (0 .. 4) {
     next if ((my $next = $line + $i) < 0);
-    if (defined($lines->[0]->[$next])) {
+    if (defined($lines->[0][$next])) {
       push @{$self->lines_after}, [$next + 1];
       for my $l (@$lines) {
         next unless defined(my $code = $l->[$next]);
@@ -125,7 +125,7 @@ sub _detect {
     my $filter = sub {
       my $num  = shift;
       my $new  = "$name line $num";
-      my $line = $lines[0]->[$num];
+      my $line = $lines[0][$num];
       return defined $line ? qq{$new, near "$line".} : "$new.";
     };
     $message =~ s/\(eval\s+\d+\) line (\d+).*/$filter->($1)/ge;

diff --git a/lib/Mojolicious/Routes/Pattern.pm b/lib/Mojolicious/Routes/Pattern.pm
@@ -219,7 +219,7 @@ sub _tokenize {
     # Relaxed or wildcard start (upgrade when quoted)
     elsif ($char ~~ [$relaxed, $wildcard]) {
       push @tree, ['placeholder', ''] unless $quoted;
-      $tree[-1]->[0] = $state = $char eq $relaxed ? 'relaxed' : 'wildcard';
+      $tree[-1][0] = $state = $char eq $relaxed ? 'relaxed' : 'wildcard';
     }
 
     # Quote end
@@ -235,17 +235,17 @@ sub _tokenize {
     }
 
     # Placeholder, relaxed or wildcard
-    elsif ($inside && $char =~ /\w/) { $tree[-1]->[-1] .= $char }
+    elsif ($inside && $char =~ /\w/) { $tree[-1][-1] .= $char }
 
     # Text
     else {
       $state = 'text';
 
       # New text element
-      push @tree, ['text', $char] and next unless $tree[-1]->[0] eq 'text';
+      push @tree, ['text', $char] and next unless $tree[-1][0] eq 'text';
 
       # More text
-      $tree[-1]->[-1] .= $char;
+      $tree[-1][-1] .= $char;
     }
   }
 

diff --git a/lib/ojo.pm b/lib/ojo.pm
@@ -141,6 +141,8 @@ resulting L<Mojo::Message::Response> object.
 Perform C<GET> request with L<Mojo::UserAgent/"get"> and return resulting
 L<Mojo::Message::Response> object.
 
+  $ perl -Mojo -E 'say g("mojolicio.us")->dom("h1, h2, h3")->pluck("text")'
+
 =head2 C<h>
 
   my $res = h('mojolicio.us');

diff --git a/t/mojo/collection.t b/t/mojo/collection.t
@@ -1,6 +1,6 @@
 use Mojo::Base -strict;
 
-use Test::More tests => 53;
+use Test::More tests => 55;
 
 # "'What are you lookin at?' - the innocent words of a drunken child."
 use Mojo::Collection 'c';
@@ -114,3 +114,8 @@ is_deeply [$collection->slice(-3, -5)->each], [10, 6], 'right result';
 is_deeply [$collection->slice(1, 2, 3)->each], [2, 3, 4], 'right result';
 is_deeply [$collection->slice(6, 1, 4)->each], [7, 2, 5], 'right result';
 is_deeply [$collection->slice(6 .. 9)->each], [7, 10, 9, 8], 'right result';
+
+# pluck
+$collection = c(c(1, 2, 3), c(4, 5, 6), c(7, 8, 9));
+is $collection->pluck('reverse'), "3\n2\n1\n6\n5\n4\n9\n8\n7", 'right result';
+is $collection->pluck(join => '-'), "1-2-3\n4-5-6\n7-8-9", 'right result';
diff --git a/t/mojo/dom.t b/t/mojo/dom.t
@@ -29,31 +29,30 @@ $dom = Mojo::DOM->new->parse(<<EOF);
 <foo><bar a="b&lt;c">ju<baz a23>s<bazz />t</bar>works</foo>
 EOF
 is $dom->tree->[0], 'root', 'right element';
-is $dom->tree->[1]->[0], 'tag', 'right element';
-is $dom->tree->[1]->[1], 'foo', 'right tag';
-is_deeply $dom->tree->[1]->[2], {}, 'empty attributes';
-is $dom->tree->[1]->[3], $dom->tree, 'right parent';
-is $dom->tree->[1]->[4]->[0], 'tag', 'right element';
-is $dom->tree->[1]->[4]->[1], 'bar', 'right tag';
-is_deeply $dom->tree->[1]->[4]->[2], {a => 'b<c'}, 'right attributes';
-is $dom->tree->[1]->[4]->[3], $dom->tree->[1], 'right parent';
-is $dom->tree->[1]->[4]->[4]->[0], 'text', 'right element';
-is $dom->tree->[1]->[4]->[4]->[1], 'ju',   'right text';
-is $dom->tree->[1]->[4]->[5]->[0], 'tag',  'right element';
-is $dom->tree->[1]->[4]->[5]->[1], 'baz',  'right tag';
-is_deeply $dom->tree->[1]->[4]->[5]->[2], {a23 => undef}, 'right attributes';
-is $dom->tree->[1]->[4]->[5]->[3], $dom->tree->[1]->[4], 'right parent';
-is $dom->tree->[1]->[4]->[5]->[4]->[0], 'text', 'right element';
-is $dom->tree->[1]->[4]->[5]->[4]->[1], 's',    'right text';
-is $dom->tree->[1]->[4]->[5]->[5]->[0], 'tag',  'right element';
-is $dom->tree->[1]->[4]->[5]->[5]->[1], 'bazz', 'right tag';
-is_deeply $dom->tree->[1]->[4]->[5]->[5]->[2], {}, 'empty attributes';
-is $dom->tree->[1]->[4]->[5]->[5]->[3], $dom->tree->[1]->[4]->[5],
-  'right parent';
-is $dom->tree->[1]->[4]->[5]->[6]->[0], 'text', 'right element';
-is $dom->tree->[1]->[4]->[5]->[6]->[1], 't',    'right text';
-is $dom->tree->[1]->[5]->[0], 'text',  'right element';
-is $dom->tree->[1]->[5]->[1], 'works', 'right text';
+is $dom->tree->[1][0], 'tag', 'right element';
+is $dom->tree->[1][1], 'foo', 'right tag';
+is_deeply $dom->tree->[1][2], {}, 'empty attributes';
+is $dom->tree->[1][3], $dom->tree, 'right parent';
+is $dom->tree->[1][4][0], 'tag', 'right element';
+is $dom->tree->[1][4][1], 'bar', 'right tag';
+is_deeply $dom->tree->[1][4][2], {a => 'b<c'}, 'right attributes';
+is $dom->tree->[1][4][3], $dom->tree->[1], 'right parent';
+is $dom->tree->[1][4][4][0], 'text', 'right element';
+is $dom->tree->[1][4][4][1], 'ju',   'right text';
+is $dom->tree->[1][4][5][0], 'tag',  'right element';
+is $dom->tree->[1][4][5][1], 'baz',  'right tag';
+is_deeply $dom->tree->[1][4][5][2], {a23 => undef}, 'right attributes';
+is $dom->tree->[1][4][5][3], $dom->tree->[1][4], 'right parent';
+is $dom->tree->[1][4][5][4][0], 'text', 'right element';
+is $dom->tree->[1][4][5][4][1], 's',    'right text';
+is $dom->tree->[1][4][5][5][0], 'tag',  'right element';
+is $dom->tree->[1][4][5][5][1], 'bazz', 'right tag';
+is_deeply $dom->tree->[1][4][5][5][2], {}, 'empty attributes';
+is $dom->tree->[1][4][5][5][3], $dom->tree->[1][4][5], 'right parent';
+is $dom->tree->[1][4][5][6][0], 'text', 'right element';
+is $dom->tree->[1][4][5][6][1], 't',    'right text';
+is $dom->tree->[1][5][0], 'text',  'right element';
+is $dom->tree->[1][5][1], 'works', 'right text';
 is "$dom", <<EOF, 'right result';
 <foo><bar a="b&lt;c">ju<baz a23>s<bazz></bazz>t</baz></bar>works</foo>
 EOF
@@ -91,8 +90,8 @@ $dom = Mojo::DOM->new->parse(<<EOF);
 </foo>
 EOF
 is $dom->xml, undef, 'xml mode not detected';
-is $dom->tree->[1]->[0], 'doctype', 'right element';
-is $dom->tree->[1]->[1], ' foo',    'right doctype';
+is $dom->tree->[1][0], 'doctype', 'right element';
+is $dom->tree->[1][1], ' foo',    'right doctype';
 is "$dom", <<EOF, 'right result';
 <!DOCTYPE foo>
 <foo bar="ba&lt;z">
@@ -1444,7 +1443,7 @@ $dom = Mojo::DOM->new->parse(<<EOF);
 EOF
 is $dom->xml, 1, 'xml mode detected';
 is $dom->at('root')->attrs('att'), 'test', 'right attribute';
-is $dom->tree->[5]->[1], ' root [
+is $dom->tree->[5][1], ' root [
   <!ELEMENT root (#PCDATA)>
   <!ATTLIST root att CDATA #REQUIRED>
 ]', 'right doctype';
@@ -1457,7 +1456,7 @@ SYSTEM "usr.dtd"
 ]>
 <foo />
 EOF
-is $dom->tree->[1]->[1], ' book
+is $dom->tree->[1][1], ' book
 SYSTEM "usr.dtd"
 [
   <!ENTITY test "yeah">
@@ -1475,7 +1474,7 @@ $dom = Mojo::DOM->new->parse(<<EOF);
 <foo xml:lang="de">Check!</fOo>
 EOF
 is $dom->xml, 1, 'xml mode detected';
-is $dom->tree->[3]->[1], ' foo [
+is $dom->tree->[3][1], ' foo [
   <!ELEMENT foo ANY>
   <!ATTLIST foo xml:lang CDATA #IMPLIED>
   <!ENTITY % e SYSTEM "myentities.ent">
@@ -1495,7 +1494,7 @@ $dom = Mojo::DOM->new->parse(<<EOF);
 <?check for-nothing?>
 <foo bar='false'>&leertaste;!!!</foo>
 EOF
-is $dom->tree->[1]->[1], ' TESTSUITE PUBLIC "my.dtd" \'mhhh\' [
+is $dom->tree->[1][1], ' TESTSUITE PUBLIC "my.dtd" \'mhhh\' [
   <!ELEMENT foo ANY>
   <!ATTLIST foo bar ENTITY \'true\'>
   <!ENTITY system_entities SYSTEM \'systems.xml\'>
@@ -2058,15 +2057,15 @@ $dom = Mojo::DOM->new->parse(<<EOF);
 <bar>after</bar>
 EOF
 is $dom->tree->[0], 'root', 'right element';
-is $dom->tree->[1]->[0], 'tag', 'right element';
-is $dom->tree->[1]->[1], 'foo', 'right tag';
-is_deeply $dom->tree->[1]->[2], {bar => ''}, 'right attributes';
-is $dom->tree->[1]->[4]->[0], 'text',       'right element';
-is $dom->tree->[1]->[4]->[1], "\n  test\n", 'right text';
-is $dom->tree->[3]->[0], 'tag', 'right element';
-is $dom->tree->[3]->[1], 'bar', 'right tag';
-is $dom->tree->[3]->[4]->[0], 'text',  'right element';
-is $dom->tree->[3]->[4]->[1], 'after', 'right text';
+is $dom->tree->[1][0], 'tag', 'right element';
+is $dom->tree->[1][1], 'foo', 'right tag';
+is_deeply $dom->tree->[1][2], {bar => ''}, 'right attributes';
+is $dom->tree->[1][4][0], 'text',       'right element';
+is $dom->tree->[1][4][1], "\n  test\n", 'right text';
+is $dom->tree->[3][0], 'tag', 'right element';
+is $dom->tree->[3][1], 'bar', 'right tag';
+is $dom->tree->[3][4][0], 'text',  'right element';
+is $dom->tree->[3][4][1], 'after', 'right text';
 is "$dom", <<EOF, 'right result';
 <foo bar="">
   test

diff --git a/t/mojo/loader.t b/t/mojo/loader.t
@@ -21,16 +21,16 @@ ok !!UNIVERSAL::can(B => 'svref_2object');
 my $e = $loader->load('LoaderException');
 isa_ok $e, 'Mojo::Exception', 'right object';
 like $e->message, qr/Missing right curly/, 'right message';
-is $e->lines_before->[0]->[0],   5,         'right line';
-like $e->lines_before->[0]->[1], qr/Apu/,   'right value';
-is $e->lines_before->[1]->[0],   6,         'right line';
-like $e->lines_before->[1]->[1], qr/whizz/, 'right value';
-is $e->lines_before->[2]->[0],   7,         'right line';
-is $e->lines_before->[2]->[1],   '',        'right value';
-is $e->lines_before->[3]->[0],   8,         'right line';
-is $e->lines_before->[3]->[1],   'foo {',   'right value';
-is $e->lines_before->[4]->[0],   9,         'right line';
-is $e->lines_before->[4]->[1],   '',        'right value';
+is $e->lines_before->[0][0],   5,         'right line';
+like $e->lines_before->[0][1], qr/Apu/,   'right value';
+is $e->lines_before->[1][0],   6,         'right line';
+like $e->lines_before->[1][1], qr/whizz/, 'right value';
+is $e->lines_before->[2][0],   7,         'right line';
+is $e->lines_before->[2][1],   '',        'right value';
+is $e->lines_before->[3][0],   8,         'right line';
+is $e->lines_before->[3][1],   'foo {',   'right value';
+is $e->lines_before->[4][0],   9,         'right line';
+is $e->lines_before->[4][1],   '',        'right value';
 is $e->line->[0], 10,   'right line';
 is $e->line->[1], "1;", 'right value';
 like "$e", qr/Missing right curly/, 'right message';
@@ -40,18 +40,18 @@ $loader = Mojo::Loader->new;
 $e      = $loader->load('LoaderException2');
 isa_ok $e, 'Mojo::Exception', 'right object';
 like $e->message, qr/Exception/, 'right message';
-is $e->lines_before->[0]->[0], 1,                           'right line';
-is $e->lines_before->[0]->[1], 'package LoaderException2;', 'right value';
-is $e->lines_before->[1]->[0], 2,                           'right line';
-is $e->lines_before->[1]->[1], 'use Mojo::Base -strict;',   'right value';
-is $e->lines_before->[2]->[0], 3,                           'right line';
-is $e->lines_before->[2]->[1], '',                          'right value';
+is $e->lines_before->[0][0], 1,                           'right line';
+is $e->lines_before->[0][1], 'package LoaderException2;', 'right value';
+is $e->lines_before->[1][0], 2,                           'right line';
+is $e->lines_before->[1][1], 'use Mojo::Base -strict;',   'right value';
+is $e->lines_before->[2][0], 3,                           'right line';
+is $e->lines_before->[2][1], '',                          'right value';
 is $e->line->[0], 4, 'right line';
 is $e->line->[1], 'LoaderException2_2::throw_error();', 'right value';
-is $e->lines_after->[0]->[0], 5,    'right line';
-is $e->lines_after->[0]->[1], '',   'right value';
-is $e->lines_after->[1]->[0], 6,    'right line';
-is $e->lines_after->[1]->[1], '1;', 'right value';
+is $e->lines_after->[0][0], 5,    'right line';
+is $e->lines_after->[0][1], '',   'right value';
+is $e->lines_after->[1][0], 6,    'right line';
+is $e->lines_after->[1][1], '1;', 'right value';
 like "$e", qr/Exception/, 'right message';
 
 $loader = Mojo::Loader->new;