#!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');