[Catalyst-commits] r6834 - in
trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder: . lib
lib/Test/WWW/Mechanize/Catalyst lib/WWW lib/WWW/Mechanize t t/lib
ash at dev.catalyst.perl.org
ash at dev.catalyst.perl.org
Tue Sep 4 18:49:17 GMT 2007
Author: ash
Date: 2007-09-04 18:49:16 +0100 (Tue, 04 Sep 2007)
New Revision: 6834
Added:
trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/lib/WWW/
trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/lib/WWW/Mechanize/
trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/lib/WWW/Mechanize/TreeBuilder.pm
trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/lib/MockMechanize.pm
Removed:
trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/lib/Test/WWW/Mechanize/Catalyst/TreeBuilder.pm
trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/lib/TestApp.pm
trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/lib/TestApp/
Modified:
trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/Makefile.PL
trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/01-basic.t
Log:
Rename and remove test dep on catalyst
Modified: trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/Makefile.PL
===================================================================
--- trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/Makefile.PL 2007-09-04 11:57:08 UTC (rev 6833)
+++ trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/Makefile.PL 2007-09-04 17:49:16 UTC (rev 6834)
@@ -4,10 +4,11 @@
all_from 'lib/Test/WWW/Mechanize/Catalyst/TreeBuilder.pm';
requires 'perl' => '5.8.1';
-requires 'Test::WWW::Mechanize::Catalyst' => '5.7';
-requires 'Moose' => 0;
+requires 'Moose';
+recommends 'HTML::TreeBuilder';
build_requires 'Test::More';
+requires 'Test::WWW::Mechanize';
no_index directory => 't/lib';
Deleted: 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-04 11:57:08 UTC (rev 6833)
+++ trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/lib/Test/WWW/Mechanize/Catalyst/TreeBuilder.pm 2007-09-04 17:49:16 UTC (rev 6834)
@@ -1,101 +0,0 @@
-package Test::WWW::Mechanize::Catalyst::TreeBuilder;
-
-=head1 NAME
-
-Test::WWW::Mechanize::Catalyst::TreeBuilder
-
-=head1 SYNOPSIS
-
- use Test::More tests => 2;
- use Test::WWW::Mechanize::Catalyst 'MyApp';
-
- 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::Role;
-use HTML::TreeBuilder;
-
-our $VERSION = 1.00000;
-
-requires '_make_request';
-
-has 'tree' => (
- 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 {
- my $orig = shift;
- my $self = shift;
- my $ret = $self->$orig(@_);
-
- # Someone needs to learn about weak refs
- 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 );
- }
-
- return $ret;
-};
-
-sub DEMOLISH {
- my $self = shift;
- $self->tree->delete if $self->has_tree;
-}
-
-=head1 AUTHOR
-
-Ash Berlin C<< <ash at cpan.org> >>
-
-=cut
-
-1;
Copied: trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/lib/WWW/Mechanize/TreeBuilder.pm (from rev 6833, trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/lib/Test/WWW/Mechanize/Catalyst/TreeBuilder.pm)
===================================================================
--- trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/lib/WWW/Mechanize/TreeBuilder.pm (rev 0)
+++ trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/lib/WWW/Mechanize/TreeBuilder.pm 2007-09-04 17:49:16 UTC (rev 6834)
@@ -0,0 +1,113 @@
+package WWW::Mechanize::TreeBuilder;
+
+=head1 NAME
+
+WWW::Mechanize::TreeBuilder
+
+=head1 SYNOPSIS
+
+ use Test::More tests => 2;
+ use Test::WWW::Mechanize;
+ # or
+ # use WWW::Mechanize;
+ # or
+ # use Test::WWW::Mechanize::Catalyst 'MyApp';
+
+ my $mech = WWW::Mechanize->new;
+ # or
+ #my $mech = Test::WWW::Mechanize::Catalyst->new;
+ # etc. etc.
+ 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 - its akin to processing XML with regexps.
+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 begin 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::Role;
+use HTML::TreeBuilder;
+
+our $VERSION = 1.00000;
+
+requires '_make_request';
+
+has 'tree' => (
+ 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 {
+ my $orig = shift;
+ my $self = shift;
+ my $ret = $self->$orig(@_);
+
+ # Someone needs to learn about weak refs
+ 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 );
+ }
+
+ return $ret;
+};
+
+sub DEMOLISH {
+ my $self = shift;
+ $self->tree->delete if $self->has_tree;
+}
+
+=head1 AUTHOR
+
+Ash Berlin C<< <ash at cpan.org> >>
+
+=head1 LICENSE
+
+Same as Perl 5.8, or at your option any later version of Perl.
+
+=cut
+
+1;
Modified: trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/01-basic.t
===================================================================
--- trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/01-basic.t 2007-09-04 11:57:08 UTC (rev 6833)
+++ trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/01-basic.t 2007-09-04 17:49:16 UTC (rev 6834)
@@ -4,24 +4,27 @@
use FindBin;
use lib "$FindBin::Bin/../t/lib";
-use Test::More tests => 8;
+use Test::More tests => 9;
-BEGIN { use_ok 'Test::WWW::Mechanize::Catalyst::TreeBuilder' };
-use Test::WWW::Mechanize::Catalyst 'TestApp';
+BEGIN {
+ use_ok 'WWW::Mechanize::TreeBuilder';
+ use_ok 'MockMechanize';
+};
-my $mech = Test::WWW::Mechanize::Catalyst->new;
+my $mech = MockMechanize->new;
-Test::WWW::Mechanize::Catalyst::TreeBuilder->meta->apply($mech);
+WWW::Mechanize::TreeBuilder->meta->apply($mech);
$mech->get_ok('/', 'Request ok');
+ok($mech->has_tree, 'We have a HTML tree');
+
isa_ok($mech->tree, 'HTML::Element');
-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');
+like($mech->find('title')->as_trimmed_text, qr/\x{2603}/, 'Copes properly with utf8 encoded data'); # Snowman utf8 test
$mech->get_ok('/plain', "Request plain text resource");
Added: trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/lib/MockMechanize.pm
===================================================================
--- trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/lib/MockMechanize.pm (rev 0)
+++ trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/lib/MockMechanize.pm 2007-09-04 17:49:16 UTC (rev 6834)
@@ -0,0 +1,40 @@
+package # Hide from pause
+ MockMechanize;
+
+use strict;
+use warnings;
+
+use base 'Test::WWW::Mechanize';
+
+sub _make_request {
+ my ($self, $req) = @_;
+
+ my ($res);
+
+ if ($req->uri eq '/') {
+ $res = HTTP::Response->new(200, 'OK', ['Content-Type' => 'text/html; charset=utf-8'], <<"EOF");
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html>
+<head>
+ <title>Hurrah \342\230\203!</title>
+</head>
+<body>
+ <h1>It works</h1>
+ <p>A para</p>
+</body>
+</html>
+EOF
+ } elsif ($req->uri eq '/plain') {
+ $res = HTTP::Response->new(200, 'OK', ['Content-Type' => 'text/plain'], "I'm plain text");
+ }
+
+ $res->request($req);
+ $res->header( 'Content-Base' => $req->uri,
+ 'Content-Length' => length $res->content,
+ Status => 200,
+ Date => 'Tue, 04 Sep 2007 16:57:36 GMT' );
+ return $res;
+}
+
+1;
Deleted: trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/lib/TestApp.pm
===================================================================
--- trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/lib/TestApp.pm 2007-09-04 11:57:08 UTC (rev 6833)
+++ trunk/Test-WWW-Mechanize-Catalyst-TreeBuilder/t/lib/TestApp.pm 2007-09-04 17:49:16 UTC (rev 6834)
@@ -1,9 +0,0 @@
-package TestApp;
-use strict;
-use warnings;
-
-use Catalyst;
-
-__PACKAGE__->setup;
-
-1;
More information about the Catalyst-commits
mailing list