#!perl
use strict;
use warnings;
use diagnostics;
use Data::Dumper;
{ ### Browser specialization ###################################################
package TweakedBrowser;
use parent 'WWW::Mechanize::Firefox';
sub new {
my ($class, %args) = @_;
my $self = $class->SUPER::new(%args); # call superclass ctor
$self->{wrapped_xpath} = $self->repl->declare(<<'JS');
function(doc, q, ref, type) {
var xpr = doc.evaluate(q, ref, null, type, null);
var r = { resultType: xpr.resultType };
switch(xpr.resultType) {
case XPathResult.NUMBER_TYPE:
r.numberValue = xpr.numberValue;
break;
case XPathResult.STRING_TYPE:
r.stringValue = xpr.stringValue;
break;
case XPathResult.BOOLEAN_TYPE:
r.booleanValue = xpr.booleanValue;
break;
case XPathResult.UNORDERED_NODE_ITERATOR_TYPE:
case XPathResult.ORDERED_NODE_ITERATOR_TYPE:
r.nodeSet = [];
var n;
while (n = xpr.iterateNext()) {
r.nodeSet.push(n);
}
break;
case XPathResult.UNORDERED_NODE_SNAPSHOT_TYPE:
case XPathResult.ORDERED_NODE_SNAPSHOT_TYPE:
r.nodeSet = [];
for (var i = 0 ; i < xpr.snapshotLength; i++ ) {
r.nodeSet[i] = xpr.snapshotItem(i);
}
break;
case XPathResult.ANY_UNORDERED_NODE_TYPE:
case XPathResult.FIRST_ORDERED_NODE_TYPE:
r.singleNodeValue = xpr.singleNodeValue;
break;
default:
break;
}
return r;
}
JS
$self->{XpathResultTypes} = {
ANY_TYPE => $self->repl->constant('XPathResult.ANY_TYPE'),
NUMBER_TYPE => $self->repl->constant('XPathResult.NUMBER_TYPE'),
STRING_TYPE => $self->repl->constant('XPathResult.STRING_TYPE'),
BOOLEAN_TYPE => $self->repl->constant('XPathResult.BOOLEAN_TYPE'),
UNORDERED_NODE_ITERATOR_TYPE => $self->repl->constant('XPathResult.UNORDERED_NODE_ITERATOR_TYPE'),
ORDERED_NODE_ITERATOR_TYPE => $self->repl->constant('XPathResult.ORDERED_NODE_ITERATOR_TYPE'),
UNORDERED_NODE_SNAPSHOT_TYPE => $self->repl->constant('XPathResult.UNORDERED_NODE_SNAPSHOT_TYPE'),
ORDERED_NODE_SNAPSHOT_TYPE => $self->repl->constant('XPathResult.ORDERED_NODE_SNAPSHOT_TYPE'),
ANY_UNORDERED_TYPE => $self->repl->constant('XPathResult.ANY_UNORDERED_NODE_TYPE'),
FIRST_ORDERED_NODE_TYPE => $self->repl->constant('XPathResult.FIRST_ORDERED_NODE_TYPE'),
};
$self->{XpathResultTypenames} = { };
while(my ($n, $c) = each %{$self->{XpathResultTypes}}) {
$self->{XpathResultTypenames}{$c} = $n;
}
bless($self, $class); # rebless to our class
}
sub xpathResultType { $_[0]->{XpathResultTypenames}{$_[1]}; }
sub xpathResult { $_[0]->{XpathResultTypes}{$_[1]}; }
sub wrapped_xpath {
my ($self, $query, %options) = @_;
if ($options{node}) {
$options{document} ||= $options{node}->{ownerDocument};
#warn "Have node, searching below node";
} else {
$options{document} ||= $self->document;
$options{node} = $options{document};
};
$options{type} ||= $self->{XpathResult}{ANY_TYPE};
$self->{wrapped_xpath}($options{document}, $query, $options{node}, $options{type});
}
}
################################################################################
#my $mech = WWW::Mechanize::Firefox->new(activate => 1);
my $mech = TweakedBrowser->new(activate => 1);
$mech->autoclose_tab(0);
$mech->update_html(<<'HTML');
Hello Firefox!
Hello World!
Hello WWW::Mechanize::Firefox Goob bye
HTML
test($mech, '//p');
test($mech, '//p/text()');
test($mech, 'substring(//p,1,4)'); # expected String: Hell
test($mech, 'string-length(//p)'); # expected Number: 38
test($mech, '//ul[@class="our_items"]');
sub test {
my ($mech, $xpq, %opts) = @_;
test_xpath($mech, $xpq, %opts);
test_wrapped($mech, $xpq, %opts);
print "#" x 80, "\n";
}
sub test_xpath {
my ($mech, $xpq, %opts) = @_;
my @xpr;
eval { @xpr = $mech->xpath($xpq, %opts); };
my %results = (
query => $xpq,
exception => $@,
innerHTML => scalar(@xpr) ? [ map { $_->{innerHTML} } @xpr ] : undef,
textContent => scalar(@xpr) ? [ map { $_->{textContent} } @xpr ] : undef,
nodeValue => scalar(@xpr) ? [ map { $_->{nodeValue} } @xpr ] : undef
);
print Data::Dumper->Dump([\%results], ['results(xpath)']);
}
sub test_wrapped {
my ($mech, $xpq, %opts) = @_;
my $xpr;
eval { $xpr = $mech->wrapped_xpath($xpq, %opts); };
my %results = (
query => $xpq,
exception => $@,
resultType => $xpr->{resultType} . " (" . $mech->xpathResultType($xpr->{resultType}) . ")",
numberValue => ($xpr->{resultType} == $mech->xpathResult('NUMBER_TYPE')) ? $xpr->{numberValue} : undef,
stringValue => ($xpr->{resultType} == $mech->xpathResult('STRING_TYPE')) ? $xpr->{stringValue} : undef,
booleanValue => ($xpr->{resultType} == $mech->xpathResult('BOOLEAN_TYPE')) ? $xpr->{booleanValue} : undef,
);
my @nodes = @{$xpr->{nodeSet}} if $xpr->{nodeSet};
$results{nodeCount} = scalar @nodes;
$results{innerHTML} = scalar(@nodes) ? [ map { $_->{innerHTML} } @nodes ] : undef;
$results{textContent} = scalar(@nodes) ? [ map { $_->{textContent} } @nodes ] : undef;
$results{nodeValue} = scalar(@nodes) ? [ map { $_->{nodeValue} } @nodes ] : undef;
if ($xpr->{singleNodeValue}) {
$results{innerHTML} = $xpr->{innerHTML};
$results{textContent} = $xpr->{textContent};
$results{nodeValue} = $xpr->{nodeValue};
}
print Data::Dumper->Dump([\%results], ['results(wrapped_xpath)']);
}