[Catalyst-commits] r6833 - in trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder: lib/Test/WWW/Mechanize/Catalyst t t/lib/TestApp/Controller

[ash at dev.catalyst.perl.org]

Author: ash
Date: 2007-09-04 12:57:08 +0100 (Tue, 04 Sep 2007)
New Revision: 6833

Modified:
   trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/lib/Test/WWW/Mechanize/Catalyst/TreeBuilder.pm
   trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/01-basic.t
   trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/lib/TestApp/Controller/Root.pm
Log:
Make it a role that needs to be applied

Modified: trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/lib/Test/WWW/Mechanize/Catalyst/TreeBuilder.pm
===================================================================
--- trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/lib/Test/WWW/Mechanize/Catalyst/TreeBuilder.pm	2007-09-03 19:45:39 UTC (rev 6832)
+++ trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/lib/Test/WWW/Mechanize/Catalyst/TreeBuilder.pm	2007-09-04 11:57:08 UTC (rev 6833)
@@ -7,29 +7,66 @@
 =head1 SYNOPSIS
 
  use Test::More tests => 2;
- use Test::WWW::Mechanize::Catalyst::TreeBuilder 'MyApp';
+ use Test::WWW::Mechanize::Catalyst 'MyApp';
 
- my $mech = Test::WWW::Mechanize::Catalyst::TreeBuilder->new;
+ my $mech = Test::WWW::Mechanize::Catalyst->new;
+ WWW::Mechanize::TreeBuilder->meta->apply($mech);
 
  $mech->get_ok('/');
  ok( $mech->look_down(_tag => 'p')->as_trimmed_text, 'Some text', 'It worked' );
 
+=head1 DESCRIPTION
+
+This module combines WWW::Mechanize and HTML::TreeBuilder. Why? Because I've 
+seen too much code like the following:
+
+ like($mech->content, qr/<p>some text</p>/, "Found the right tag");
+
+Which is just all flavours of wrong. Instead, do it like the following:
+
+ ok($mech->look_down(_tag => 'p', sub { $_[0]->as_trimmed_text eq 'some text' })
+
+The anon-sub there is a bit icky, but this means that if the p tag should 
+happen to add attributes to the C<< <p> >> tag (such as an id or a class) it
+will still work and find the right tag.
+
+All of the methods avaiable on L<HTML::Element> (that aren't 'private' - i.e. 
+everything that doesn't begind with an underscore) such as C<look_down> or 
+C<find> are automatically delegated to C<< $mech->tree >> through the magic of
+Moose.
+
+=head1 METHODS
+
+Everything in L<WWW::Mechanize> (or which ever sub class you apply it to) and
+all public methods from L<HTML::Element>.
+
 =cut
 
-use Moose;
+use Moose::Role;
 use HTML::TreeBuilder;
 
 our $VERSION = 1.00000;
 
-extends 'Test::WWW::Mechanize::Catalyst';
+requires '_make_request';
 
 has 'tree' => ( 
-  is => 'ro', 
-  isa => 'HTML::Element',
-  writer => '_set_tree',
-  lazy => 1,
-  default => sub { new HTML::TreeBuilder },
-  handles => [ qw/look_down find/ ],
+  is        => 'ro', 
+  isa       => 'HTML::Element',
+  writer    => '_set_tree',
+  predicate => 'has_tree',
+  clearer   => 'clear_tree',
+  default   => undef,
+
+  # Since HTML::Element isn't a moose object, i have to 'list' everything I 
+  # 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) = @_;
+
+    return 
+      map  { $_ => $_ }
+      grep { !/^_/ } $delegate_class->list_all_package_symbols('CODE'); 
+  }
 );
 
 around '_make_request' => sub {
@@ -38,9 +75,12 @@
   my $ret  = $self->$orig(@_);
 
   # Someone needs to learn about weak refs
-  $self->tree->delete if $self->tree;
- 
-  if ($ret->header('content-type') =~ m[^(text/html|application/(?:.*?\+)xml)]) {
+  if ($self->has_tree) {
+    $self->tree->delete;
+    $self->clear_tree;
+  }
+
+  if ($ret->content_type =~ m[^(text/html|application/(?:.*?\+)xml)]) {
     $self->_set_tree( HTML::TreeBuilder->new_from_content($ret->decoded_content)->elementify );
   } 
   
@@ -49,8 +89,7 @@
 
 sub DEMOLISH {
   my $self = shift;
-  warn "DEMOLISH\n";
-  $self->tree->delete if $self->tree;
+  $self->tree->delete if $self->has_tree;
 }
 
 =head1 AUTHOR

Modified: trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/01-basic.t
===================================================================
--- trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/01-basic.t	2007-09-03 19:45:39 UTC (rev 6832)
+++ trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/01-basic.t	2007-09-04 11:57:08 UTC (rev 6833)
@@ -3,14 +3,27 @@
 
 use FindBin;
 use lib "$FindBin::Bin/../t/lib";
-use Test::More tests => 4;
 
-BEGIN { use_ok 'Test::WWW::Mechanize::Catalyst::TreeBuilder', 'TestApp'; }
+use Test::More tests => 8;
 
-my $mech = Test::WWW::Mechanize::Catalyst::TreeBuilder->new;
+BEGIN { use_ok 'Test::WWW::Mechanize::Catalyst::TreeBuilder' };
+use Test::WWW::Mechanize::Catalyst 'TestApp';
 
-$mech->get_ok('/');
+my $mech = Test::WWW::Mechanize::Catalyst->new;
 
+Test::WWW::Mechanize::Catalyst::TreeBuilder->meta->apply($mech);
+
+$mech->get_ok('/', 'Request ok');
+
 isa_ok($mech->tree, 'HTML::Element');
 
-is($mech->look_down(_tag => 'p')->as_trimmed_text, 'A para');
+ok($mech->has_tree, 'We have a HTML tree');
+
+is($mech->look_down(_tag => 'p')->as_trimmed_text, 'A para', "Got the right <p> out");
+
+isa_ok($mech->find('h1'), 'HTML::Element', 'Can find an H1 tag');
+
+$mech->get_ok('/plain', "Request plain text resource");
+
+ok( !$mech->has_tree, "Plain text content-type has no tree");
+

Modified: trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/lib/TestApp/Controller/Root.pm
===================================================================
--- trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/lib/TestApp/Controller/Root.pm	2007-09-03 19:45:39 UTC (rev 6832)
+++ trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/lib/TestApp/Controller/Root.pm	2007-09-04 11:57:08 UTC (rev 6833)
@@ -24,4 +24,8 @@
 EOF
 }
 
+sub plain : Local {
+  $_[1]->res->body("I'm plain text");
+}
+
 1;