@@ -25,12 +25,16 @@ my %args = (
name => 'Web-Query',
module_name => 'Web::Query',
- allow_pure_perl => 0,
+ allow_pureperl => 0,
script_files => [glob('script/*'), glob('bin/*')],
+ c_source => [qw()],
+ PL_files => {},
test_files => ((-d '.git' || $ENV{RELEASE_TESTING}) && -d 'xt') ? 't/ xt/' : 't/',
recursive_test_files => 1,
+
+
);
if (-d 'share') {
$args{share_dir} = 'share';
@@ -1,5 +1,61 @@
Revision history for Perl extension Web::Query
+0.26 2014-03-31T08:23:34Z
+
+ - impl prev() and next() method #31
+ (xaicron)
+
+0.25 2014-02-13T01:26:42Z
+
+ - re-packaging(no feature changes)
+
+0.24 2014-02-12T05:34:09Z
+
+ - replace_with: Can't call method "clone" on an undefined value #24
+ (Reported by @daxim++, Fixed by @yanick++)
+
+0.23 2013-05-30T16:09:03Z
+
+ - improved find() documentation
+ - fixed cpanfile min perl version
+ - modified tests to use the expression form of eval to try to load Web::Query::LibXML
+ - the block form of eval is not working as expected on some perl versions on i386-freebsd
+ (cafe01)
+
+0.22 2013-05-15T23:36:38Z
+
+ - added new module: Web::Query::LibXML
+ - modified test files to also test Web::Query::LibXML (if it loads).
+
+0.21 2013-05-15T14:36:11Z
+
+ - new jQuery-compatible method: add()
+ - fixed filter() that relied on wrong find() behavior
+ - fixed two t/03_traverse.t tests that was expecting wrong behavior from filter()
+
+0.20 2013-05-13T22:51:02Z
+
+ - improved documentation
+ - fixed find() to match only descendant elements
+ This is the correct jQuery compatible implementation, which I have changed in 0.14 to also match root nodes, my bad.
+ - fixed tests that relied on that wrong find() behavior.
+ (cafe01)
+
+0.19 2013-05-12T18:19:57Z
+
+ - implemented contents() jQuery-compatible method
+ - new() now accepts another Web::Query object
+ (cafe01)
+
+0.18 2013-05-09T19:40:40Z
+
+ - fixed html() method, now using $self->_build_tree
+ - calling parent() instead of undocumented getParentNode()
+ - calling disembowel() instead of guts()
+ Need for Web::Query::LibXML, so nodes get detached from old document and returned each as root of a new document.
+ (Carlos Fernando Avila Gratz)
+
+
0.17 2013-05-08T01:18:36Z
- new_from_file() now calling guts() instead of elementify()
@@ -5,6 +5,8 @@ META.json
README.md
cpanfile
lib/Web/Query.pm
+lib/Web/Query/LibXML.pm
+minil.toml
t/00_compile.t
t/01_src.t
t/02_op.t
@@ -16,21 +18,27 @@ t/07_remove.t
t/08_indent.t
t/09_as_html.t
t/10_subclass.t
+t/11_get_eq.t
+t/add.t
t/add_class.t
t/after.t
t/append.t
t/before.t
t/clone.t
+t/contents.t
t/data/foo.html
t/data/html5_snippet.html
t/detach.t
+t/filter.t
t/find.t
t/has_class.t
t/insert_after.t
t/insert_before.t
t/lib/My/TreeBuilder.pm
t/lib/My/Web/Query.pm
+t/next.t
t/prepend.t
+t/prev.t
t/remove_class.t
t/replace_with.t
t/store_comments.t
@@ -4,8 +4,10 @@
"Tokuhiro Matsuno <tokuhirom AAJKLFJEF@ GMAIL COM>"
],
"dynamic_config" : 0,
- "generated_by" : "Minilla/v0.4.2",
- "license" : "perl_5",
+ "generated_by" : "Minilla/v0.13.0",
+ "license" : [
+ "perl_5"
+ ],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
@@ -19,7 +21,8 @@
"share",
"eg",
"examples",
- "author"
+ "author",
+ "builder"
]
},
"prereqs" : {
@@ -33,9 +36,9 @@
"develop" : {
"requires" : {
"Test::CPAN::Meta" : "0",
- "Test::MinimumVersion" : "0.10108",
+ "Test::MinimumVersion::Fast" : "0.04",
"Test::Pod" : "1.41",
- "Test::Spellunker" : "v0.2.2"
+ "Test::Spellunker" : "v0.2.7"
}
},
"runtime" : {
@@ -46,7 +49,7 @@
"LWP::UserAgent" : "6",
"Scalar::Util" : "0",
"parent" : "0",
- "perl" : "5.008001"
+ "perl" : "5.008005"
}
},
"test" : {
@@ -58,7 +61,11 @@
"provides" : {
"Web::Query" : {
"file" : "lib/Web/Query.pm",
- "version" : "0.17"
+ "version" : "0.26"
+ },
+ "Web::Query::LibXML" : {
+ "file" : "lib/Web/Query/LibXML.pm",
+ "version" : "0.26"
}
},
"release_status" : "stable",
@@ -72,13 +79,17 @@
"web" : "https://github.com/tokuhirom/Web-Query"
}
},
- "version" : "0.17",
+ "version" : "0.26",
+ "x_authority" : "cpan:TOKUHIROM",
"x_contributors" : [
"Hiroki Honda <cside.story@gmail.com>",
"Oleg <verdrehung@gmail.com>",
"Kang-min Liu <gugod@gugod.org>",
- "Yanick Champoux <yanick@babyl.dyndns.org>",
+ "Carlos Fernando Avila Gratz <cafe01@gmail.com>",
+ "DQNEO <dqneoo@gmail.com>",
"Carlos Fernando Avila Gratz <cafe@q1software.com>",
- "tokuhirom <tokuhirom@gmail.com>"
+ "Yanick Champoux <yanick@babyl.dyndns.org>",
+ "xaicron <xaicron@gmail.com>",
+ "Tokuhiro Matsuno <tokuhirom@gmail.com>"
]
}
@@ -3,17 +3,17 @@ abstract: 'Yet another scraping library like jQuery'
author:
- 'Tokuhiro Matsuno <tokuhirom AAJKLFJEF@ GMAIL COM>'
build_requires:
- Test::More: 0.98
+ Test::More: '0.98'
configure_requires:
- CPAN::Meta: 0
- CPAN::Meta::Prereqs: 0
- Module::Build: 0.38
+ CPAN::Meta: '0'
+ CPAN::Meta::Prereqs: '0'
+ Module::Build: '0.38'
dynamic_config: 0
-generated_by: 'Minilla/v0.4.2, CPAN::Meta::Converter version 2.120921'
+generated_by: 'Minilla/v0.13.0, CPAN::Meta::Converter version 2.133380'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: Web-Query
no_index:
directory:
@@ -24,27 +24,35 @@ no_index:
- eg
- examples
- author
+ - builder
provides:
Web::Query:
file: lib/Web/Query.pm
- version: 0.17
+ version: '0.26'
+ Web::Query::LibXML:
+ file: lib/Web/Query/LibXML.pm
+ version: '0.26'
requires:
- HTML::Entities: 0
- HTML::Selector::XPath: 0.06
- HTML::TreeBuilder::XPath: 0.12
- LWP::UserAgent: 6
- Scalar::Util: 0
- parent: 0
- perl: 5.008001
+ HTML::Entities: '0'
+ HTML::Selector::XPath: '0.06'
+ HTML::TreeBuilder::XPath: '0.12'
+ LWP::UserAgent: '6'
+ Scalar::Util: '0'
+ parent: '0'
+ perl: '5.008005'
resources:
bugtracker: https://github.com/tokuhirom/Web-Query/issues
homepage: https://github.com/tokuhirom/Web-Query
repository: git://github.com/tokuhirom/Web-Query.git
-version: 0.17
+version: '0.26'
+x_authority: cpan:TOKUHIROM
x_contributors:
- 'Hiroki Honda <cside.story@gmail.com>'
- 'Oleg <verdrehung@gmail.com>'
- 'Kang-min Liu <gugod@gugod.org>'
- - 'Yanick Champoux <yanick@babyl.dyndns.org>'
+ - 'Carlos Fernando Avila Gratz <cafe01@gmail.com>'
+ - 'DQNEO <dqneoo@gmail.com>'
- 'Carlos Fernando Avila Gratz <cafe@q1software.com>'
- - 'tokuhirom <tokuhirom@gmail.com>'
+ - 'Yanick Champoux <yanick@babyl.dyndns.org>'
+ - 'xaicron <xaicron@gmail.com>'
+ - 'Tokuhiro Matsuno <tokuhirom@gmail.com>'
@@ -6,21 +6,21 @@ Web::Query - Yet another scraping library like jQuery
use Web::Query;
- wq('http://google.com/search?q=foobar')
- ->find('h2')
- ->each(sub {
- my $i = shift;
- printf("%d) %s\n", $i+1, $_->text
- });
+ wq('http://www.w3.org/TR/html401/')
+ ->find('div.head dt')
+ ->each(sub {
+ my $i = shift;
+ printf("%d %s\n", $i+1, $_->text);
+ });
# DESCRIPTION
Web::Query is a yet another scraping framework, have a jQuery like interface.
-Yes, I know Ingy's [pQuery](http://search.cpan.org/perldoc?pQuery). But it's just a alpha quality. It doesn't works.
-Web::Query built at top of the CPAN modules, [HTML::TreeBuilder::XPath](http://search.cpan.org/perldoc?HTML::TreeBuilder::XPath), [LWP::UserAgent](http://search.cpan.org/perldoc?LWP::UserAgent), and [HTML::Selector::XPath](http://search.cpan.org/perldoc?HTML::Selector::XPath).
+Yes, I know Ingy's [pQuery](https://metacpan.org/pod/pQuery). But it's just a alpha quality. It doesn't works.
+Web::Query built at top of the CPAN modules, [HTML::TreeBuilder::XPath](https://metacpan.org/pod/HTML::TreeBuilder::XPath), [LWP::UserAgent](https://metacpan.org/pod/LWP::UserAgent), and [HTML::Selector::XPath](https://metacpan.org/pod/HTML::Selector::XPath).
-So, this module uses [HTML::Selector::XPath](http://search.cpan.org/perldoc?HTML::Selector::XPath) and only supports the CSS 3
+So, this module uses [HTML::Selector::XPath](https://metacpan.org/pod/HTML::Selector::XPath) and only supports the CSS 3
selector supported by that module.
Web::Query doesn't support jQuery's extended queries(yet?).
@@ -34,9 +34,11 @@ __THIS LIBRARY IS UNDER DEVELOPMENT. ANY API MAY CHANGE WITHOUT NOTICE__.
# METHODS
+## CONSTRUCTORS
+
- my $q = Web::Query->new($stuff, \\%options )
- Create new instance of Web::Query. You can make the instance from URL(http, https, file scheme), HTML in string, URL in string, [URI](http://search.cpan.org/perldoc?URI) object, and instance of [HTML::Element](http://search.cpan.org/perldoc?HTML::Element).
+ Create new instance of Web::Query. You can make the instance from URL(http, https, file scheme), HTML in string, URL in string, [URI](https://metacpan.org/pod/URI) object, and instance of [HTML::Element](https://metacpan.org/pod/HTML::Element).
This method throw the exception on unknown $stuff.
@@ -47,7 +49,7 @@ __THIS LIBRARY IS UNDER DEVELOPMENT. ANY API MAY CHANGE WITHOUT NOTICE__.
- my $q = Web::Query->new\_from\_element($element: HTML::Element)
- Create new instance of Web::Query from instance of [HTML::Element](http://search.cpan.org/perldoc?HTML::Element).
+ Create new instance of Web::Query from instance of [HTML::Element](https://metacpan.org/pod/HTML::Element).
- `my $q = Web::Query->new_from_html($html: Str)`
@@ -71,107 +73,252 @@ __THIS LIBRARY IS UNDER DEVELOPMENT. ANY API MAY CHANGE WITHOUT NOTICE__.
Create new instance of Web::Query from file name.
-- my @html = $q->html();
-- my $html = $q->html();
-- $q->html('<p>foo</p>');
+## TRAVERSING
- Get/Set the innerHTML.
+### add
-- $q->as\_html();
+Add elements to the set of matched elements.
- Return the elements associated with the object as strings.
- If called in a scalar context, only return the string representation
- of the first element.
+- add($html)
-- my @text = $q->text();
-- my $text = $q->text();
-- $q->text('text');
+ An HTML fragment to add to the set of matched elements.
- Get/Set the inner text.
+- add(@elements)
-- my $attr = $q->attr($name);
-- `$q->attr($name, $val);`
+ One or more @elements to add to the set of matched elements.
- Get/Set the attribute value in element.
+- add($wq)
-- $q = $q->find($selector)
+ An existing Web::Query object to add to the set of matched elements.
- This method find nodes by $selector from $q. $selector is a CSS3 selector.
+- add($selector, $context)
-- $q->each(sub { my ($i, $elem) = @\_; ... })
+ $selector is a string representing a selector expression to find additional elements to add to the set of matched elements.
- Visit each nodes. `$i` is a counter value, 0 origin. `$elem` is iteration item.
- `$_` is localized by `$elem`.
+ $context is the point in the document at which the selector should begin matching
-- $q->map(sub { my ($i, $elem) = @\_; ... })
+### contents
- Creates a new array with the results of calling a provided function on every element.
+Get the immediate children of each element in the set of matched elements, including text and comment nodes.
-- $q->filter(sub { my ($i, $elem) = @\_; ... })
+### each
- Reduce the elements to those that pass the function's test.
+Visit each nodes. `$i` is a counter value, 0 origin. `$elem` is iteration item.
+`$_` is localized by `$elem`.
-- $q->end()
+ $q->each(sub { my ($i, $elem) = @_; ... })
- Back to the before context like jQuery.
+### end
-- my $size = $q->size() : Int
+Back to the before context like jQuery.
- Return the number of DOM elements matched by the Web::Query object.
+### filter
-- my $parent = $q->parent() : Web::Query
+Reduce the elements to those that pass the function's test.
- Return the parent node from `$q`.
+ $q->filter(sub { my ($i, $elem) = @_; ... })
-- my $first = $q->first()
+### find
- Return the first matching element.
+Get the descendants of each element in the current set of matched elements, filtered by a selector.
- This method constructs a new Web::Query object from the first matching element.
+ my $q2 = $q->find($selector); # $selector is a CSS3 selector.
+
-- my $last = $q->last()
+__NOTE__ If you want to match the element itself, use ["filter"](#filter).
- Return the last matching element.
+__INCOMPATIBLE CHANGE__
+From v0.14 to v0.19 (inclusive) find() also matched the element itself, which is not jQuery compatible.
+You can achieve that result using `filter()`, `add()` and `find()`:
- This method constructs a new Web::Query object from the last matching element.
+ my $wq = wq('<div class="foo"><p class="foo">bar</p></div>'); # needed because we don't have a global document like jQuery does
+ print $wq->filter('.foo')->add($wq->find('.foo'))->as_html; # <div class="foo"><p class="foo">bar</p></div><p class="foo">bar</p>
-- $q->remove()
+### first
- Delete the elements associated with the object from the DOM.
+Return the first matching element.
- # remove all <blink> tags from the document
- $q->find('blink')->remove;
+This method constructs a new Web::Query object from the first matching element.
-- $q->replace\_with( $replacement );
+### last
- Replace the elements of the object with the provided replacement.
- The replacement can be a string, a `Web::Query` object or an
- anonymous function. The anonymous function is passed the index of the current
- node and the node itself (with is also localized as `$_`).
+Return the last matching element.
- my $q = wq( '<p><b>Abra</b><i>cada</i><u>bra</u></p>' );
+This method constructs a new Web::Query object from the last matching element.
- $q->find('b')->replace_with('<a>Ocus</a>);
- # <p><a>Ocus</a><i>cada</i><u>bra</u></p>
+### map
- $q->find('u')->replace_with($q->find('b'));
- # <p><i>cada</i><b>Abra</b></p>
+Creates a new array with the results of calling a provided function on every element.
- $q->find('i')->replace_with(sub{
- my $name = $_->text;
- return "<$name></$name>";
- });
- # <p><b>Abra</b><cada></cada><u>bra</u></p>
+ $q->map(sub { my ($i, $elem) = @_; ... })
+
+### parent
+
+Get the parent of each element in the current set of matched elements.
+
+### prev
+
+Get the previous node of each element in the current set of matched elements.
+
+ my $prev = $q->prev;
+
+### next
+
+Get the next node of each element in the current set of matched elements.
+
+ my $next = $q->next;
+
+## MANIPULATION
+
+### add\_class
+
+Adds the specified class(es) to each of the set of matched elements.
+
+ # add class 'foo' to <p> elements
+ wq('<div><p>foo</p><p>bar</p></div>')->find('p')->add_class('foo');
+
+### after
+
+Insert content, specified by the parameter, after each element in the set of matched elements.
+
+ wq('<div><p>foo</p></div>')->find('p')
+ ->after('<b>bar</b>')
+ ->end
+ ->as_html; # <div><p>foo</p><b>bar</b></div>
+
+
+The content can be anything accepted by ["new"](#new).
+
+### append
+
+Insert content, specified by the parameter, to the end of each element in the set of matched elements.
+
+ wq('<div></div>')->append('<p>foo</p>')->as_html; # <div><p>foo</p></div>
+
+
+The content can be anything accepted by ["new"](#new).
+
+### as\_html
+
+Return the elements associated with the object as strings.
+If called in a scalar context, only return the string representation
+of the first element.
+
+### ` attr `
+
+Get/Set the attribute value in element.
+
+ my $attr = $q->attr($name);
+
+ $q->attr($name, $val);
+
+### before
+
+Insert content, specified by the parameter, before each element in the set of matched elements.
+
+ wq('<div><p>foo</p></div>')->find('p')
+ ->before('<b>bar</b>')
+ ->end
+ ->as_html; # <div><b>bar</b><p>foo</p></div>
+
+
+The content can be anything accepted by ["new"](#new).
+
+### clone
+
+Create a deep copy of the set of matched elements.
+
+### detach
+
+Remove the set of matched elements from the DOM.
+
+### has\_class
+
+Determine whether any of the matched elements are assigned the given class.
+
+### ` html `
+
+Get/Set the innerHTML.
+
+ my @html = $q->html();
+
+ my $html = $q->html(); # 1st matching element only
+
+ $q->html('<p>foo</p>');
+
+### insert\_before
+
+Insert every element in the set of matched elements before the target.
+
+### insert\_after
+
+Insert every element in the set of matched elements after the target.
+
+### ` prepend `
+
+Insert content, specified by the parameter, to the beginning of each element in the set of matched elements.
+
+### remove
+
+Delete the elements associated with the object from the DOM.
+
+ # remove all <blink> tags from the document
+ $q->find('blink')->remove;
+
+### remove\_class
+
+Remove a single class, multiple classes, or all classes from each element in the set of matched elements.
+
+### replace\_with
+
+Replace the elements of the object with the provided replacement.
+The replacement can be a string, a `Web::Query` object or an
+anonymous function. The anonymous function is passed the index of the current
+node and the node itself (with is also localized as `$_`).
+
+ my $q = wq( '<p><b>Abra</b><i>cada</i><u>bra</u></p>' );
+
+ $q->find('b')->replace_with('<a>Ocus</a>);
+ # <p><a>Ocus</a><i>cada</i><u>bra</u></p>
+
+ $q->find('u')->replace_with($q->find('b'));
+ # <p><i>cada</i><b>Abra</b></p>
+
+ $q->find('i')->replace_with(sub{
+ my $name = $_->text;
+ return "<$name></$name>";
+ });
+ # <p><b>Abra</b><cada></cada><u>bra</u></p>
+
+### size
+
+Return the number of elements in the Web::Query object.
+
+ wq('<div><p>foo</p><p>bar</p></div>')->find('p')->size; # 2
+
+### text
+
+Get/Set the text.
+
+ my @text = $q->text();
+
+ my $text = $q->text(); # 1st matching element only
+
+ $q->text('text');
+
+
+If called in a scalar context, only return the string representation
+of the first element
# HOW DO I CUSTOMIZE USER AGENT?
-You can specify your own instance of [LWP::UserAgent](http://search.cpan.org/perldoc?LWP::UserAgent).
+You can specify your own instance of [LWP::UserAgent](https://metacpan.org/pod/LWP::UserAgent).
$Web::Query::UserAgent = LWP::UserAgent->new( agent => 'Mozilla/5.0' );
# INCOMPATIBLE CHANGES
-0. 10
+- 0.10
new\_from\_url() is no longer throws exception on bad response from HTTP server.
@@ -181,7 +328,7 @@ Tokuhiro Matsuno <tokuhirom AAJKLFJEF@ GMAIL COM>
# SEE ALSO
-[pQuery](http://search.cpan.org/perldoc?pQuery)
+[pQuery](https://metacpan.org/pod/pQuery)
# LICENSE
@@ -4,7 +4,7 @@ requires 'HTML::TreeBuilder::XPath', '0.12';
requires 'LWP::UserAgent', '6';
requires 'Scalar::Util';
requires 'parent';
-requires 'perl', '5.008001';
+requires 'perl', '5.008005';
on test => sub {
requires 'Test::More', '0.98';
@@ -0,0 +1,114 @@
+package Web::Query::LibXML;
+use 5.008005;
+use strict;
+use warnings;
+use parent qw/Web::Query Exporter/;
+use HTML::TreeBuilder::LibXML;
+
+
+our $VERSION = "0.26";
+
+our @EXPORT = qw/wq/;
+
+sub wq { Web::Query::LibXML->new(@_) }
+
+sub _build_tree {
+ my $class = shift;
+ my $tree = HTML::TreeBuilder::LibXML->new();
+ $tree->ignore_unknown(0);
+ $tree->store_comments(1);
+ $tree;
+}
+
+# TODO use Web::Query remove
+sub remove {
+ my $self = shift;
+ my $before = $self->end;
+
+ while (defined $before) {
+ @{$before->{trees}} = grep {
+ my $el = $_;
+ not grep { $el->{node}->isSameNode($_->{node}) } @{$self->{trees}};
+ } @{$before->{trees}};
+
+ $before = $before->end;
+ }
+
+ $_->delete for @{$self->{trees}};
+ @{$self->{trees}} = ();
+
+ $self;
+}
+
+sub prev {
+ my $self = shift;
+ my @new;
+ for my $tree (@{$self->{trees}}) {
+ push @new, $tree->left;
+ }
+ return (ref $self || $self)->new_from_element(\@new, $self);
+}
+
+sub next {
+ my $self = shift;
+ my @new;
+ for my $tree (@{$self->{trees}}) {
+ push @new, $tree->right;
+ }
+ return (ref $self || $self)->new_from_element(\@new, $self);
+}
+
+1;
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+Web::Query::LibXML - fast, drop-in replacement for Web::Query
+
+=head1 SYNOPSIS
+
+ use Web::Query::LibXML;
+
+ # imports wq()
+ # all methods inherited from Web::Query
+ # see Web::Query for documentation
+
+
+=head1 DESCRIPTION
+
+Web::Query::LibXML is Web::Query subclass that overrides the _build_tree() method to use HTML::TreeBuilder::LibXML instead of HTML::TreeBuilder::XPath.
+Its a lot faster than its superclass. Use this module unless you can't install (or depend on) L<XML::LibXML> on your system.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<< wq($stuff) >>
+
+This is a shortcut for C<< Web::Query::LibXML->new($stuff) >>. This function is exported by default.
+
+=back
+
+=head1 METHODS
+
+All public methods are inherited from L<Web::Query>.
+
+=head1 LICENSE
+
+Copyright (C) Carlos Fernando Avila Gratz.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Carlos Fernando Avila Gratz E<lt>cafe@q1software.comE<gt>
+
+=head1 SEE ALSO
+
+L<Web::Query>, L<HTML::TreeBuilder::LibXML>, L<XML::LibXML>
+
+=cut
+
@@ -3,7 +3,7 @@ use strict;
use warnings;
use 5.008001;
use parent qw/Exporter/;
-our $VERSION = '0.17';
+our $VERSION = '0.26';
use HTML::TreeBuilder::XPath;
use LWP::UserAgent;
use HTML::Selector::XPath 0.06 qw/selector_to_xpath/;
@@ -24,7 +24,7 @@ sub __ua {
}
sub _build_tree {
- my ($self, $content) = @_;
+ my $class = shift;
my $tree = HTML::TreeBuilder::XPath->new();
$tree->ignore_unknown(0);
$tree->store_comments(1);
@@ -52,6 +52,10 @@ sub _resolve_new {
if ($stuff->isa('URI')) {
return $class->new_from_url($stuff->as_string);
}
+
+ if ($stuff->isa($class)) {
+ return $class->new_from_element($stuff->{trees});
+ }
die "Unknown source type: $stuff";
}
@@ -81,7 +85,7 @@ sub new_from_file {
my ($class, $fname) = @_;
my $tree = $class->_build_tree;
$tree->parse_file($fname);
- my $self = $class->new_from_element([$tree->guts]);
+ my $self = $class->new_from_element([$tree->disembowel]);
$self->{need_delete}++;
return $self;
}
@@ -90,15 +94,15 @@ sub new_from_html {
my ($class, $html) = @_;
my $tree = $class->_build_tree;
$tree->parse_content($html);
- my $self = $class->new_from_element([$tree->guts]);
+ my $self = $class->new_from_element([$tree->disembowel]);
$self->{need_delete}++;
return $self;
}
sub new_from_element {
my $class = shift;
- my $trees = ref $_[0] eq 'ARRAY' ? $_[0] : +[$_[0]];
- return bless { trees => +[ grep { blessed $_ } @$trees ], before => $_[1] }, $class;
+ my $trees = ref $_[0] eq 'ARRAY' ? $_[0] : [$_[0]];
+ return bless { trees => [ @$trees ], before => $_[1] }, $class;
}
sub end {
@@ -115,38 +119,59 @@ sub parent {
my $self = shift;
my @new;
for my $tree (@{$self->{trees}}) {
- push @new, $tree->getParentNode();
+ push @new, $tree->parent();
}
return (ref $self || $self)->new_from_element(\@new, $self);
}
sub first {
my $self = shift;
- return (ref $self || $self)->new_from_element([$self->{trees}[0] || ()], $self);
+ return $self->eq(0);
}
sub last {
my $self = shift;
- return (ref $self || $self)->new_from_element([$self->{trees}[-1] || ()], $self);
+ return $self->eq(-1);
+}
+
+sub get {
+ my ($self, $index) = @_;
+ return $self->{trees}[$index];
+}
+
+sub eq {
+ my ($self, $index) = @_;
+ return (ref $self || $self)->new_from_element([$self->{trees}[$index] || ()], $self);
}
sub find {
my ($self, $selector) = @_;
- my $xpath_rootless = selector_to_xpath($selector);
- my @new;
- for my $tree (@{$self->{trees}}) {
- push @new, $tree if defined $tree->parent && $tree->matches($xpath_rootless);
- push @new, $tree->findnodes(selector_to_xpath($selector, root => defined $tree->parent ? './' : '/'));
- }
+ my $xpath = selector_to_xpath($selector, root => './');
+ my @new = map { $_->findnodes($xpath) } @{$self->{trees}};
return (ref $self || $self)->new_from_element(\@new, $self);
}
+sub contents {
+ my ($self, $selector) = @_;
+
+ my @new = map { $_->content_list } @{$self->{trees}};
+
+ if ($selector) {
+ my $xpath = selector_to_xpath($selector);
+ @new = grep { $_->matches($xpath) } @new;
+ }
+
+ return (ref $self || $self)->new_from_element(\@new, $self);
+}
+
sub as_html {
my $self = shift;
- my @html = map { $_->as_HTML( q{&<>'"}, $self->{indent}, {} ) }
+ my @html = map {
+ ref $_ ? $_->as_HTML( q{&<>'"}, $self->{indent}, {} )
+ : $_ }
@{$self->{trees}};
return wantarray ? @html : $html[0];
@@ -154,17 +179,13 @@ sub as_html {
sub html {
my $self = shift;
- my $builder = HTML::TreeBuilder->new;
- $builder->store_comments(1);
if (@_) {
map {
$_->delete_content;
- my $tree = HTML::TreeBuilder->new;
- $tree->ignore_unknown(0);
- $tree->store_comments(1);
+ my $tree = $self->_build_tree;
$tree->parse_content($_[0]);
- $_->push_content($tree->guts);
+ $_->push_content($tree->disembowel);
} @{$self->{trees}};
return $self;
}
@@ -231,7 +252,9 @@ sub filter {
return $self;
} else {
- return $self->find($_[0])
+ my $xpath = selector_to_xpath($_[0]);
+ my @new = grep { $_->matches($xpath) } @{$self->{trees}};
+ return (ref $self || $self)->new_from_element(\@new, $self);
}
}
@@ -269,8 +292,11 @@ sub replace_with {
$rep = (ref $self || $self)->new_from_html( $rep )
unless ref $rep;
- my $r = $rep->{trees}->[0]->clone;
- $r->parent( $node->parent ) if $node->parent;
+
+
+ my $r = $rep->{trees}->[0];
+ $r = $r->clone if ref $r;
+ $r->parent( $node->parent ) if ref $r and $node->parent;
$node->replace_with( $r );
}
@@ -358,7 +384,7 @@ sub add_class {
for (my $i = 0; $i < @{$self->{trees}}; $i++) {
my $t = $self->{trees}->[$i];
- my $current_class = $t->attr('class');
+ my $current_class = $t->attr('class') || '';
my $classes = ref $class eq 'CODE' ? $class->($i, $current_class, $t) : $class;
my @classes = split /\s+/, $classes;
@@ -416,10 +442,50 @@ sub clone {
return (ref $self || $self)->new_from_element(\@clones);
}
-sub DESTROY {
- if ($_[0]->{need_delete}) {
- $_->delete for @{$_[0]->{trees}}; # avoid memory leaks
+sub add {
+ my ($self, @stuff) = @_;
+ my @nodes;
+
+ # add(selector, context)
+ if (@stuff == 2 && !ref $stuff[0] && $stuff[1]->isa('HTML::Element')) {
+ push @nodes, $stuff[1]->findnodes(selector_to_xpath($stuff[0]), root => './');
+ }
+ else {
+ # handle any combination of html string, element object and web::query object
+ push @nodes, map {
+ $self->{need_delete} = 1 if $_->{need_delete};
+ delete $_->{need_delete};
+ @{$_->{trees}};
+ } map { (ref $self || $self)->new($_) } @stuff;
+ }
+
+ push @{$self->{trees}}, @nodes;
+ $self;
+}
+
+sub prev {
+ my $self = shift;
+ my @new;
+ for my $tree (@{$self->{trees}}) {
+ push @new, $tree->getPreviousSibling;
+ }
+ return (ref $self || $self)->new_from_element(\@new, $self);
+}
+
+sub next {
+ my $self = shift;
+ my @new;
+ for my $tree (@{$self->{trees}}) {
+ push @new, $tree->getNextSibling;
}
+ return (ref $self || $self)->new_from_element(\@new, $self);
+}
+
+sub DESTROY {
+ return unless $_[0]->{need_delete};
+
+ # avoid memory leaks
+ $_->delete for grep { ref $_ } @{$_[0]->{trees}};
}
1;
@@ -427,6 +493,8 @@ __END__
=encoding utf8
+=for stopwords prev
+
=head1 NAME
Web::Query - Yet another scraping library like jQuery
@@ -435,12 +503,12 @@ Web::Query - Yet another scraping library like jQuery
use Web::Query;
- wq('http://google.com/search?q=foobar')
- ->find('h2')
- ->each(sub {
- my $i = shift;
- printf("%d) %s\n", $i+1, $_->text
- });
+ wq('http://www.w3.org/TR/html401/')
+ ->find('div.head dt')
+ ->each(sub {
+ my $i = shift;
+ printf("%d %s\n", $i+1, $_->text);
+ });
=head1 DESCRIPTION
@@ -467,6 +535,8 @@ This is a shortcut for C<< Web::Query->new($stuff) >>. This function is exported
=head1 METHODS
+=head2 CONSTRUCTORS
+
=over 4
=item my $q = Web::Query->new($stuff, \%options )
@@ -506,83 +576,205 @@ Here is a best practical code:
Create new instance of Web::Query from file name.
-=item my @html = $q->html();
+=back
+
+=head2 TRAVERSING
-=item my $html = $q->html();
+=head3 add
-=item $q->html('<p>foo</p>');
+Add elements to the set of matched elements.
-Get/Set the innerHTML.
+=over 4
-=item $q->as_html();
+=item add($html)
-Return the elements associated with the object as strings.
-If called in a scalar context, only return the string representation
-of the first element.
+An HTML fragment to add to the set of matched elements.
-=item my @text = $q->text();
+=item add(@elements)
-=item my $text = $q->text();
+One or more @elements to add to the set of matched elements.
-=item $q->text('text');
+=item add($wq)
-Get/Set the inner text.
+An existing Web::Query object to add to the set of matched elements.
-=item my $attr = $q->attr($name);
+=item add($selector, $context)
-=item C<< $q->attr($name, $val); >>
+$selector is a string representing a selector expression to find additional elements to add to the set of matched elements.
-Get/Set the attribute value in element.
+$context is the point in the document at which the selector should begin matching
+
+=back
-=item $q = $q->find($selector)
+=head3 contents
-This method find nodes by $selector from $q. $selector is a CSS3 selector.
+Get the immediate children of each element in the set of matched elements, including text and comment nodes.
-=item $q->each(sub { my ($i, $elem) = @_; ... })
+=head3 each
Visit each nodes. C<< $i >> is a counter value, 0 origin. C<< $elem >> is iteration item.
C<< $_ >> is localized by C<< $elem >>.
-=item $q->map(sub { my ($i, $elem) = @_; ... })
+ $q->each(sub { my ($i, $elem) = @_; ... })
-Creates a new array with the results of calling a provided function on every element.
+=head3 end
-=item $q->filter(sub { my ($i, $elem) = @_; ... })
+Back to the before context like jQuery.
+
+=head3 filter
Reduce the elements to those that pass the function's test.
-=item $q->end()
+ $q->filter(sub { my ($i, $elem) = @_; ... })
-Back to the before context like jQuery.
+=head3 find
-=item my $size = $q->size() : Int
+Get the descendants of each element in the current set of matched elements, filtered by a selector.
-Return the number of DOM elements matched by the Web::Query object.
+ my $q2 = $q->find($selector); # $selector is a CSS3 selector.
+
+B<NOTE> If you want to match the element itself, use L</filter>.
-=item my $parent = $q->parent() : Web::Query
+B<INCOMPATIBLE CHANGE>
+From v0.14 to v0.19 (inclusive) find() also matched the element itself, which is not jQuery compatible.
+You can achieve that result using C<filter()>, C<add()> and C<find()>:
-Return the parent node from C<< $q >>.
+ my $wq = wq('<div class="foo"><p class="foo">bar</p></div>'); # needed because we don't have a global document like jQuery does
+ print $wq->filter('.foo')->add($wq->find('.foo'))->as_html; # <div class="foo"><p class="foo">bar</p></div><p class="foo">bar</p>
-=item my $first = $q->first()
+=head3 first
Return the first matching element.
This method constructs a new Web::Query object from the first matching element.
-=item my $last = $q->last()
+=head3 last
Return the last matching element.
This method constructs a new Web::Query object from the last matching element.
-=item $q->remove()
+=head3 map
+
+Creates a new array with the results of calling a provided function on every element.
+
+ $q->map(sub { my ($i, $elem) = @_; ... })
+
+=head3 parent
+
+Get the parent of each element in the current set of matched elements.
+
+=head3 prev
+
+Get the previous node of each element in the current set of matched elements.
+
+ my $prev = $q->prev;
+
+=head3 next
+
+Get the next node of each element in the current set of matched elements.
+
+ my $next = $q->next;
+
+=head2 MANIPULATION
+
+=head3 add_class
+
+Adds the specified class(es) to each of the set of matched elements.
+
+ # add class 'foo' to <p> elements
+ wq('<div><p>foo</p><p>bar</p></div>')->find('p')->add_class('foo');
+
+=head3 after
+
+Insert content, specified by the parameter, after each element in the set of matched elements.
+
+ wq('<div><p>foo</p></div>')->find('p')
+ ->after('<b>bar</b>')
+ ->end
+ ->as_html; # <div><p>foo</p><b>bar</b></div>
+
+The content can be anything accepted by L</new>.
+
+=head3 append
+
+Insert content, specified by the parameter, to the end of each element in the set of matched elements.
+
+ wq('<div></div>')->append('<p>foo</p>')->as_html; # <div><p>foo</p></div>
+
+The content can be anything accepted by L</new>.
+
+=head3 as_html
+
+Return the elements associated with the object as strings.
+If called in a scalar context, only return the string representation
+of the first element.
+
+=head3 C< attr >
+
+Get/Set the attribute value in element.
+
+ my $attr = $q->attr($name);
+
+ $q->attr($name, $val);
+
+=head3 before
+
+Insert content, specified by the parameter, before each element in the set of matched elements.
+
+ wq('<div><p>foo</p></div>')->find('p')
+ ->before('<b>bar</b>')
+ ->end
+ ->as_html; # <div><b>bar</b><p>foo</p></div>
+
+The content can be anything accepted by L</new>.
+
+=head3 clone
+
+Create a deep copy of the set of matched elements.
+
+=head3 detach
+
+Remove the set of matched elements from the DOM.
+
+=head3 has_class
+
+Determine whether any of the matched elements are assigned the given class.
+
+=head3 C< html >
+
+Get/Set the innerHTML.
+
+ my @html = $q->html();
+
+ my $html = $q->html(); # 1st matching element only
+
+ $q->html('<p>foo</p>');
+
+=head3 insert_before
+
+Insert every element in the set of matched elements before the target.
+
+=head3 insert_after
+
+Insert every element in the set of matched elements after the target.
+
+=head3 C< prepend >
+
+Insert content, specified by the parameter, to the beginning of each element in the set of matched elements.
+
+=head3 remove
Delete the elements associated with the object from the DOM.
# remove all <blink> tags from the document
$q->find('blink')->remove;
-=item $q->replace_with( $replacement );
+=head3 remove_class
+
+Remove a single class, multiple classes, or all classes from each element in the set of matched elements.
+
+=head3 replace_with
Replace the elements of the object with the provided replacement.
The replacement can be a string, a C<Web::Query> object or an
@@ -603,7 +795,24 @@ node and the node itself (with is also localized as C<$_>).
});
# <p><b>Abra</b><cada></cada><u>bra</u></p>
-=back
+=head3 size
+
+Return the number of elements in the Web::Query object.
+
+ wq('<div><p>foo</p><p>bar</p></div>')->find('p')->size; # 2
+
+=head3 text
+
+Get/Set the text.
+
+ my @text = $q->text();
+
+ my $text = $q->text(); # 1st matching element only
+
+ $q->text('text');
+
+If called in a scalar context, only return the string representation
+of the first element
=head1 HOW DO I CUSTOMIZE USER AGENT?
@@ -0,0 +1 @@
+authority = "cpan:TOKUHIROM"
@@ -2,53 +2,69 @@ use strict;
use warnings;
use utf8;
use Test::More;
-use Web::Query;
use Cwd ();
+use Web::Query;
-subtest 'from file' => sub {
- plan tests => 5;
- test(wq('t/data/foo.html'));
-};
-
-is wq('t/data/html5_snippet.html')->size, 3, 'snippet from file';
-
-subtest 'from url' => sub {
- plan tests => 5;
- test(wq('file://' . Cwd::abs_path('t/data/foo.html')));
-};
-
-subtest 'from treebuilder' => sub {
- plan tests => 5;
- my $tree = HTML::TreeBuilder::XPath->new_from_file('t/data/foo.html');
- test(wq($tree));
-};
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
-subtest 'from Array[treebuilder]' => sub {
- plan tests => 5;
- my $tree = HTML::TreeBuilder::XPath->new_from_file('t/data/foo.html');
- test(wq([$tree]));
-};
+done_testing;
-subtest 'from html' => sub {
- plan tests => 5;
- open my $fh, '<', 't/data/foo.html';
- my $html = do { local $/; <$fh> };
- test(wq($html));
-};
-if (eval "require URI; 1;") {
- subtest 'from URI' => sub {
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ subtest 'from file' => sub {
+ plan tests => 5;
+ run_tests(wq('t/data/foo.html'));
+ };
+
+ is wq('t/data/html5_snippet.html')->size, 3, 'snippet from file';
+
+ subtest 'from url' => sub {
+ plan tests => 5;
+ run_tests(wq('file://' . Cwd::abs_path('t/data/foo.html')));
+ };
+
+ subtest 'from treebuilder' => sub {
plan tests => 5;
- test(wq(URI->new('file://' . Cwd::abs_path('t/data/foo.html'))));
+ my $tree = HTML::TreeBuilder::XPath->new_from_file('t/data/foo.html');
+ run_tests(wq($tree));
};
+
+ subtest 'from Array[treebuilder]' => sub {
+ plan tests => 5;
+ my $tree = HTML::TreeBuilder::XPath->new_from_file('t/data/foo.html');
+ run_tests(wq([$tree]));
+ };
+
+ subtest 'from html' => sub {
+ plan tests => 5;
+ open my $fh, '<', 't/data/foo.html';
+ my $html = do { local $/; <$fh> };
+ run_tests(wq($html));
+ };
+
+ subtest 'from Web::Query object' => sub {
+ plan tests => 5;
+ my $tree = HTML::TreeBuilder::XPath->new_from_file('t/data/foo.html');
+ run_tests(wq(wq($tree)));
+ };
+
+ if (eval "require URI; 1;") {
+ subtest 'from URI' => sub {
+ plan tests => 5;
+ run_tests(wq(URI->new('file://' . Cwd::abs_path('t/data/foo.html'))));
+ };
+ }
+
}
-my $wq = wq('file://' . Cwd::abs_path('t/data/html5_snippet.html'));
-is scalar(grep { not ref $_ } @{$wq->{trees}}), 0, 'new_from_element skips non blessed';
-
-done_testing;
-sub test {
+sub run_tests {
$_[0]->find('.foo')->find('a')->each(sub {
is $_->text, 'foo!';
is $_->attr('href'), '/foo';
@@ -62,4 +78,3 @@ sub test {
});
like $_[0]->html, qr{href="/bar2"};
}
-
@@ -4,21 +4,33 @@ use utf8;
use Test::More;
use Web::Query;
-subtest 'get/set text' => sub {
- my $q = wq('t/data/foo.html');
- $q->find('.foo a')->text('> ok');
- is trim($q->find('.foo a')->text()), '> ok';
- is trim($q->find('.foo a')->html()), '> ok';
-};
-
-subtest 'get/set html' => sub {
- my $q = wq('t/data/foo.html');
- $q->find('.foo')->html('<B>ok</B>');
- is trim($q->find('.foo')->html()), '<b>ok</b>';
-};
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
done_testing;
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ subtest 'get/set text' => sub {
+ my $q = wq('t/data/foo.html');
+ $q->find('.foo a')->text('> ok');
+ is trim($q->find('.foo a')->text()), '> ok';
+ is trim($q->find('.foo a')->html()), '> ok';
+ };
+
+ subtest 'get/set html' => sub {
+ my $q = wq('t/data/foo.html');
+ $q->find('.foo')->html('<B>ok</B>');
+ is trim($q->find('.foo')->html()), '<b>ok</b>';
+ };
+
+}
+
sub trim {
local $_ = shift;
$_ =~ s/[\r\n]+$//;
@@ -2,46 +2,57 @@ use strict;
use warnings;
use utf8;
use Test::More;
-use Web::Query qw/wq/;
use Scalar::Util qw/refaddr/;
+use Web::Query;
-my $html = <<'...';
-<html><body><div id="foo"><div id="bar"><div id="baz"></div></div></div></body></html>
-...
-subtest 'parent' => sub {
- is wq($html)->find('#baz')->parent()->attr('id'), 'bar';
- is wq($html)->find('#bar')->parent()->attr('id'), 'foo';
-};
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
-subtest 'first/last return new instance' => sub {
- subtest 'first' => sub {
- my $q = wq($html)->find('div');
- my $first = $q->first;
- isnt(refaddr($first), refaddr($q));
+done_testing;
+
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $html = '<html><body><div id="foo"><div id="bar"><div id="baz"></div></div></div></body></html>';
+
+ subtest 'parent' => sub {
+ is wq($html)->find('#baz')->parent()->attr('id'), 'bar';
+ is wq($html)->find('#bar')->parent()->attr('id'), 'foo';
};
- subtest 'last' => sub {
- my $q = wq($html)->find('div');
- my $last = $q->last;
- isnt(refaddr($last), refaddr($q));
+
+ subtest 'first/last return new instance' => sub {
+ subtest 'first' => sub {
+ my $q = wq($html)->find('div');
+ my $first = $q->first;
+ isnt(refaddr($first), refaddr($q));
+ };
+ subtest 'last' => sub {
+ my $q = wq($html)->find('div');
+ my $last = $q->last;
+ isnt(refaddr($last), refaddr($q));
+ };
};
-};
-subtest 'size' => sub {
- is wq($html)->find('div')->size, 3;
- is wq($html)->find('body')->size, 1;
- is wq($html)->find('li')->size, 0;
- is wq($html)->find('.null')->first->size, 0;
- is wq($html)->find('.null')->last->size, 0;
-};
-subtest 'map' => sub {
- is_deeply wq($html)->find('div')->map(sub {$_[0]}), [0, 1, 2];
- is_deeply wq($html)->find('div')->map(sub {$_->attr('id')}), [qw/foo bar baz/];
-};
-subtest 'filter' => sub {
- is wq($html)->filter('div')->size, 3;
- is wq($html)->filter('body')->size, 1;
- is wq($html)->filter('li')->size, 0;
- is wq($html)->find('div')->filter(sub {$_->attr('id') =~ /ba/})->size, 2;
- is wq($html)->find('div')->filter(sub {my $i = shift; $i % 2 == 0})->size, 2;
-};
-done_testing;
+ subtest 'size' => sub {
+ is wq($html)->find('div')->size, 3;
+ is wq($html)->find('body')->size, 1;
+ is wq($html)->find('li')->size, 0;
+ is wq($html)->find('.null')->first->size, 0;
+ is wq($html)->find('.null')->last->size, 0;
+ };
+ subtest 'map' => sub {
+ is_deeply wq($html)->find('div')->map(sub {$_[0]}), [0, 1, 2];
+ is_deeply wq($html)->find('div')->map(sub {$_->attr('id')}), [qw/foo bar baz/];
+ };
+ subtest 'filter' => sub {
+ is wq($html)->filter('div')->size, 0;
+ is wq($html)->filter('body')->size, 0;
+ is wq($html)->filter('li')->size, 0;
+ is wq($html)->find('div')->filter(sub {$_->attr('id') =~ /ba/})->size, 2;
+ is wq($html)->find('div')->filter(sub {my $i = shift; $i % 2 == 0})->size, 2;
+ };
+}
@@ -2,16 +2,27 @@ use strict;
use warnings;
use utf8;
use Test::More;
-use Web::Query qw/wq/;
+use Web::Query;
-my $html = <<'...';
-<html><body><ul id="foo"><li>A</li><li>B</li><li>C</li><li>D</li><li>E</li><li>F</li></ul></body></html>
-...
-subtest 'first' => sub {
- is wq($html)->find('#foo li')->first()->text(), 'A';
-};
-subtest 'last' => sub {
- is wq($html)->find('#foo li')->last()->text(), 'F';
-};
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
done_testing;
+
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $html = '<html><body><ul id="foo"><li>A</li><li>B</li><li>C</li><li>D</li><li>E</li><li>F</li></ul></body></html>';
+
+ subtest 'first' => sub {
+ is wq($html)->find('#foo li')->first()->text(), 'A';
+ };
+ subtest 'last' => sub {
+ is wq($html)->find('#foo li')->last()->text(), 'F';
+ };
+
+}
@@ -2,9 +2,21 @@ use strict;
use warnings;
use utf8;
use Test::More;
-use Web::Query qw/wq/;
+use Web::Query;
-is(wq('<html><header>foo</header></html>')->find('header')->first->text, 'foo');
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
done_testing;
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ is(wq('<html><header>foo</header></html>')->find('header')->first->text, 'foo');
+}
+
+
@@ -5,48 +5,52 @@ use utf8;
use Test::More;
use Web::Query;
-subtest "remove and size" => sub {
- my $q = wq('t/data/foo.html');
- $q->find('.foo')->remove();
- is $q->find('.foo')->size() => 0, "all .foo are removed and cannot be found.";
-};
-
-subtest "remove and html" => sub {
- my $q = wq('t/data/foo.html');
- $q->find('.foo, .bar')->remove();
- is $q->html, q{<head><title>test1</title></head><body></body>}, ".foo and .bar are removed and not showing in html";
-};
-
-subtest "\$q->remove->end->html" => sub {
- my $q = wq('t/data/foo.html');
- is(
- $q->find('.foo, .bar')->remove->end->html,
- q{<head><title>test1</title></head><body></body>},
- "The chainning works."
- );
-};
-
-subtest "remove root elements" => sub {
- my $q = wq('t/data/foo.html');
- $q->remove;
- is $q->size, 0, "size 0 after remove";
- is join('', $q->as_html), '', "html '' after remove"; # not '<></>'
-};
-
-subtest "remove root elements after find" => sub {
- my $q = wq('t/data/foo.html');
- $q->find('html')->remove;
- is $q->size, 0, "size 0 after remove";
- is join('', $q->as_html), '', "html '' after remove"; # not '<></>'
-};
-
-subtest "remove root elements via each()" => sub {
- my $q = wq('t/data/foo.html');
- $q->find('html')->each(sub{ $_->remove });
- is $q->size, 0, "size 0 after remove";
- is join('', $q->as_html), '', "html '' after remove"; # not '<></>'
-};
-
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
done_testing;
+
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ subtest "remove and size" => sub {
+ my $q = wq('t/data/foo.html');
+ $q->find('.foo')->remove();
+ is $q->find('.foo')->size() => 0, "all .foo are removed and cannot be found.";
+ };
+
+ subtest "remove and html" => sub {
+ my $q = wq('t/data/foo.html');
+ $q->find('.foo, .bar')->remove();
+ like $q->html, qr{^<head><title>test1</title></head><body>\s*</body>$}, ".foo and .bar are removed and not showing in html";
+ };
+
+ subtest "\$q->remove->end->html" => sub {
+ my $q = wq('t/data/foo.html');
+ like(
+ $q->find('.foo, .bar')->remove->end->html,
+ qr{^<head><title>test1</title></head><body>\s*</body>$},
+ "The chainning works."
+ );
+ };
+
+ subtest "remove root elements" => sub {
+ my $q = wq('t/data/foo.html');
+ $q->remove;
+ is $q->size, 0, "size 0 after remove";
+ is join('', $q->as_html), '', "html '' after remove"; # not '<></>'
+ };
+
+ subtest "remove elements via each()" => sub {
+ my $q = wq('t/data/foo.html');
+ $q->each(sub{ $_->remove });
+ is $q->size, 0, "size 0 after remove";
+ is join('', $q->as_html), '', "html '' after remove"; # not '<></>'
+ };
+
+}
@@ -1,24 +1,37 @@
use strict;
use warnings;
-
-use Test::More tests => 4;
+use Test::More;
use Web::Query;
-my $inner = "<head></head><body><p>Hi there</p><p>How is life?</p></body>";
-my $html = "<html>$inner</html>";
-
-my $q = Web::Query->new($html);
-
-is $q->html => $inner, "html() returns inner html";
-is $q->as_html => $html, "as_html() returns element itself";
-
-my $scalar = $q->find('p')->as_html;
-my @array = $q->find('p')->as_html;
-
-is $scalar => '<p>Hi there</p>', 'called in scalar context';
-is_deeply \@array => [ '<p>Hi there</p>', q{<p>How is life?</p>} ],
- 'called in list context';
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
+
+done_testing;
+
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $inner = "<head></head><body><p>Hi there</p><p>How is life?</p></body>";
+ my $html = "<html>$inner</html>";
+
+ my $q = Web::Query->new($html);
+
+ is $q->html => $inner, "html() returns inner html";
+ is $q->as_html => $html, "as_html() returns element itself";
+
+ my $scalar = $q->find('p')->as_html;
+ my @array = $q->find('p')->as_html;
+
+ is $scalar => '<p>Hi there</p>', 'called in scalar context';
+ is_deeply \@array => [ '<p>Hi there</p>', q{<p>How is life?</p>} ],
+ 'called in list context';
+
+}
@@ -0,0 +1,59 @@
+use strict;
+use warnings;
+use utf8;
+use Test::More;
+use Web::Query;
+
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
+
+done_testing;
+
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $html = '<html><body><ul id="foo"><li>A</li><li>B</li><li>C</li><li>D</li><li>E</li><li>F</li></ul></body></html>';
+
+ subtest 'get first' => sub {
+ my $q = wq($html)->find('#foo li');
+ my $elm = $q->get(0);
+ isa_ok $elm, 'HTML::Element';
+ is wq($elm)->text(), 'A';
+ };
+ subtest 'get second' => sub {
+ my $q = wq($html)->find('#foo li');
+ my $elm = $q->get(1);
+ isa_ok $elm, 'HTML::Element';
+ is wq($elm)->text(), 'B';
+ };
+ subtest 'get last' => sub {
+ my $q = wq($html)->find('#foo li');
+ my $elm = $q->get(-1);
+ isa_ok $elm, 'HTML::Element';
+ is wq($elm)->text(), 'F';
+ };
+ subtest 'get before last' => sub {
+ my $q = wq($html)->find('#foo li');
+ my $elm = $q->get(-2);
+ isa_ok $elm, 'HTML::Element';
+ is wq($elm)->text(), 'E';
+ };
+
+ subtest 'eq first' => sub {
+ is wq($html)->find('#foo li')->eq(0)->text(), 'A';
+ };
+ subtest 'eq second' => sub {
+ is wq($html)->find('#foo li')->eq(1)->text(), 'B';
+ };
+ subtest 'eq last' => sub {
+ is wq($html)->find('#foo li')->eq(-1)->text(), 'F';
+ };
+ subtest 'eq before last' => sub {
+ is wq($html)->find('#foo li')->eq(-2)->text(), 'E';
+ };
+
+}
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use lib 'lib';
+use Test::More;
+use Web::Query;
+
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
+
+done_testing;
+
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $html = <<HTML;
+ <div class="container">
+ <div class="foo">Foo</div>
+ <div class="bar">Bar</div>
+ </div>
+HTML
+
+
+ # add($object)
+ is join('|', wq($html)->find('.foo')->add(wq($html)->find('.bar'))->as_html)
+ => '<div class="foo">Foo</div>|<div class="bar">Bar</div>', 'add($object)';
+
+
+ # add($html)
+ is join('|', wq($html)->find('.foo')->add('<div class="bar">Bar</div>')->as_html)
+ => '<div class="foo">Foo</div>|<div class="bar">Bar</div>', 'add($html)';
+
+ # add(@elements)
+ is join('|', wq($html)->find('.foo')->add(@{ wq($html)->find('div')->{trees}})->as_html)
+ => '<div class="foo">Foo</div>|<div class="foo">Foo</div>|<div class="bar">Bar</div>', 'add(@elements)';
+
+ # add($selector, $xpath_context)
+ is join('|', wq($html)->find('.foo')->add('.bar', wq($html)->{trees}->[0] )->as_html)
+ => '<div class="foo">Foo</div>|<div class="bar">Bar</div>', 'add($selector, $xpath_context)';
+}
\ No newline at end of file
@@ -6,30 +6,33 @@ use lib 'lib';
use Test::More;
use Web::Query;
-my $wq = wq(<<HTML);
-<div class="container">
- <div class="inner">Hello</div>
- <div class="inner">Goodbye</div>
-</div>
-HTML
-
-$wq->find('.inner')->add_class('foo bar inner');
-#diag $wq->as_html;
-is $wq->as_html, '<div class="container"><div class="inner foo bar">Hello</div><div class="inner foo bar">Goodbye</div></div>', 'add_class("foo bar inner")';
-
-
-$wq = wq(<<HTML);
-<div class="container">
- <div class="inner">Hello</div>
- <div class="inner">Goodbye</div>
-</div>
-HTML
-
-$wq->find('.inner')->add_class(sub{
- my ($i, $current, $el) = @_;
- return "foo-$i bar";
-});
-
-is $wq->as_html, '<div class="container"><div class="inner foo-0 bar">Hello</div><div class="inner foo-1 bar">Goodbye</div></div>', 'add_class(CODE)';
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
done_testing;
+
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $html = '<div class="container"><div class="inner">Hello</div><div class="inner">Goodbye</div></div>';
+
+ my $wq = wq($html);
+
+ $wq->find('.inner')->add_class('foo bar inner');
+ is $wq->as_html, '<div class="container"><div class="inner foo bar">Hello</div><div class="inner foo bar">Goodbye</div></div>', 'add_class("foo bar inner")';
+
+ # add_class(CODE)
+ $wq = wq($html);
+
+ $wq->find('.inner')->add_class(sub{
+ my ($i, $current, $el) = @_;
+ return "foo-$i bar";
+ });
+
+ is $wq->as_html, '<div class="container"><div class="inner foo-0 bar">Hello</div><div class="inner foo-1 bar">Goodbye</div></div>', 'add_class(CODE)';
+
+}
@@ -1,17 +1,24 @@
#!/usr/bin/env perl
-
use strict;
use warnings;
use lib 'lib';
-use Test::More 'no_plan';
+use Test::More;
use Web::Query;
-my $html = <<HTML;
-<div class="container">
- <div class="inner">Hello</div>
- <div class="inner">Goodbye</div>
-</div>
-HTML
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
+
+done_testing;
+
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $html = '<div class="container"><div class="inner">Hello</div><div class="inner">Goodbye</div></div>';
-is wq($html)->find('.inner')->after('<p>Test</p>')->end->as_html,
- '<div class="container"><div class="inner">Hello</div><p>Test</p><div class="inner">Goodbye</div><p>Test</p></div>', 'after';
+ is wq($html)->find('.inner')->after('<p>Test</p>')->end->as_html,
+ '<div class="container"><div class="inner">Hello</div><p>Test</p><div class="inner">Goodbye</div><p>Test</p></div>', 'after';
+}
\ No newline at end of file
@@ -5,14 +5,20 @@ use lib 'lib';
use Test::More;
use Web::Query;
-my $html = <<HTML;
-<div class="container">
- <div class="inner">Hello</div>
- <div class="inner">Goodbye</div>
-</div>
-HTML
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
-is wq($html)->find('.inner')->append('<p>Test</p>')->end->as_html,
- '<div class="container"><div class="inner">Hello<p>Test</p></div><div class="inner">Goodbye<p>Test</p></div></div>', 'append';
+done_testing;
-done_testing;
\ No newline at end of file
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $html = '<div class="container"><div class="inner">Hello</div><div class="inner">Goodbye</div></div>';
+
+ is wq($html)->find('.inner')->append('<p>Test</p>')->end->as_html,
+ '<div class="container"><div class="inner">Hello<p>Test</p></div><div class="inner">Goodbye<p>Test</p></div></div>', 'append';
+}
\ No newline at end of file
@@ -1,17 +1,24 @@
#!/usr/bin/env perl
-
use strict;
use warnings;
use lib 'lib';
-use Test::More 'no_plan';
+use Test::More;
use Web::Query;
-my $html = <<HTML;
-<div class="container">
- <div class="inner">Hello</div>
- <div class="inner">Goodbye</div>
-</div>
-HTML
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
+
+done_testing;
-is wq($html)->find('.inner')->before('<p>Test</p>')->end->as_html,
- '<div class="container"><p>Test</p><div class="inner">Hello</div><p>Test</p><div class="inner">Goodbye</div></div>', 'before';
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $html = '<div class="container"><div class="inner">Hello</div><div class="inner">Goodbye</div></div>';
+
+ is wq($html)->find('.inner')->before('<p>Test</p>')->end->as_html,
+ '<div class="container"><p>Test</p><div class="inner">Hello</div><p>Test</p><div class="inner">Goodbye</div></div>', 'before';
+}
\ No newline at end of file
@@ -3,8 +3,19 @@ use warnings;
use Test::More;
use Web::Query;
-my $html = '<p><b>Hi</b><i>there</i><u>world</u></p>';
-
-is wq($html)->clone->as_html, $html, 'clone';
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
done_testing;
+
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $html = '<p><b>Hi</b><i>there</i><u>world</u></p>';
+ is wq($html)->clone->as_html, $html, 'clone';
+}
+
@@ -0,0 +1,25 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Web::Query;
+
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
+
+done_testing;
+
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $html = "<div><p>foo</p></div><div><p>bar</p></div><div><span>baz</span></div>";
+
+ is join('|', wq($html)->contents->as_html), '<p>foo</p>|<p>bar</p>|<span>baz</span>', 'contents()';
+ is join('|', wq($html)->contents('p')->as_html), '<p>foo</p>|<p>bar</p>', 'contents("p")';
+
+ is wq('<p>foo</p>')->contents->as_html => 'foo';
+}
@@ -1,3 +1 @@
-<a>foo</a>
-<header>bar</header>
-<div>baz</div>
\ No newline at end of file
+<a>foo</a><header>bar</header><div>baz</div>
@@ -5,16 +5,23 @@ use lib 'lib';
use Test::More;
use Web::Query;
-my $wq = wq(<<HTML);
-<div class="container">
- <div class="inner">Hello</div>
- <div class="inner">Goodbye</div>
-</div>
-HTML
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
-my $detached = $wq->find('.inner')->detach;
-is join('', $detached->as_html), '<div class="inner">Hello</div><div class="inner">Goodbye</div>', 'detach - retval';
-is $wq->as_html, '<div class="container"></div>', 'detach - original object modified';
-is $detached->find('.inner')->size, 2, 'detached can find() root elements';
+done_testing;
-done_testing;
\ No newline at end of file
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $wq = wq('<div class="container"><div class="inner"><p>Hello</p></div><div class="inner"><p>Goodbye</p></div></div>');
+
+ my $detached = $wq->find('.inner')->detach;
+ is join('', $detached->as_html), '<div class="inner"><p>Hello</p></div><div class="inner"><p>Goodbye</p></div>', 'detach - retval';
+ is $wq->as_html, '<div class="container"></div>', 'detach - original object modified';
+ is $detached->find('p')->size, 2, 'find() works on detached elements';
+
+}
@@ -0,0 +1,32 @@
+use strict;
+use warnings;
+use Test::More;
+use Web::Query;
+
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
+
+done_testing;
+
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $html = <<HTML;
+ <div class="container">
+ <div class="inner">Hello</div>
+ </div>
+
+ <div>
+ <div class="inner">Hello</div>
+ </div>
+HTML
+
+ is wq($html)->filter('span')->size, 0;
+ is wq($html)->filter('div.container')->size, 1;
+ is wq($html)->filter('div')->size, 2;
+
+}
\ No newline at end of file
@@ -1,24 +1,35 @@
use strict;
use warnings;
-
-use Test::More tests => 3;
-
+use Test::More;
use Web::Query;
-my $wq = wq(<<HTML);
-
-<div class="container">
- <div class="inner">Hello</div>
-</div>
-
-<div class="container">
- <div class="inner">Hello</div>
-</div>
-
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
+
+done_testing;
+
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $wq = wq(<<HTML);
+
+ <div class="container">
+ <div class="inner">Hello</div>
+ </div>
+
+ <div class="container">
+ <div class="inner">Hello</div>
+ </div>
+
HTML
+
+ is $wq->find('.inner')->size, 2, 'find() on multiple tree object';
+
+ is wq('<html>1</html>')->find('html')->size, 0, 'find() does not include root elements';
+ is(wq('<div>foo</div><div>bar</div>')->find('div')->size, 0);
-is $wq->find('.inner')->size, 2, 'find() on multiple tree object';
-
-is wq('<html>1</html>')->find('html')->size, 1, 'find() includes root elements';
-is(wq('<div>foo</div><div>bar</div>')->find('div')->size, 2);
-
+}
@@ -5,14 +5,20 @@ use lib 'lib';
use Test::More;
use Web::Query;
-my $wq = wq(<<HTML);
-<div class="container">
- <div class="inner">Hello</div>
- <div class="inner">Goodbye</div>
-</div>
-HTML
-
-is $wq->find('.inner')->has_class('inner'), 1, 'has_class - positive';
-is $wq->find('.inner')->has_class('nahh'), undef, 'has_class - negative';
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
done_testing;
+
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $wq = wq('<div class="container"><div class="inner">Hello</div><div class="inner">Goodbye</div></div>');
+
+ is $wq->find('.inner')->has_class('inner'), 1, 'has_class - positive';
+ is $wq->find('.inner')->has_class('nahh'), undef, 'has_class - negative';
+}
@@ -5,16 +5,20 @@ use lib 'lib';
use Test::More;
use Web::Query;
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
-my $wq = wq(<<HTML);
-<div class="container">
- <div class="inner">Hello</div>
- <div class="inner">Goodbye</div>
-</div>
-HTML
+done_testing;
-wq('<p>Test</p>')->insert_after($wq->find('.inner'));
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
-is $wq->as_html, '<div class="container"><div class="inner">Hello</div><p>Test</p><div class="inner">Goodbye</div><p>Test</p></div>', 'insert_after';
-
-done_testing;
\ No newline at end of file
+ my $wq = wq('<div class="container"><div class="inner">Hello</div><div class="inner">Goodbye</div></div>');
+
+ wq('<p>Test</p>')->insert_after($wq->find('.inner'));
+ is $wq->as_html, '<div class="container"><div class="inner">Hello</div><p>Test</p><div class="inner">Goodbye</div><p>Test</p></div>', 'insert_after';
+}
\ No newline at end of file
@@ -5,16 +5,20 @@ use lib 'lib';
use Test::More;
use Web::Query;
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
-my $wq = wq(<<HTML);
-<div class="container">
- <div class="inner">Hello</div>
- <div class="inner">Goodbye</div>
-</div>
-HTML
+done_testing;
-wq('<p>Test</p>')->insert_before($wq->find('.inner'));
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
-is $wq->as_html, '<div class="container"><p>Test</p><div class="inner">Hello</div><p>Test</p><div class="inner">Goodbye</div></div>', 'insert_before';
-
-done_testing;
\ No newline at end of file
+ my $wq = wq('<div class="container"><div class="inner">Hello</div><div class="inner">Goodbye</div></div>');
+
+ wq('<p>Test</p>')->insert_before($wq->find('.inner'));
+ is $wq->as_html, '<div class="container"><p>Test</p><div class="inner">Hello</div><p>Test</p><div class="inner">Goodbye</div></div>', 'insert_before';
+}
\ No newline at end of file
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+use Test::More;
+use Web::Query;
+
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
+
+done_testing;
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq"};
+
+ my $wq = wq(<<HTML);
+
+ <div class="container">
+ <div class="d1">Hello</div>
+ <div class="d2">World</div>
+ </div>
+
+ <div class="container">
+ <div class="d1">Hello</div>
+ <div class="d2">World</div>
+ </div>
+HTML
+
+ my $elem = $wq->find('.d1')->next;
+ is $elem->size, 2;
+ is $elem->attr('class'), 'd2', 'next';
+}
@@ -5,14 +5,22 @@ use lib 'lib';
use Test::More;
use Web::Query;
-my $html = <<HTML;
-<div class="container">
- <div class="inner">Hello</div>
- <div class="inner">Goodbye</div>
-</div>
-HTML
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
-is wq($html)->find('.inner')->prepend('<p>Test</p>')->end->as_html,
- '<div class="container"><div class="inner"><p>Test</p>Hello</div><div class="inner"><p>Test</p>Goodbye</div></div>', 'prepend';
+done_testing;
-done_testing;
\ No newline at end of file
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+
+ my $html = '<div class="container"><div class="inner">Hello</div><div class="inner">Goodbye</div></div>';
+
+ is wq($html)->find('.inner')->prepend('<p>Test</p>')->end->as_html,
+ '<div class="container"><div class="inner"><p>Test</p>Hello</div><div class="inner"><p>Test</p>Goodbye</div></div>', 'prepend';
+
+}
\ No newline at end of file
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+use Test::More;
+use Web::Query;
+
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
+
+done_testing;
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq"};
+
+ my $wq = wq(<<HTML);
+
+ <div class="container">
+ <div class="d1">Hello</div>
+ <div class="d2">World</div>
+ </div>
+
+ <div class="container">
+ <div class="d1">Hello</div>
+ <div class="d2">World</div>
+ </div>
+HTML
+
+ my $elem = $wq->find('.d2')->prev;
+ is $elem->size, 2;
+ is $elem->attr('class'), 'd1', 'previous';
+}
@@ -5,26 +5,27 @@ use lib 'lib';
use Test::More;
use Web::Query;
-my $wq = wq(<<HTML);
-<div class="container">
- <div class="inner foo bar">Hello</div>
- <div class="inner foo bar">Goodbye</div>
-</div>
-HTML
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
-my $rv = $wq->find('.inner')->remove_class('foo bar');
-isa_ok $rv, 'Web::Query', 'remove_class returned';
-#diag $wq->as_html;
-is $wq->as_html, '<div class="container"><div class="inner">Hello</div><div class="inner">Goodbye</div></div>', 'remove_class("foo bar")';
+done_testing;
-$wq = wq(<<HTML);
-<div class="container">
- <div class="inner foo bar">Hello</div>
- <div class="inner foo bar">Goodbye</div>
-</div>
-HTML
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
-$wq->find('.inner')->remove_class(sub{ 'foo bar' });
-is $wq->as_html, '<div class="container"><div class="inner">Hello</div><div class="inner">Goodbye</div></div>', 'remove_class(CODE)';
+ my $wq = wq('<div class="container"><div class="inner foo bar">Hello</div><div class="inner foo bar">Goodbye</div></div>');
+ my $rv = $wq->find('.inner')->remove_class('foo bar');
+
+ isa_ok $rv, 'Web::Query', 'remove_class returned';
+ is $wq->as_html, '<div class="container"><div class="inner">Hello</div><div class="inner">Goodbye</div></div>', 'remove_class("foo bar")';
+
+ $wq = wq('<div class="container"><div class="inner foo bar">Hello</div><div class="inner foo bar">Goodbye</div></div>');
+ $wq->find('.inner')->remove_class(sub{ 'foo bar' });
+
+ is $wq->as_html, '<div class="container"><div class="inner">Hello</div><div class="inner">Goodbye</div></div>', 'remove_class(CODE)';
-done_testing;
\ No newline at end of file
+}
\ No newline at end of file
@@ -1,24 +1,41 @@
use strict;
use warnings;
-
-use Test::More tests => 4;
-
-use Web::Query;
-
-my $html = '<p><b>Hi</b><i>there</i><u>world</u></p>';
-
-is wq($html)->find('b')->replace_with('<strong>Hello</strong>')->end->as_html
- => '<p><strong>Hello</strong><i>there</i><u>world</u></p>';
-
-my $q = wq( $html );
-
-is $q->find('u')->replace_with($q->find('b'))->end->as_html
- => '<p><i>there</i><b>Hi</b></p>';
-
-is wq($html)->find('p *')->replace_with(sub {
- my $i = $_->text;
- return "<$i></$i>";
-} )->end->as_html => '<p><hi></hi><there></there><world></world></p>';
-
-is wq($html)->find('p *')->replace_with( '<blink />' )->end->as_html
- => '<p><blink></blink><blink></blink><blink></blink></p>';
+use Test::More;
+
+my @modules = qw/ Web::Query Web::Query::LibXML /;
+
+plan tests => scalar @modules;
+
+subtest $_ => sub { test($_) } for @modules;
+
+sub test {
+ my $class = shift;
+
+ eval "require $class; 1"
+ or plan skip_all => "couldn't load $class";
+
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $html = '<p><b>Hi</b><i>there</i><u>world</u></p>';
+
+ is wq($html)->find('b')->replace_with('<strong>Hello</strong>')->end->as_html
+ => '<p><strong>Hello</strong><i>there</i><u>world</u></p>';
+
+ my $q = wq( $html );
+
+ is $q->find('u')->replace_with($q->find('b'))->end->as_html
+ => '<p><i>there</i><b>Hi</b></p>';
+
+ is wq($html)->find('*')->replace_with(sub {
+ my $i = $_->text;
+ return "<$i></$i>";
+ } )->end->as_html => '<p><hi></hi><there></there><world></world></p>';
+
+ is wq($html)->find('*')->replace_with( '<blink />' )->end->as_html
+ => '<p><blink></blink><blink></blink><blink></blink></p>';
+
+ is wq('<p><span>foo</span></p>')->find('span')
+ ->replace_with(sub { $_->contents })
+ ->end->as_html => '<p>foo</p>';
+}
@@ -3,11 +3,23 @@ use warnings;
use Test::More;
use Web::Query;
-my $source = '<!-- header --><header></header>';
+test('Web::Query');
+test('Web::Query::LibXML') if eval "require Web::Query::LibXML; 1";
-is join('', wq($source)->as_html), $source, 'constructor stores comments';
+done_testing;
-is wq($source)->find('header')->html('<!-- comment -->')->as_html, '<header><!-- comment --></header>', 'html() stores comments';
+
+sub test {
+ my $class = shift;
+ diag "testing $class";
+ no warnings 'redefine';
+ *wq = \&{$class . "::wq" };
+
+ my $source = '<div><!-- header --><header></header></div>';
+
+ is join('', wq($source)->as_html), $source, 'constructor stores comments';
+
+ is wq($source)->find('header')->html('<p><!-- comment --></p>')->as_html, '<header><p><!-- comment --></p></header>', 'html() stores comments';
-done_testing;
\ No newline at end of file
+}
\ No newline at end of file
@@ -7,8 +7,8 @@ use Web::Query;
binmode Test::More->builder->$_, ":utf8" for qw/output failure_output todo_output/;
my @res;
-wq('http://livedoor-search.naver.jp/search?c=ld_top_sb&ie=utf-8&q=dankogai&search_btn=1')
- ->find('.MdSRList01 h2')
+wq('http://64p.org/')
+ ->find('.description')
->each(sub {
my $i = shift;
push @res, $_->text;