LWP::UserAgent and HTTP::Request for a POST request - perl

In a certain script I tried to write this:
my $ua = LWP::UserAgent->new;
my $res = $ua->post($url, Content => $data);
and got "400 Bad Request".
After some reading I tried this:
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new( 'POST', $url );
$req->content( $data );
my $res = $ua->request( $req );
and it worked, but I thought these two should do the same. What am I missing here?
Am I misunderstanding something in the documentation of HTTP::Request and LWP::UserAgent?
Is there a way to ask LWP::UserAgent to print what it is doing?

Here's one way to do it:
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
{
no strict "refs";
no warnings "redefine";
my $orig_sub = \&LWP::UserAgent::send_request;
*{"LWP::UserAgent::send_request"} = sub {
my ($self, $request) = #_;
print $request->as_string . "\n";
my $response = $orig_sub->(#_);
print $response->as_string . "\n";
return $response;
};
}
my $a = LWP::UserAgent->new;
my $response = $a->get("http://google.com");
It will print out all the requests and responses that LWP::UserAgent does.

Related

Can I decode gzip when using the mirror function in LWP Useragent?

Can I use something like $response->decoded_content within a LWP UserAgent 'mirror' request? Thank you.
When using mirror() the received data is not added to the response object directly, but instead written directly to the mirror file. This means that decoded_content() will not work. However, you can add a response_header that enables the storage of the received data:
use strict;
use warnings;
use LWP::UserAgent ();
my $ua = LWP::UserAgent->new;
my $fn = 'libwww-perl-6.41.tar.gz'; # Example file..
my $url = 'https://cpan.metacpan.org/authors/id/O/OA/OALDERS/'. $fn;
$ua->add_handler(
response_header => sub {
my($response, $ua, $handler) = #_;
$response->{default_add_content} = 1;
}
);
my $response = $ua->mirror($url, $fn);
if ( $response->is_success ) {
if ( $response->header('Content-Type') eq 'application/x-gzip') {
$response->header('Content-Encoding' => 'gzip');
}
my $decoded_content = $response->decoded_content;
# Do someting with the decoded content here ...
}

Print http request response in JSON format

#!/usr/bin/perl
use strict;
use warnings;
use JSON qw(decode_json);
use JSON;
use LWP::UserAgent;
use HTTP::Request;
#GET_METHOD
my $usagnt_get = LWP::UserAgent->new;
my $server_end_point_get = "http://192.168.201.1:8000/c/r";
my $reqst_get = HTTP::Request->new( GET => $server_endpoint_get );
$reqst_get->header( 'content-type' => 'application/json' );
#Request User Agent
my $respnse_get = $usagnt->request( $reqst_get );
if ( $resp_get->is_success ) {
my $message = $respnse_get->decoded_content;
print "\n Received GET Response:\n$res_message\n";
print "\n****** GET operations SUCCESS..!\n";
}
else {
print "HTTP_GET error code:", $respnse_get->code, "\n";
print "HTTP_GET error message:", $respnse_get->res_message, "\n";
}
Please help me to get output with JSON format of ie requesting method with HTTP req and get method is capturing with all the projects list in getting method.
# Here is the successfully compiled code
!/usr/bin/perl
use strict;
use LWP::UserAgent;
my $token="";
my $uri = 'http://xxx.xxx.xxx.xxx:8000/a/b';
my $json => '{"username":"user","password":"pwd"}';
my $req = HTTP::Request->new('POST', $uri );
$request->header( 'Content-Type' => 'application/json');
$request->content( $json );
my $lwp = LWP::UserAgent->new;
my $message = $lwp->request( $request );
if ( $message->is_success ) {
my $token= $message->content;
print "\n Received POST Response:\n$token\n";
} else {
print "error code:", $message->code,"\n";
print "error message:", $message->as_string(), "\n";
}

LWP POST request not working

The if statement is showing me that there is a response, but when I try to print the response I get nothing
use LWP::UserAgent;
use strict;
use warnings;
use HTTP::Request::Common;
# use this {"process": "mobileGps","phone": "9565551236"}
my $url = "the url goes here";
my $json = '{data :{"process" : "mobileGps", "phone" : "9565551236"}}';
my $req = HTTP::Request->new( POST => $url );
$req->header( 'Content-Type' => 'application/json' );
$req->content( $json );
my $ua = LWP::UserAgent->new;
my $res = $ua->request( $req );
if ( $res->is_success ) {
print "It worked";
print $res->decoded_content;
}
else {
print $res->code;
}
I do have the URL: I just took it out for the purpose of this example.
What am I missing?
Try debugging your script like this:
use strict;
use warnings;
use HTTP::Request::Common;
use LWP::ConsoleLogger::Easy qw( debug_ua );
use LWP::UserAgent;
# use this {"process": "mobileGps","phone": "9565551236"}
my $url = "the url goes here";
my $json = '{data :{"process" : "mobileGps", "phone" : "9565551236"}}';
my $req = HTTP::Request->new(POST => $url);
$req->header('Content-Type' =>'application/json');
$req->content($json);
my $ua = LWP::UserAgent->new;
debug_ua( $ua );
my $res = $ua->request($req);
if ($res->is_success) {
print "It worked";
print $res->decoded_content;
} else {
print $res->code;
}
That will (hopefully) give you a better idea of what's going on.
Can you not use the debugger, or add some print statements to see how your program is progressing?
If not then this is going to be another case of on-line turn-by-turn debugging, which benefits no one except the OP, and the ultimate diagnosis is that they should have learned the language first
The internet can be wise, but it will make many more artisans Pretender than craftsmen
Please don't ever expect to make a half-hearted attempt at a sketch, and then rope in the rest of the world to finish your job. It takes a huge amount of experience, aptitude, and understanding to get even a "What's your name" .. "Hello" program working, and things only get harder thereafter
If you don't like being careful and thorough, and would rather ask for people to do your stuff for you than discover a solution by experimentation, then you are a manager, not a programmer. I hope you will never try to advance a software career by getting great at delegating, because that doesn't work with software
Here. Use this as you will. The world is full of managers; it is good programmers that we need
use strict;
use warnings 'all';
use feature 'say';
use constant URL => 'http://example.com/';
use LWP;
my $ua = LWP::UserAgent->new;
my $json = '{}';
my $req = HTTP::Request->new( POST => URL );
$req->header( content_type => 'application/json' );
$req->content( $json );
my $res = $ua->request( $req );
say $res->as_string;
The code is fine. The problem must be with the server that is serving the request upon status code 200. You should check at server's end.

Perl print the redirected url

I want to print the redirected url in perl.
Input url : http://pricecheckindia.com/go/store/snapdeal/52517?ref=velusliv
output url : http://www.snapdeal.com/product/vox-2-in-1-camcorder/1154987704?utm_source=aff_prog&utm_campaign=afts&offer_id=17&aff_id=1298&source=pricecheckindia
use LWP::UserAgent qw();
use CGI qw(:all);
print header();
my ($url) = "http://pricecheckindia.com/go/store/snapdeal/52517?ref=velusliv";
my $ua = LWP::UserAgent->new;
my $req = new HTTP::Request(GET => $url);
my $res = $ua->request($req);
print $res->request;
How to get this done in perl?
You need to examine the HTTP response to find the URL. The documentation of HTTP::Response gives full details of how to do this, but to summarise, you should do the following:
use strict;
use warnings;
use feature ':5.10'; # enables "say"
use LWP::UserAgent;
my $url = "http://pricecheckindia.com/go/store/snapdeal/52517?ref=velusliv";
my $ua = LWP::UserAgent->new;
my $req = new HTTP::Request(GET => $url);
my $res = $ua->request($req);
# you should add a check to ensure the response was actually successful:
if (! $res->is_success) {
say "GET failed! " . $res->status_line;
}
# show the base URI for the response:
say "Base URI: " . $res->base;
You can view redirects using HTTP::Response's redirects method:
if ($res->redirects) { # are there any redirects?
my #redirects = $res->redirects;
say join(", ", #redirects);
}
else {
say "No redirects.";
}
In this case, the base URI is the same as $url, and if you examine the contents of the page, you can see why.
# print out the contents of the response:
say $res->decoded_contents;
Right near the bottom of the page, there is the following code:
$(window).load(function() {
window.setTimeout(function() {
window.location = "http://www.snapdeal.com/product/vox-2-in-1-camcorder/1154987704?utm_source=aff_prog&utm_campaign=afts&offer_id=17&aff_id=1298&source=pricecheckindia"
}, 300);
});
The redirect is handled by javascript, and so is not picked up by LWP::UserAgent. If you want to get this URL, you will need to extract it from the response contents (or use a different client that supports javascript).
On a different note, your script starts off like this:
use LWP::UserAgent qw();
The code following the module name, qw(), is used to import particular subroutines into your script so that you can use them by name (instead of having to refer to the module name and the subroutine name). If the qw() is empty, it's not doing anything, so you can just omit it.
To have LWP::UserAgent follow redirects, just set the max_redirects option:
use strict;
use warnings;
use LWP::UserAgent qw();
my $url = "http://pricecheckindia.com/go/store/snapdeal/52517?ref=velusliv";
my $ua = LWP::UserAgent->new( max_redirect => 5 );
my $res = $ua->get($url);
if ( $res->is_success ) {
print $res->decoded_content; # or whatever
} else {
die $res->status_line;
}
However, that website is using a JavaScript redirect.
$(window).load(function() {
window.setTimeout(function() {
window.location = "http://www.snapdeal.com/product/vox-2-in-1-camcorder/1154987704?utm_source=aff_prog&utm_campaign=afts&offer_id=17&aff_id=1298&source=pricecheckindia"
}, 300);
});
This will not work unless you use a framework that enables JavaScript, like WWW::Mechanize::Firefox.
It will throw you an error for the last line $res - > request since it is returning hash and content from the response. So below is the code:
use LWP::UserAgent qw();
use CGI qw(:all);
print header();
my ($url) = "http://pricecheckindia.com/go/store/snapdeal/52517?ref=velusliv";
my $ua = LWP::UserAgent->new;
my $req = new HTTP::Request(GET => $url);
my $res = $ua->request($req);
print $res->content;

Detect a broken link (web) in perl

I'm trying to detect if a link is broken or not, as in if it's a web address I could paste into my browser and find a web page. I've tried two methods so far that I found online and both are giving me false positives (LWP::UserAgent and LWP::Simple).
#!/usr/bin/perl -w
use strict;
use LWP::UserAgent;
my $url1 = 'http://www.gutenberg.org';
my $url2 = 'http://www.gooasdfzzzle.com.no/thisisnotarealsite';
my $ua = LWP::UserAgent->new;
$ua->agent("Mozilla/8.0"); # Pretend to be Mozilla
my $req = HTTP::Request->new(GET => "$url1");
my $res = $ua->request($req);
if ($res->is_success) {
print "Success!\n";
} else {
print "Error: " . $res->status_line . "\n";
}
$req = HTTP::Request->new(GET => "$url2");
$res = $ua->request($req);
if ($res->is_success) {
print "Success!\n";
} else {
print "Error: " . $res->status_line . "\n";
}
Which is giving me output of:
Success!
Success!
and then there's
#!/usr/bin/perl -w
use strict;
use LWP::Simple;
my $url1 = 'http://www.gutenberg.org';
my $url2 = 'http://www.gooasdfzzzle.com.no/thisisnotarealsite';
if (head("$url1")) {
print "Yes\n";
} else {
print "No\n";
}
if (head("$url2")) {
print "Yes\n";
} else {
print "No\n";
}
Which is giving me an output of:
Yes
Yes
Am I missing something here?
Your code worked fine for me, I can only see a problem if your running behind a VPN or gateway as previous stated. Always use strict and warnings, and here is an alternative way so you are not initializing a new Request object everytime you want to check for a valid link.
use strict;
use warnings;
use LWP::UserAgent;
sub check_url {
my ($url) = #_;
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(HEAD => $url);
my $res = $ua->request($req);
return $res->status_line if $res->is_error;
return "Success: $url";
}