How to use WWW:Mechanize to login - perl

I want to login to a persian blogging service . This is my code:
#!/usr/bin/perl
use WWW::Mechanize;
$mech = WWW::Mechanize->new();
$url = "http://blogfa.com/Desktop/Login.aspx?t=1";
$mech->get($url);
$result = $mech->submit_form(
form_name => 'aspnetForm', #name of the form
#instead of form name you can specify
#form_number => 1
fields =>
{
'master$ContentPlaceHolder1$Uid' => 'my username', # name of the input field and value
'master$ContentPlaceHolder1$Password' => 'my password',
}
,'master$ContentPlaceHolder1$btnSubmit' => 'ورود به بخش مدیریت' #name of the submit button
);
$result->content();
if ($result =~ /میز کار/) {
print "Done\n"; }
else {
print "Failed!\n"; }
But it doesn't work at all. What is the problem?

The problem is, that WWW:Mechanize does not execute javascript. Since the site you want to log in uses javascript for logging in, its not able to do that.
You could fix that problem by using WWW::Mechanize::Firefox, which allows you to execute javascript.

This should work:
my $mech = WWW::Mechanize->new();
$mech->get("http://blogfa.com/Desktop/Login.aspx?t=1");
$mech->submit_form(
with_fields => {
'master$ContentPlaceHolder1$Uid' => 'my username',
'master$ContentPlaceHolder1$Password' => 'my password',
},
button => 'master$ContentPlaceHolder1$btnSubmit',
);

Related

How can I send mail in a Perl script?

