Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Parameterize the role to support using different tree classes

  • Loading branch information...
commit e1584676aa1e2284b873f12f5943ec3d8fad636e 1 parent d7a21ba
@ashb ashb authored
View
4 Makefile.PL
@@ -5,8 +5,10 @@ name 'WWW-Mechanize-TreeBuilder';
all_from 'lib/WWW/Mechanize/TreeBuilder.pm';
license 'perl';
-requires 'Moose' => '0.69';
+requires 'Moose' => '0.65';
requires 'HTML::TreeBuilder';
+requires 'Scalar::Util';
+requires 'MooseX::Role::Parameterized';
build_requires 'Test::More';
build:requires 'Test::WWW::Mechanize';
View
68 lib/WWW/Mechanize/TreeBuilder.pm
@@ -52,16 +52,63 @@ used (so that the existing behaviour of Mechanize doesn't break.)
=cut
-use Moose::Role;
-use HTML::TreeBuilder;
+use MooseX::Role::Parameterized;
+use Moose::Util::TypeConstraints;
+#use HTML::TreeBuilder;
-our $VERSION = '1.00003';
+subtype 'WWW.Mechanize.TreeBuilder.TreeClass'
+ => as 'ClassType',
+ => where { Class::MOP::load_class($_) && $_->isa('HTML::TreeBuilder') };
+
+subtype 'WWW.Mechanize.TreeBuilder.ElementClass'
+ => as 'ClassType',
+ => where { Class::MOP::load_class($_) && $_->isa('HTML::Element') };
+
+our $VERSION = '1.00004';
+
+parameter tree_class => (
+ isa => 'WWW.Mechanize.TreeBuilder.TreeClass',
+ required => 1,
+ default => 'HTML::TreeBuilder',
+);
+
+parameter element_class => (
+ isa => 'WWW.Mechanize.TreeBuilder.ElementClass',
+ lazy => 1,
+ default => 'HTML::Element',
+ predicate => 'has_element_class'
+);
+
+# Used if element_class is not provided to give sane defaults
+our %ELEMENT_CLASS_MAPPING = (
+ 'HTML::TreeBuilder' => 'HTML::Element',
+ # HTML::TreeBuilder::XPath does it wrong.
+ 'HTML::TreeBuilder::XPath' => 'HTML::TreeBuilder::XPath::Node'
+);
+
+role {
+ my $p = shift;
+
+ my $tree_class = $p->tree_class;
+ my $ele_class;
+ unless ($p->has_element_class) {
+ $ele_class = $ELEMENT_CLASS_MAPPING{$tree_class};
+
+ if (!defined( $ele_class ) ) {
+ local $Carp::Internal{'MooseX::Role::Parameterized::Meta::Role::Parameterizable'} = 1;
+ Carp::carp "WWW::Mechanize::TreeBuilder element_class not specified for overridden tree_class of $tree_class";
+ $ele_class = "HTML::Element";
+ }
+
+ } else {
+ $ele_class = $p->element_class;
+ }
requires '_make_request';
has 'tree' => (
is => 'ro',
- isa => 'HTML::Element',
+ isa => $ele_class,
writer => '_set_tree',
predicate => 'has_tree',
clearer => 'clear_tree',
@@ -72,15 +119,16 @@ has 'tree' => (
# take all subs from the symbol table that dont start with a _
handles => sub {
my ($attr, $delegate_class) = @_;
+ #$delegate_class = Moose::Meta::Class->initialize($p->tree_class);
$DB::single = 1;
my %methods = map { $_->name => 1
- } $attr->associated_class->get_all_methods,
- $attr->associated_class->get_all_attributes;
+ } $attr->associated_class->get_all_methods;
return
map { $_->name => $_->name }
- grep { my $n = $_->name; $n !~ /^_/ && !$methods{$n} } $delegate_class->get_all_methods;
+ grep { my $n = $_->name; $n !~ /^_/ && !$methods{$n} }
+ $delegate_class->get_all_methods;
}
);
@@ -96,7 +144,7 @@ around '_make_request' => sub {
}
if ($ret->content_type =~ m[^(text/html|application/(?:.*?\+)xml)]) {
- $self->_set_tree( HTML::TreeBuilder->new_from_content($ret->decoded_content)->elementify );
+ $self->_set_tree( $tree_class->new_from_content($ret->decoded_content)->elementify );
}
return $ret;
@@ -107,6 +155,10 @@ sub DEMOLISH {
$self->tree->delete if $self->has_tree;
}
+};
+
+no MooseX::Role::Parameterized;
+
=head1 AUTHOR
Ash Berlin C<< <ash@cpan.org> >>
View
3  t/01-basic.t
@@ -13,7 +13,7 @@ BEGIN {
my $mech = MockMechanize->new;
-WWW::Mechanize::TreeBuilder->meta->apply($mech);
+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');
@@ -32,7 +32,6 @@ $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");
View
33 t/02-parameterize.t
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../t/lib";
+
+use Test::More tests => 9;
+
+BEGIN {
+ use_ok 'WWW::Mechanize::TreeBuilder';
+ use_ok 'MockMechanize';
+};
+
+my $mech = MockMechanize->new;
+
+WWW::Mechanize::TreeBuilder->meta->apply(
+ $mech,
+ tree_class => 'MockTreeBuilder'
+);
+
+can_ok($mech, "some_other_method" );
+$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, 'MockTreeBuilderEle');
+is($mech->some_other_method, "I exist in MockTreeBuilderEle", "Delegated to subclass ok" );
+
+is($mech->look_down(_tag => 'p')->as_trimmed_text, 'A para', "Got the right <p> out");
+
View
23 t/lib/MockTreeBuilder.pm
@@ -0,0 +1,23 @@
+package #
+ MockTreeBuilder;
+
+use base 'HTML::TreeBuilder';
+
+sub new {
+ my $self = shift->SUPER::new(@_);
+ $self->{_element_class} = 'MockTreeBuilderEle';
+ return $self;
+}
+
+$WWW::Mechanize::TreeBuilder::ELEMENT_CLASS_MAPPING{"@{[__PACKAGE__]}"} = 'MockTreeBuilderEle';
+
+package #
+ MockTreeBuilderEle;
+
+use base 'HTML::Element';
+
+sub some_other_method { "I exist in " . Scalar::Util::blessed($_[0]) };
+
+
+
+1;
Please sign in to comment.
Something went wrong with that request. Please try again.