Public Scratchpad | Download, Select Code To D/L |
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)
- A propos de PM
- Qu'est-ce que PerlMonks ?
- Qui s'occupe du site ?
- Who uses PM?
- Quelle confidentialité sur PerlMonks ?
- J'ai besoin d'aide! Qui peut m'aider?
- PM est-il l'endroit où avoir la solution à ses devoirs (à la maison)?
- PerlMonks et JavaScript
- Où est documenté la fonction xxx() ?
- What does SoPW mean? (or Guide to PerlMonks Abbreviations)
- Bien démarrer
- Creating an account on PerlMonks
- Choosing a username
- Changing your password
- Retrieving a forgotten username or password
- Logging on to Perl Monks
- How do I change my home node?
- How do I change my preferences?
- Customising PerlMonks CSS
- What XML generators are currently available on PerlMonks?
- Why are categorized questions and answers displayed separately from the rest of my writeups?
- Rechercher PerlMonks
- Search
- Super Search
- thepen - Perlmonk's static mirror
- Publier sur PM
- I want to ask a question of the Perl Monks; where do I start?
- Where do I post X?
- How do I post a question effectively?
- How do I compose an effective node title?
- Can't See Your Post?
- Writeup Formatting Tips
- How do I change/delete my post?
- How does editing work in the Q&A Sections?
- How does editing work in the Perl Monks FAQ section?
- Why did I get downvoted?
- What shortcuts can I use for linking to other information?
- Liaisons
- How do I link to nodes on this site by title?
- How do I link to a node on this site by number?
- There is more than one node with the same name. How do I link to the one that I want?
- How do I link to modules on CPAN?
- How do I link to a Google search?
- How do I link to a book by ISBN?
- Visite guidé de PM
- The Monastery Gates
- Snippets
- Cool Uses for Perl
- Poetry
- Code
- Obfuscation
- Q&A
- Library
- Seekers of Perl Wisdom
- Craft
- Meditations
- Perl Monks Discussion
- Perl News
- Reviews
- Tutorials
- Newest Nodes
- Offering Plate
- Chatterbox
- Poll
- Scratch Pad
- Boîte à discussions
- Chatterbox FAQ]
- What is the Chatterbox?
- Is the chatterbox logged?
- Using the Chatterbox: Public Messaging
- Using the Chatterbox: Private Messaging
- Using the Chatterbox: URLs, Special Characters, and Code
- Using the Chatterbox: Linking
- Other CB Clients
- Tout en Modération
- What is moderation?
- Who can moderate?]
- What is reputation?
- Voting Guidelines (or 'How should I spend my votes?')
- How do I moderate?
- What nodes should/should not be frontpaged?
- What is Consideration?
- Who can consider a node?
- How to use the moderation system
- How does Nodes to Consider work?
- The Pilgrimage towards Sainthood
- Level powers
- Voting/Experience System
- Level 1: Initiate ( or 'When you first join' )
- Level 2: Novice
- I just became a Novice; Why can't I vote yet?
- Level 3: Acolyte
- Level 4: Scribe
- Level 5: Monk
- Level 6: Friar
- Level 7: Abbot
- Level 8: Bishop
- Level 9: Pontiff
- Level 10: Saint
- Orders of Monks - What are PerlMonks Orders?
- PM Nodelets - What are Nodelets?
- All-Time Best
- Approval Nodelet
- CPAN nodelet
- Chatterbox
- Daily Best
- Everything Developer
- Function Nodelet
- Information
- Keyword Nodelet
- Leftovers
- Node Status
- Node navigator
- Nodelet Nodelet
- Other Users
- Personal Nodelet
- Sections
- Tick tock
- Voting Booth
- Weekly Best
- XP Nodelet
- Your Input
- Outside (External) Links