scratchpad
dfaure
<h1>Form data post test for WWW.Mechanize::Firefox</h1>
<code>
#!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->{streamPostData} = $self->repl->declare(<<'JS');
function(dataString, charset) {
// POST method requests must wrap the encoded text in a MIME stream
const Cc = Components.classes;
const Ci = Components.interfaces;
var stringStream = Cc["@mozilla.org/io/string-input-stream;1"].
createInstance(Ci.nsIStringInputStream);
if ("data" in stringStream) // Gecko 1.9 or newer
stringStream.data = dataString;
else // 1.8 or older
stringStream.setData(dataString, dataString.length);
var postData = Cc["@mozilla.org/network/mime-input-stream;1"].
createInstance(Ci.nsIMIMEInputStream);
var contentType = "application/x-www-form-urlencoded";
if (charset)
contentType += "; charset=" + charset;
postData.addHeader("Content-Type", contentType);
postData.addContentLength = true;
postData.setData(stringStream);
return postData;
}
JS
bless($self, $class); # rebless to our class
}
sub post {
my ($self, $url, %options) = @_;
my $b = $self->tab->{linkedBrowser};
$self->clear_current_form;
my $flags = 0;
if ($options{no_cache}) {
$flags = $self->repl->constant('nsIWebNavigation.LOAD_FLAGS_BYPASS_CACHE');
};
if (! exists $options{synchronize}) {
$options{synchronize} = $self->events;
};
if( !ref $options{synchronize}) {
$options{synchronize} = $options{synchronize}
? $self->events
: []
};
$self->_sync_call($options{synchronize}, sub {
my $postData = $self->{streamPostData}($options{data}, $options{charset});
$b->loadURIWithFlags(''.$url, $flags, undef, $options{charset}, $postData);
});
}
}
################################################################################
#my $mech = WWW::Mechanize::Firefox->new(activate => 1);
my $mech = TweakedBrowser->new(activate => 1);
$mech->autoclose_tab(0);
my $url = 'http://httpbin.org/post';
my $post_data = "foo=bar&baz=xuux";
$mech->post($url, data => $post_data, charset => 'utf-8');
</code>
<hr/>
<h1>XPath test for WWW.Mechanize::Firefox</h1>
[https://developer.mozilla.org/en-US/docs/DOM/document.evaluate]
<code>
#!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');
<html>
<head>
<title>Hello Firefox!</title>
</head>
<body>
<h1>Hello <b>World</b>!</h1>
<p id='paragraph'>Hello <b>WWW::Mechanize::Firefox</b> Goob bye</p>
<ul id='some_items'>
<li>Item #1</li>
<li>Item #2</li>
</ul>
<ul class='our_items'>
<li>Item #3</li>
<li>Item #4</li>
</ul>
<ul id='more_items'>
<li>Item #5</li>
</ul>
<ul class='our_items'>
<li>Item #6</li>
</ul>
<ul id='other_items'>
<li>Item #7</li>
<li>Item #8</li>
<li>Item #9</li>
</ul>
</body>
</html>
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)']);
}
</code>
<hr />
<i>Very old stuff below...</i>
<p>My Perlmonks CSS:</p>
<code>
#monkbar { display: none; }
h3.other, h3.superdoc, h3.categorized_answer, h3.categorized_question {
font-size: 200%;
font-style: italic;
font-family: Georgia, serif;
padding: 10px;
}
pre, tt {
font-family: "Bitstream Vera Sans Mono", monospace;
}
.topnavmenu, #replies_table font { font-size: 100%; }
textarea {
width: 100%;
height: 25em;
}
body {
color: black;
background-color: rgb(240,240,240); }
a { color: rgb(39,78,144); }
a:link { text-decoration: underline; }
a:hover, a.titlebar:hover { text-decoration: underline; }
a:visited, a.titlebar:visited { text-decoration: none; }
td { color: black; }
tr.titlebar { background-color: rgb(100,135,220); }
td.titlebar { color: white; }
tr.section_title {
color: white;
background-color: rgb(0,51,153); }
td.section_title {
color: white;
background-color: rgb(0,51,153); }
tr.post_head, tr.highlight {
background-color: /*rgb(140,170,230)*/ rgb(212,208,200); }
.code {
border: 1px solid #666;
padding: 10px;
color: rgb(39,78,144);
background-color: white;
display: block;
}
table.nodelet_container { background-color: rgb(0,51,153); }
tbody.nodelet th, th.nodehead {
color: white;
background-color: rgb(0,51,153);
/* color: rgb(39,78,144);
background-color: rgb(140,170,230);*/ }
tbody.nodelet td, td.nodebody {
color: rgb(39,78,144);
background-color: rgb(240,240,240); }
table#replies_table {
background-color: /*rgb(240,240,240)*/transparent;
}
table#reply_tables th a {
background-color: rgb(0,51,153); }
table#replies_table th font {
color: rgb(253,160,91);
}
table#replies_table td[colspan="2"] {
background-color: rgb(212,208,200);
}
table#replies_table td {
background-color: transparent;
}
#approval_nodelet input[type="text"] {
background-color: rgb(255,200,200);
}
a[href="http://pair.com/"] { display: none; }
</code>
<hr />
<p align="center"><traduction en cours/translation in progress></p>
<h1>FAQ PerlMonks (fr_FR)</h1>
<ul>
<li><a name="About_PM"><i>A propos de PM</i></a></li>
<ul>
<li>[id://367914]</li>
<li>[id://368383]</li>
<li><i>Who uses PM?</i></li>
<li>[id://368399]</li>
<li>[id://368644]</li>
<li>[id://370152]</li>
<li>[id://370749]</li>
<li>[id://402037]</li>
<li>What does SoPW mean? (or Guide to PerlMonks Abbreviations)</li>
</ul>
<li><a name="Getting_Started"><i>Bien démarrer</i></a></li>
<ul>
<li>Creating an account on PerlMonks</li>
<li>Choosing a username</li>
<li>Changing your password</li>
<li>Retrieving a forgotten username or password</li>
<li>Logging on to Perl Monks</li>
<li>How do I change my home node?</li>
<li>How do I change my preferences?</li>
<li><i>Customising PerlMonks CSS</i></li>
<li>What XML generators are currently available on PerlMonks?</li>
<li>Why are categorized questions and answers displayed separately from the rest of my writeups?</li>
</ul>
<li><a name="Searching_PerlMonks">Rechercher PerlMonks</a></li>
<ul>
<li>Search</li>
<li>Super Search</li>
<li>thepen - Perlmonk's static mirror</li>
<li>Google</li>
</ul>
<li><a name="Making_a_Post_on_PM"><i>Publier sur PM</i></a></li>
<ul>
<li>I want to ask a question of the Perl Monks; where do I start?</li>
<li>Where do I post X?</li>
<li>How do I post a question effectively?</li>
<li>How do I compose an effective node title?</li>
<li>Can't See Your Post?</li>
<li>Writeup Formatting Tips</li>
<li>How do I change/delete my post?</li>
<li>How does editing work in the Q&A Sections?</li>
<li>How does editing work in the Perl Monks FAQ section?</li>
<li>Why did I get downvoted?</li>
<li>What shortcuts can I use for linking to other information?</li>
</ul>
<li><a name="Linking"><i>Liaisons</i></a></li>
<ul>
<li>How do I link to nodes on this site by title?</li>
<li>How do I link to a node on this site by number?</li>
<li>There is more than one node with the same name. How do I link to the one that I want?</li>
<li>How do I link to modules on CPAN?</li>
<li>How do I link to a Google search?</li>
<li>How do I link to a book by ISBN?</li>
</ul>
<li><a name="PM_Tour"><i>Visite guidé de PM</i></a></li>
<ul>
<li><i>The Monastery Gates</i></li>
<li><i>Snippets</i></li>
<li><i>Cool Uses for Perl</i></li>
<li><i>Poetry</i></li>
<li><i>Code</i></li>
<li><i>Obfuscation</i></li>
<li><i>Q&A</i></li>
<li><i>Library</i></li>
<li><i>Seekers of Perl Wisdom</i></li>
<li><i>Craft</i></li>
<li><i>Meditations</i></li>
<li><i>Perl Monks Discussion</i></li>
<li><i>Perl News</i></li>
<li><i>Reviews</i></li>
<li><i>Tutorials</i></li>
<li><i>Newest Nodes</i></li>
<li><i>Offering Plate</i></li>
<li><i>Chatterbox</i></li>
<li><i>Poll</i></li>
<li><i>Scratch Pad</i></li>
</ul>
<li><a name="Chatterbox"><i>Boîte à discussions</i></a></li>
<ul>
<li>Chatterbox FAQ]</li>
<li>What is the Chatterbox?</li>
<li><i>Is the chatterbox logged?</i></li>
<li>Using the Chatterbox: Public Messaging</li>
<li>Using the Chatterbox: Private Messaging</li>
<li>Using the Chatterbox: URLs, Special Characters, and Code</li>
<li>Using the Chatterbox: Linking</li>
<li>Other CB Clients</li>
</ul>
<li><a name="All_in_Moderation"><i>Tout en Modération</i></a></li>
<ul>
<li>What is moderation?</li>
<li>Who can moderate?]</li>
<li>What is reputation?</li>
<li>Voting Guidelines (or 'How should I spend my votes?')</li>
<li>How do I moderate?</li>
<li>What nodes should/should not be frontpaged?</li>
<li>What is Consideration?</li>
<li>Who can consider a node?</li>
<li>How to use the moderation system</li>
<li>How does Nodes to Consider work?</li>
</ul>
<li><a name="The_Pilgrimage_towards_Sainthood">The Pilgrimage towards Sainthood</a></li>
<ul>
<li>[id://17375|Level powers]</li>
<li>[id://5938|Voting/Experience System]</li>
<li>[id://21211|Level 1: Initiate ( or 'When you first join' )]</li>
<li>[id://17643|Level 2: Novice]</li>
<li>[id://17381]</li>
<li>Level 3: Acolyte</li>
<li>[id://198665|Level 4: Scribe]</li>
<li>[id://17644|Level 5: Monk]</li>
<li>[id://17645|Level 6: Friar]</li>
<li>Level 7: Abbot</li>
<li>Level 8: Bishop</li>
<li>Level 9: Pontiff</li>
<li>[id://244022|Level 10: Saint]</li>
</ul>
<li><a name="Orders_of_Monks">Orders of Monks - [id://238736]</a></li>
<ul>
<li><a href="?node=238736#gods">Gods</a></li>
<li><a href="?node=238736#pmdev">PMDev</a></li>
<li><a href="?node=238736#developers">Developers</a></li>
<li><a href="?node=238736#powerusers">Power Users</a></li>
<li><a href="?node=238736#editors">Janitors</a></li>
<li><a href="?node=238736#qandaeditors">QandAEditors</a></li>
<li><a href="?node=238736#sitedocmanagers">SiteDocManagers</a></li>
<li><a href="?node=238736#sitedocclan">SiteDocClan</a></li>
<li><a href="?node=238736#cabal">Cabal</a></li>
</ul>
<li><a name="PM_Nodelets">PM Nodelets - [id://239623]</a></li>
<ul>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#atbest">All-Time Best</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#approval">Approval Nodelet</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#cpan">CPAN nodelet</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#chatterbox">Chatterbox</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#dbest">Daily Best</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#everything">Everything Developer</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#function">Function Nodelet</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#info">Information</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#keyword">Keyword Nodelet</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#leftovers">Leftovers</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#nodestatus">Node Status</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#navigator">Node navigator</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#nodelet">Nodelet Nodelet</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#users">Other Users</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#personal">Personal Nodelet</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#sections">Sections</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#ticktock">Tick tock</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#voting">Voting Booth</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#weekly">Weekly Best</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#xp">XP Nodelet</a></li>
<li><a title='This document is in Beta proofing. Send any comments via /msg SiteDocClan' href="?node_id=239623#input">Your Input</a></li>
</ul>
<li><a name="Outside_(External)_Links">Outside (External) Links</a></li>
<ul>
<li>[id://236970|Installing and adding to Perl]</li>
<li>[id://236804|Code Editors]</li>
<li>[id://236975|Reference Material]</li>
<li>[id://236977|People and Places]</li>
<li>[id://236978|Miscellaneous]</li>
</ul>
</ul>