I have adapted a script from the Perl Cookbook. I am testing it to send mail to myself in gmail.
#!/usr/bin/perl
use strict;
use warnings;
use MIME::Lite;
my $msg;
$msg = MIME::Lite->new(From => 'zmumba#gmail.com',
To => 'zmumba#gmail.com',
Subject => 'My office photo',
Type => 'multipart/mixed');
$msg->attach(Type => 'image/png',
Path => '/home/zmumba/ZMD_Proj/Docs/Reporting',
Filename => 'office_lyout.png');
$msg->attach(Type => 'TEXT',
Data => 'I hope you can use this!');
$msg->send( );
When I run this script, I get the message "/home/zmumba/ZMD_Proj/Docs/Reporting" not readable.
From here How can I send mail through Gmail with Perl? , I now understand that I have to send mail through a mailserver to use MIME::Lite. So I replaced
$msg = MIME::Lite->new(From => 'zmumba#gmail.com
with
$msg = Email::Send::Gmail->new(From => 'zmumba#gmail.com
and I get the error "Can't locate object method "new" via package Email::Send::Gmail".
Then I tried
$msg = Net::IMAP::Simple::SSL->new(From => 'zmumba#gmail.com',
and I get "Odd number of elements in hash assignment at /home/zmumba/perl5/lib/perl5/Net/IMAP/Simple.pm line 25.
Can't call method "attach" on an undefined value at ...".
Any assistance on how to go about it?
Thanks in anticipation.
The Perl Cookbook is 20 years old and its recommendations will be out of date. Using MIME::Lite is discouraged.
MIME::Lite is not recommended by its current maintainer. There are a number of alternatives, like Email::MIME or MIME::Entity and Email::Sender, which you should probably use instead. MIME::Lite continues to accrue weird bug reports, and it is not receiving a large amount of refactoring due to the availability of better alternatives. Please consider using something else.
You should probably follow their recommendation and use Email::Sender.
"Can't locate object method "new" via package Email::Send::Gmail"
You need to load Email::Send::Gmail with use Email::Send::Gmail.
You may need to install the Email::Send::Gmail module. It's simplest to do this using either cpanminus or install a fresh Perl with perlbrew and then use cpanminus.
Then I tried
$msg = Net::IMAP::Simple::SSL->new(From => 'zmumba#gmail.com',
and I get "Odd number of elements in hash assignment at /home/zmumba/perl5/lib/perl5/Net/IMAP/Simple.pm line 25.
MIME::Lite, Email::Send::Gmail, and Net::IMAP::Simple::SSL are different libraries with different interfaces that take different arguments differently. Refer to their documentation for how to use them.
As mentioned before, both MIME::Lite and Email::Send is discouraged -
Email::Send is going away... well, not really going away, but it's
being officially marked "out of favor." It has API design problems
that make it hard to usefully extend and rather than try to deprecate
features and slowly ease in a new interface, we've released
Email::Sender which fixes these problems and others
I have created a script which uses Email::MIME, Email::Sender::Simple, Email::Sender::Transport::SMTP for sending mail. You can take a look at https://github.com/rai-gaurav/perl-toolkit/tree/master/Mail and use it as per your requirement.
Important lines from that code are -
sub create_mail {
my ( $self, $file_attachments, $mail_subject, $mail_body ) = #_;
my #mail_attachments;
if (#$file_attachments) {
foreach my $attachment (#$file_attachments) {
my $single_attachment = Email::MIME->create(
attributes => {
filename => basename($attachment),
content_type => "application/json",
disposition => 'attachment',
encoding => 'base64',
name => basename($attachment)
},
body => io->file($attachment)->all
);
push( #mail_attachments, $single_attachment );
}
}
# Multipart message : It contains attachment as well as html body
my #parts = (
#mail_attachments,
Email::MIME->create(
attributes => {
content_type => 'text/html',
encoding => 'quoted-printable',
charset => 'US-ASCII'
},
body_str => $mail_body,
),
);
my $mail_to_users = join ', ', #{ $self->{config}->{mail_to} };
my $cc_mail_to_users = join ', ', #{ $self->{config}->{mail_cc_to} };
my $email = Email::MIME->create(
header => [
From => $self->{config}->{mail_from},
To => $mail_to_users,
Cc => $cc_mail_to_users,
Subject => $mail_subject,
],
parts => [#parts],
);
return $email;
}
sub send_mail {
my ( $self, $email ) = #_;
my $transport = Email::Sender::Transport::SMTP->new(
{
host => $self->{config}->{smtp_server}
}
);
eval { sendmail( $email, { transport => $transport } ); };
if ($#) {
return 0, $#;
}
else {
return 1;
}
}
Gmail and other mail servers will not allow unauthorized relay. In most cases you will need authorized access.
Here is what I use, after also trying many modules. Maybe this solution seems a little bit overdone, but it's easy to change for HTML with plain text as alternative or other attachments. Parameters of the transport are the most common ones.
#!perl
use strict;
use warnings;
use utf8;
use Email::Sender::Simple qw(sendmail try_to_sendmail);
use Email::Sender::Transport::SMTPS;
use Email::Simple ();
use Email::Simple::Creator ();
use Email::MIME;
send_my_mail('john.doe#hisdomain.com','Test','Test, pls ignore');
sub send_my_mail {
my ($to_mail_address, $subject, $body_text) = #_;
my $smtpserver = 'smtp.mydomain.com';
my $smtpport = 587;
my $smtpuser = 'me#mydomain.com';
my $smtppassword = 'mysecret';
my $transport = Email::Sender::Transport::SMTPS->new({
host => $smtpserver,
ssl => 'starttls',
port => $smtpport,
sasl_username => $smtpuser,
sasl_password => $smtppassword,
#debug => 1,
});
my $text_part = Email::MIME->create(
attributes => {
'encoding' => 'quoted-printable',
'content_type' => 'text/plain',
'charset' => 'UTF-8',
},
'body_str' => $body_text,
);
my $alternative_part = Email::MIME->create(
attributes => {
'content_type' => 'multipart/alternative',
},
parts => [ $text_part, ],
);
my $email = Email::MIME->create(
header_str => [
To => $to_mail_address,
From => "Website <$smtpuser>",
Subject => $subject,
],
attributes => {
'content_type' => 'multipart/mixed',
},
parts => [ $alternative_part ],
);
my $status = try_to_sendmail($email, { transport => $transport });
return $status;
}
Take a look at Email::Send::Gmail module. It might solve your problem.

Unable to parse html tags with perl

I am trying to parse the following link using perl
http://www.inc.com/profile/fuhu
I am trying to get information like Rank, 2013 Revenue and 2010 Revenue, etc,
But when fetch data with perl, I get following and same shows in Page Source Code.
<dl class="RankTable">
<div class="dtddwrapper">
<div class="dtdd">
<dt>Rank</dt><dd><%=rank%></dd>
</div>
</div>
<div class="dtddwrapper">
And When I check with Firebug, I get following.
<dl class="RankTable">
<div class="dtddwrapper">
<div class="dtdd">
<dt>Rank</dt><dd>1</dd>
</div>
</div>
<div class="dtddwrapper">
My Perl code is as following.
use WWW::Mechanize;
$url = "http://www.inc.com/profile/fuhu";
my $mech = WWW::Mechanize->new();
$mech->get( $url );
$data = $mech->content();
print $data;
As other have said this is not plain HTML, there is some JS wizardry. The data comes from a dynamic JSON request.
The following script prints the rank and dumps everything else available in $data.
First it gets the ID of the profile and then it makes the appropriate JSON request, just like a regular browser.
use strict;
use warnings;
use WWW::Mechanize;
use JSON qw/decode_json/;
use Data::Dumper;
my $url = "http://www.inc.com/profile/fuhu";
my $mech = WWW::Mechanize->new();
$mech->get( $url );
if ($mech->content() =~ /profileID = (\d+)/) {
my $id = $1;
$mech->get("http://www.inc.com/rest/inc5000company/$id/full_list");
my $data = decode_json($mech->content());
my $rank = $data->{data}{rank};
print "rank is $rank\n";
print "\ndata hash value \n";
print Dumper($data);
}
Output:
rank is 1
data hash value
$VAR1 = {
'time' => '2014-08-22 11:40:00',
'data' => {
'ifi_industry' => 'Consumer Products & Services',
'app_revenues_lastyear' => '195640000',
'industry_rank' => '1',
'ifc_company' => 'Fuhu',
'current_industry_rank' => '1',
'app_employ_fouryearsago' => '49',
'ifc_founded' => '2008-00-00',
'rank' => '1',
'city_display_name' => 'Los Angeles',
'metro_rank' => '1',
'ifc_business_model' => 'The creator of an Android tablet for kids and an Adobe Air application that allows children to access the Internet in a parent-controlled environment.',
'next_id' => '25747',
'industry_id' => '4',
'metro_id' => '2',
'app_employ_lastyear' => '227',
'state_rank' => '1',
'ifc_filelocation' => 'fuhu',
'ifc_url' => 'http://www.fuhu.com',
'years' => [
{
'ify_rank' => '1',
'ify_metro_rank' => '1',
'ify_industry_rank' => '1',
'ify_year' => '2014',
'ify_state_rank' => '1'
},
{
'ify_industry_rank' => undef,
'ify_year' => '2013',
'ify_rank' => '1',
'ify_metro_rank' => undef,
'ify_state_rank' => undef
}
],
'ifc_twitter_handle' => 'NabiTablet',
'id' => '22890',
'app_revenues_fouryearsago' => '123000',
'ifc_city' => 'El Segundo',
'ifc_state' => 'CA'
}
};
This thing : <%=rank%> is inside a script, it's not HTML. So when you see it in firebug, it shows after executing this part. But when you look at the HTML code, you see it this way. So HTML parsing won't work here.
Usually in this type of cases, the variables (rank for example) are passed from server using a XHR call. So you need to check the XHR calls in firebug and see the responses.

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

Unable to login into a site using www:Mechanize

I am using WWW:Mechanize to try to login to a site.
Code
use WWW::Mechanize;
my $mech = WWW::Mechanize->new();
$mech->get("https://www.amazon.com/gp/css/homepage.html/");
$mech->submit_form(
form_name => 'yaSignIn',
fields => {
email => 'email',
qpassword=> 'pass'
}
);
print $mech->content();
However it is not being logged into the site. What am i doing wrong. The website redirects and says please enable cookies to continue. How do i do that .
Try putting this block before your get.
$mech->cookie_jar(
HTTP::Cookies->new(
file => "cookies.txt",
autosave => 1,
ignore_discard => 1,
)
);
SuperEdit2: I just tried this myself and it seemed to work. Give it a try.(changed the form number to 3 and added an agent alias)
use strict;
use warnings;
use WWW::Mechanize;
# Create a new instance of Mechanize
my $bot = WWW::Mechanize->new();
$bot->agent_alias( 'Linux Mozilla' );
# Create a cookie jar for the login credentials
$bot->cookie_jar(
HTTP::Cookies->new(
file => "cookies.txt",
autosave => 1,
ignore_discard => 1,
)
);
# Connect to the login page
my $response = $bot->get( 'https://www.amazon.com/gp/css/homepage.html/' );
# Get the login form. You might need to change the number.
$bot->form_number(3);
# Enter the login credentials.
$bot->field( email => 'email' );
$bot->field( password => 'pass' );
$response = $bot->click();
print $response->decoded_content;

Perl WWW::Mechanize Credentials

I want to search content from a site using WWW::Mechanize but to be able to do that first I must be logged in with my registered username and password, which I can't do with this code. What must be changed so I can submit the form successfully. Thanks.
use strict;
use warnings;
use WWW::Mechanize;
my $username = "username";
my $password = "password";
my $cookie_jar;
my $url = "http://www.albumartexchange.com/forums/ucp.php?mode=login";
my $mech = WWW::Mechanize->new( cookie_jar => $cookie_jar );
$mech->credentials($username, $password);
$mech->get($url);
$mech->success() or die "Failed";
$mech->submit_form(
form_number => 4,
);
die "Submit failed" unless $mech->success;
$mech->save_content('log.txt');
UPDATE:
use strict;
use warnings;
use WWW::Mechanize;
my $cookie_jar;
my $mech = WWW::Mechanize->new( cookie_jar => $cookie_jar );
$mech->get( 'http://www.albumartexchange.com/forums/ucp.php?mode=login' );
$mech->submit_form(
form_number => 4,
fields => {
'username'
=> 'some_username',
'password'
=> 'some_password',
}
);
$mech->save_content('log.txt');
You don't need credentials here. Just use:
$mech->submit_form(
form_number => 4,
fields => {
username => $user,
password => $pass,
},
);
Of course don't forget to change username and password to the actual field names for your target page.
That page doesn't use HTTP authentication, which is what credentials is for. Just use Mech to fill in the username and password form fields and submit the login form.