[Catalyst-commits] r9307 - in trunk/WWW-Mechanize-TreeBuilder: . lib/WWW/Mechanize t

[ash at dev.catalyst.perl.org]

Author: ash
Date: 2009-02-14 23:26:58 +0000 (Sat, 14 Feb 2009)
New Revision: 9307

Added:
   trunk/WWW-Mechanize-TreeBuilder/Changes
Modified:
   trunk/WWW-Mechanize-TreeBuilder/Makefile.PL
   trunk/WWW-Mechanize-TreeBuilder/lib/WWW/Mechanize/TreeBuilder.pm
   trunk/WWW-Mechanize-TreeBuilder/t/01-basic.t
Log:
Fix delegation of methods

Added: trunk/WWW-Mechanize-TreeBuilder/Changes
===================================================================
--- trunk/WWW-Mechanize-TreeBuilder/Changes	                        (rev 0)
+++ trunk/WWW-Mechanize-TreeBuilder/Changes	2009-02-14 23:26:58 UTC (rev 9307)
@@ -0,0 +1,20 @@
+Changelog for WWW::Mechanize::TreeBuilder
+
+1.00004 - 2009 Feb 14
+  - Fix delegation with latest Mooses (something seems to have changed along
+    the way) and add tests to it
+  - Bump Moose dep to 0.69 to be on the safe side
+
+1.00003 - 2008 Jan 14
+  - Fix delegation of 'clone' and other methods that already exist on Mechanize
+
+1.00002 - 2007 Sep 6
+  - Fix Makefile.PL so that HTML::TreeBuilder is a dependancy, not just 
+    recomended - oops.
+
+1.00001 - 2007 Sep 5
+  - I can't count - fix test count.
+
+1.00000 - 2007 Sep 4
+  - Initial Release
+

Modified: trunk/WWW-Mechanize-TreeBuilder/Makefile.PL
===================================================================
--- trunk/WWW-Mechanize-TreeBuilder/Makefile.PL	2009-02-14 23:09:02 UTC (rev 9306)
+++ trunk/WWW-Mechanize-TreeBuilder/Makefile.PL	2009-02-14 23:26:58 UTC (rev 9307)
@@ -1,15 +1,15 @@
 use inc::Module::Install;
 
+perl_version    '5.008001';
 name            'WWW-Mechanize-TreeBuilder';
 all_from        'lib/WWW/Mechanize/TreeBuilder.pm';
 license         'perl';
 
-requires        'perl'                           => 5.006000;
-requires        'Moose';
+requires        'Moose'                          => '0.69';
 requires        'HTML::TreeBuilder';
 
 build_requires  'Test::More';
-requires        'Test::WWW::Mechanize';
+build:requires  'Test::WWW::Mechanize';
 
 no_index        directory => 't/lib';
 

Modified: trunk/WWW-Mechanize-TreeBuilder/lib/WWW/Mechanize/TreeBuilder.pm
===================================================================
--- trunk/WWW-Mechanize-TreeBuilder/lib/WWW/Mechanize/TreeBuilder.pm	2009-02-14 23:09:02 UTC (rev 9306)
+++ trunk/WWW-Mechanize-TreeBuilder/lib/WWW/Mechanize/TreeBuilder.pm	2009-02-14 23:26:58 UTC (rev 9307)
@@ -72,11 +72,16 @@
   # want it to handle myself here. how annoying. But since I'm lazy, I'll just
   # take all subs from the symbol table that dont start with a _
   handles => sub {
-    my ($class, $delegate_class) = @_;
+    my ($attr, $delegate_class) = @_;
 
+    $DB::single = 1;
+    my %methods = map { $_->name => 1 
+      } $attr->associated_class->get_all_methods,
+        $attr->associated_class->get_all_attributes;
+
     return 
-      map  { $_ => $_ }
-      grep { !/^_/ && !$class->can($_) } $delegate_class->list_all_package_symbols('CODE'); 
+      map  { $_->name => $_->name }
+      grep { my $n = $_->name; $n !~ /^_/ && !$methods{$n} } $delegate_class->get_all_methods; 
   }
 );
 

Modified: trunk/WWW-Mechanize-TreeBuilder/t/01-basic.t
===================================================================
--- trunk/WWW-Mechanize-TreeBuilder/t/01-basic.t	2009-02-14 23:09:02 UTC (rev 9306)
+++ trunk/WWW-Mechanize-TreeBuilder/t/01-basic.t	2009-02-14 23:26:58 UTC (rev 9307)
@@ -4,7 +4,7 @@
 use FindBin;
 use lib "$FindBin::Bin/../t/lib";
 
-use Test::More tests => 12;
+use Test::More tests => 14;
 
 BEGIN { 
   use_ok 'WWW::Mechanize::TreeBuilder';
@@ -15,10 +15,24 @@
 
 WWW::Mechanize::TreeBuilder->meta->apply($mech);
 
+# Check that the clone come from WWW::Mech, not HTML::TreeBuilder
+my @meths = $mech->meta->find_all_methods_by_name('clone');
+
+is( 
+  grep( { $_->{code}{delegate_to_method} }  $mech->meta->find_all_methods_by_name('clone')),
+  0,
+  "clone not delegated to tree"
+);
+
 $mech->get_ok('/', 'Request ok');
 
+# Check we can use normal TWMC methods
+$mech->content_contains('A para');
+
 ok($mech->has_tree, 'We have a HTML tree');
 
+
+
 isa_ok($mech->tree, 'HTML::Element');
 
 is($mech->look_down(_tag => 'p')->as_trimmed_text, 'A para', "Got the right <p> out");