Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

dfaure's scratchpad

by dfaure (Chaplain)
on Jun 02, 2004 at 06:25 UTC ( #359209=scratchpad: print w/ replies, xml ) Need Help??

Form data post test for WWW.Mechanize::Firefox

#!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 s +tream 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_BYPA +SS_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');

XPath test for WWW.Mechanize::Firefox

https://developer.mozilla.org/en-US/docs/DOM/document.evaluate
#!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('XPathResu +lt.ANY_TYPE'), NUMBER_TYPE => $self->repl->constant('XPathResu +lt.NUMBER_TYPE'), STRING_TYPE => $self->repl->constant('XPathResu +lt.STRING_TYPE'), BOOLEAN_TYPE => $self->repl->constant('XPathResu +lt.BOOLEAN_TYPE'), UNORDERED_NODE_ITERATOR_TYPE => $self->repl->constant('XPathResu +lt.UNORDERED_NODE_ITERATOR_TYPE'), ORDERED_NODE_ITERATOR_TYPE => $self->repl->constant('XPathResu +lt.ORDERED_NODE_ITERATOR_TYPE'), UNORDERED_NODE_SNAPSHOT_TYPE => $self->repl->constant('XPathResu +lt.UNORDERED_NODE_SNAPSHOT_TYPE'), ORDERED_NODE_SNAPSHOT_TYPE => $self->repl->constant('XPathResu +lt.ORDERED_NODE_SNAPSHOT_TYPE'), ANY_UNORDERED_TYPE => $self->repl->constant('XPathResu +lt.ANY_UNORDERED_NODE_TYPE'), FIRST_ORDERED_NODE_TYPE => $self->repl->constant('XPathResu +lt.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)']); }

Very old stuff below...

My Perlmonks CSS:

#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; }

<traduction en cours/translation in progress>

FAQ PerlMonks (fr_FR)

Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (4)
As of 2016-05-31 21:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?