Get url with Perl module WWW::Mechanize - perl

I've found the following code:
use WWW::Mechanize;
use WWW::Mechanize::FormFiller;
use URI::URL;
my #go_terms=qw/GO:0006612 GO:0045862 GO:0048545 GO:0007568 GO:0046326 GO:0051901 GO:0010524 GO:0006044 GO:0032024/;
my $go_string=join("\n",#go_terms);
my $agent = WWW::Mechanize->new( autocheck => 1 );
my $formfiller = WWW::Mechanize::FormFiller->new();
$agent->env_proxy();
$agent->get('http://revigo.irb.hr/');
$agent->form_number(1) if $agent->forms and scalar #{$agent->forms};
$formfiller->add_filler( 'goList' => Fixed => $go_string);
$formfiller->add_filler( 'cutoff' => Fixed => '0.4' );
$formfiller->add_filler( 'isPValue' => Fixed => 'yes' );
$formfiller->add_filler( 'whatIsBetter' => Fixed => 'higher' );
$formfiller->add_filler( 'goSizes' => Fixed => 0 );
$formfiller->add_filler( 'measure' => Fixed => 'SIMREL' );
$formfiller->fill_form($agent->current_form);
my $request = $agent->click("startRevigo");
what I am trying to do is, once startRevigo is clicked, I want to go to the following url http://revigo.irb.hr/toR.jsp?table=1 and download the file it is giving to me. No clue about how to do this, even reading cpan manual.

Not tested!
use WWW::Mechanize;
my #go_terms=qw/GO:0006612 GO:0045862 GO:0048545 GO:0007568 GO:0046326 GO:0051901 GO:0010524 GO:0006044 GO:0032024/;
my $go_string=join("\n",#go_terms);
my $agent = WWW::Mechanize->new( autocheck => 1 );
$agent->env_proxy();
$agent->get('http://revigo.irb.hr/');
$agent->submit_form(
with_fields => {
goList => $go_string,
cutoff => 0.4
isPValue => "yes",
whatIsBetter => "higher",
goSizes => 0,
measure => "SIMREL",
},
);
$agent->get("http://revigo.irb.hr/toR.jsp?table=1");
$agent->save_content("your_file.r");

I'd use LWP::UserAgent instead
require LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
$ua->env_proxy;
my $response = $ua->get('http://revigo.irb.hr/toR.jsp?table=1');
if ($response->is_success) {
print $response->decoded_content; # I am just printing it but you can save it etc
}
else {
die $response->status_line;
}
http://search.cpan.org/dist/libwww-perl/lib/LWP/UserAgent.pm

Related

How to send serialized post with Plack::Test?

Writing a REST application with perl Dancer2. I set the serializer setting to the format in code.
set serializer => 'JSON';
I wrote a test file to rest the application, but failure in POST.
REST application got KEY but null value.
DBD::Pg::st execute failed: ERROR: null value in column "email" of relation "owners" violates not-null constraint
How to set serialized format content in Plack::Test?
use strict;
use warnings;
use Test::More;
use Test::Deep;
use Plack::Test;
use Plack::Util;
use HTTP::Request::Common;
use JSON::MaybeXS qw(decode_json encode_json);
use Data::Dumper qw(Dumper);
use Storable qw(freeze thaw);
use utf8;
use MyApp;
my %data = (
password => 'A12345678',
email => 'test#test.com'
);
# APP Start
my $app = MyApp->to_app;
my $test = Plack::Test->create($app);
subtest register => sub {
print ">>> Test <<<\n";
my $datas = {
password => $data{password},
email => $data{email},
};
my $serialized_data = freeze($datas);
my $res = $test->request( POST '/api/v1/register', $serialized_data );
print Dumper $res;
};
done_testing();
Dumper $res =>
$VAR1 = bless( {
'_headers' => bless( {
'content-type' => 'application/json',
'server' => 'Perl Dancer2 0.400000',
'content-length' => 454
}, 'HTTP::Headers' ),
'_request' => bless( {
'_headers' => bless( {
'content-length' => 0,
'
12345678
test1#test.comemail
a1234567password' => undef,
'content-type' => 'application/x-www-form-urlencoded',
'::std_case' => {
'
12345678
test1#test.comemail
a1234567password' => '
12345678
Test1#Test.ComEmail
A1234567Password'
}
}, 'HTTP::Headers' ),
I tested this REST API with Postman is fine.

Facebook status update using WWW::Mechanize

I am trying to update status on facebook using Mechanize.I am able to login using the script but unable to update.I verified the id of form for status update is "u_0_w".
But selecting the form_id method says "There is no form with ID "u_0_w"".
My script is this:
use WWW::Mechanize;
use strict;
use warnings;
use Data::Dumper;
use HTTP::Cookies::Netscape;
my $cookiesfilename='/home/xxx/xxx/cookies.txt';
my $out;
my $mech = WWW::Mechanize->new( cookie_jar => HTTP::Cookies::Netscape->new( file => $cookiesfilename ) );
$mech->get("https://www.facebook.com/login.php");
my $response=$mech->submit_form(
fields => {
email => 'xxxx#xxxx.com',
pass => 'xxxxx',
}
);
#my $array=$mech->forms();
#$mech->get('/home.php');
print Dumper($mech->forms());
#$mech->form_id("u_0_w");
$mech->submit_form(
fields => {
xhpc_message_text=>'Why so serious'
}
);
print $response->status_line;
open($out, ">", "output_page.html") or die "Can't open output_page.html: $!";
print $out $response->decoded_content;
Then I tried to print all the forms on the page using Dumper the output is:
$VAR1 = bless( {
'default_charset' => 'UTF-8',
'enctype' => 'application/x-www-form-urlencoded',
'accept_charset' => 'UNKNOWN',
'action' => bless( do{\(my $o = 'https://www.facebook.com/search/web/direct_search.php')}, 'URI::https' ),
'method' => 'GET',
'attr' => {
'method' => 'get'
},
'inputs' => [
bless( {
'tabindex' => '-1',
'value' => '1',
'class' => '_42ft _42fu _4w98',
'type' => 'submit'
}, 'HTML::Form::SubmitInput' ),
bless( {
'/' => '/',
'autocomplete' => 'off',
'tabindex' => '1',
'name' => 'q',
'aria-label' => 'Search Facebook',
'value_name' => '',
'class' => 'inputtext _586f',
'type' => 'text',
'id' => 'u_0_b',
'role' => 'combobox',
'placeholder' => 'Search Facebook'
}, 'HTML::Form::TextInput' )
]
}, 'HTML::Form' );
It means it is not detecting the status update form it is detecting only Facebook search form.
What may be the problem for mechanize not detecting all the form elements?
The form contains <button type="submit">. Do Mechanize support it?
Why do you have to use Mechanize for this? There's already a module available for this on CPAN.
Take a look at WWW::Facebook::API.
Also see a related question: How do I use Perl's WWW::Facebook::API to publish to a user's newsfeed?
Synopsis:
use WWW::Facebook::API;
my $facebook = WWW::Facebook::API->new(
desktop => 0,
api_key => $fb_api_key,
secret => $fb_secret,
session_key => $query->cookie($fb_api_key.'_session_key'),
session_expires => $query->cookie($fb_api_key.'_expires'),
session_uid => $query->cookie($fb_api_key.'_user')
);
my $response = $facebook->stream->publish(
message => qq|Test status message|,
);

perl Email::MIME not working intermittent

the following code sometimes work, and sometimes do not. It is runnign on linux, where postfix is installed, i disabled it and stopped the service. does this need postfix to run?
when i run this test code in terminal i get no error and no email.
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
use Email::MIME;
use Email::Sender::Simple qw(sendmail);
my $sub='test';
my $exitCode=0;
my $emailTo='raxxxx#xxxx.com';
my $bcc='';
if ($exitCode == 0){$exitCode = '';}
my #mesgBody = ("test\n","email\n");
my $message = Email::MIME->create(
header_str => [
From => '"Rajeev" <'.$emailTo.'>',
To => $emailTo,
Subject => $sub,
],
attributes => {
'X-Priority' => 1,
'X-MSMail-Priority' => 'High',
encoding => 'quoted-printable',
charset => 'ISO-8859-1',
},
body_str => "#mesgBody"."\n".$exitCode, #old body_str => $sub."\n".$mesg."\n".$exitCode,
);
#sendmail($message);
if ($bcc eq ''){
my $result=sendmail(
$message,
{
from => '"Rajeev" <'.$emailTo.'>',
to => [$emailTo],
}
);
print "result=".Dumper($result)."\n";
} else {
sendmail(
$message,
{
from => '"Rajeev" <'.$emailTo.'>',
to => [$emailTo, $bcc],
}
);
}
output:->
result=$VAR1 = bless( {}, 'Email::Sender::Success' );
so if this is success, why am i not getting any email?
I also see nothing in system logs.
thank you.
# service postfix start
solved the problem.

LWP Get Large File Download Headers Missing

This post is follow on work related to LWP GET large file download. That post was regarding an error from LWP when trying to pass arguments in the header incorrectly. Now I am posting the changes I made and how I am trying to debug the approach. This discussion should be very informative for those interested in POST vs GET header formation, and what the server receives while using the CGI package. It is not information easily found on the net.
Here is my client code snip:
my $bytes_received = 0; # vars used below are set prior to this point
my $filename = $opt{t}."/$srcfile";
open (FH, ">", "$filename") or $logger->error( "Couldn't open $filename for writing: $!" );
my $ua = LWP::UserAgent->new();
my $target = $srcfile;
my $res = $ua->get(
$url,
':content_cb' => \&callback,
'api' => 'olfs', # Note attempted use of different types of quotes had no impact
"cmd" => 'rfile',
"target" => $target,
"bs" => $bs
);
print $logger->info("$bytes_received bytes received");
sub callback{
my($chunk, $res) = #_;
$bytes_received += length($chunk);
print FH $chunk;
}
Here is the server snip (cgi script):
my $query = new CGI;
my $rcvd_data = Dumper($query);
print $rcvd_data;
Here is the output from a GET:
$VAR1 = bless( {
'.parameters' => [],
'use_tempfile' => 1,
'.charset' => 'ISO-8859-1',
'.fieldnames' => {},
'param' => {},
'.header_printed' => 1,
'escape' => 1
}, 'CGI' );
Here is a client with a POST request:
my $ua = new LWP::UserAgent();
local $HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1;
my $req =
POST
$url,
'Content_Type' => 'form-data',
'Content' => {
"api" => 'olfs',
"cmd" => 'wfile',
"target" => $target,
"tsize" => $file_size,
"bs" => $bs,
"filename" => [ $file ] };
# HTTP::Message calls set_content, which appears to set the subroutine for content
# LWP::UserAgent
# LWP::Protocol::file::request sends content in chunks
#
$req->content( $req->content() );
$logger->info("Uploading: $file");
my $resp = $ua->request($req);
Here is the output on the server, just like before but now from the POST:
'.parameters' => [
'cmd',
'bs',
'api',
'target',
'filename',
'tsize'
],
'use_tempfile' => 1,
'.tmpfiles' => {
'*Fh::fh00001random23' => {
'info' => {
'Content-Type' => 'text/plain',
'Content-Disposition' => 'form-data; name="filename"; filename="random23"'
},
'name' => bless( do{\(my $o = '/usr/tmp/CGItemp33113')}, 'CGITempFile' ),
'hndl' => bless( \*Fh::fh00001random23, 'Fh' )
}
},
'.charset' => 'ISO-8859-1',
'.fieldnames' => {},
'param' => {
'cmd' => [
'wfile'
],
'bs' => [
'buffer1'
],
'api' => [
'olfs'
],
'target' => [
'random23'
],
'tsize' => [
'1073741824'
],
'filename' => [
$VAR1->{'.tmpfiles'}{'*Fh::fh00001random23'}{'hndl'}
},
'escape' => 1,
'.header_printed' => 1
}, 'CGI' );
In short, you can see in the POST dump the "key" / "value" pairs, ie "target => random23". In the GET dump I do not find any keys or values from what I submitted on the client side. Can that be explained, or what do I need to do so as to extract key / value pairs in the CGI script?
You're passing your form variables as HTTP headers.
Like I previously mentioned, if you want to build a url, you can use URI.
$url = URI->new($url);
$url->query_form(
api => 'olfs',
cmd => 'rfile',
target => $target,
bs => $bs,
);

POSTing to form using LWP::UserAgent gets no response (mostly)

Here is my dilemma: I am trying to fill out a web form and get a result back from that form using LWP::UserAgent. Here is an example of my code:
#!/usr/bin/perl -w
use strict;
use LWP;
use HTTP::Request::Common;
use LWP::Debug qw(+);
my $ua = LWP::UserAgent->new(protocols_allowed=>["https"]);
my $req = POST 'https://their.securesite.com/index.php',
[ 'firstName' => 'Me',
'lastName' => 'Testing',
'addressLine1' => '123 Main Street',
'addressLine2' => '',
'city' => 'Anyplace',
'state' => 'MN',
'zipCode' => '55555',
'card' => 'visa',
'cardNumber' => '41111111111111111',
'ccv2' => '123',
'exp_month' => '07',
'exp_year' => '2015',
'shared_key' => 'hellos',
];
my $response = $ua->request($req);
print $response->is_success() . "\n";
print $response->status_line . "\n";
print $response->content . "\n";
When I run this, I get back a 200 OK and a "1" for success, but not the response page from the form. Just the closing tags:
</body>
</html>
Could this possibly be due to the fact that the form page and response page both have the same URL? I am new to LWP, so I am grasping at straws here. It may still be on the clients end, but I want to rule out any issues on my end as well.
Thanks in advance for any help you guys can give - I am Googled out.
If you can use Mojo::UserAgent (part of the Mojolicious suite of tools) the code would look like this. Note that you might need IO::Socket::SSL in order to use HTTPS.
#!/usr/bin/env perl
use strict;
use warnings;
use Mojo::UserAgent;
my $ua = Mojo::UserAgent->new;
my $tx = $ua->post('https://their.securesite.com/index.php', form =>
{ 'firstName' => 'Me',
'lastName' => 'Testing',
'addressLine1' => '123 Main Street',
'addressLine2' => '',
'city' => 'Anyplace',
'state' => 'MN',
'zipCode' => '55555',
'card' => 'visa',
'cardNumber' => '41111111111111111',
'ccv2' => '123',
'exp_month' => '07',
'exp_year' => '2015',
'shared_key' => 'hellos',
});
if ( $tx->success ) {
print $tx->res->body;
# or work with the resulting DOM
# my $dom = $tx->res->dom;
} else {
my ($err, $code) = $tx->error;
print $code ? "$code response: $err\n" : "Connection error: $err\n";
}
The interface is a little different, but it has lots of nice features, including Mojo::DOM integration for parsing the response HTML.
Use $response->decoded_content to get the content without the headers. See HTTP::Message for more information.
#!/usr/bin/perl -w
use strict;
use URI;
use LWP::UserAgent;
use HTTP::Request;
my $url = URI->new('https://their.securesite.com/index.php');
my $ua = LWP::UserAgent->new();
my $request = HTTP::Request->new(
'POST',
$url,
HTTP::Headers->new(
'User-Agent' => "perl ua/ v0.001",
'Accept' => "text/xml, multipart/*, application/soap"
),
[ 'firstName' => 'Me',
'lastName' => 'Testing',
'addressLine1' => '123 Main Street',
'addressLine2' => '',
'city' => 'Anyplace',
'state' => 'MN',
'zipCode' => '55555',
'card' => 'visa',
'cardNumber' => '41111111111111111',
'ccv2' => '123',
'exp_month' => '07',
'exp_year' => '2015',
'shared_key' => 'hellos',
]
) or die "Error initiating Request: $#\n";
my $response = $ua->request( $request );
if ($response->is_success) {
print $response->decoded_content, "\n";
} else {
die $response->status_line;
}
Check the value of $response->as_string
It'll show you full http response with headers