I am trying to upload a file to a public API with a code similar to this:
my $ua = LWP::UserAgent->new;
sub uploadbox {
my $url = "http://host/token";
my $response = $ua->put($url,
'Content_Type' => 'form-data',
'Content' => [
Filedata => [ "$codename.box", "$codename.box", Content_type => 'application/octet-stream' ]
]
);
}
uploadbox();
This code runs, and exits without uploading anything ( the uploaded files are 300MB big, so it shoud take time).
Am I passing the right parameters to the put subroutine ?
How to further debug this ?
I like to debug LWP::UserAgent scripts using LWP::ConsoleLogger::Easy. (Disclaimer: this is one of my own modules).
use LWP::ConsoleLogger::Easy qw( debug_ua );
my $ua = LWP::UserAgent->new;
debug_ua( $ua );
# insert the rest of your code here
You'll now get a huge amount of debugging information from both the request and the response printed to your terminal. That should hopefully give you a good starting point to figure out what's going on.
In the end I just decided to use curl, and I get a dynamic status line for free
sub uploadbox {
my ($url) = #_;
my $curl = "curl -X PUT $url --upload-file $codename.box";
$OUTPUT_AUTOFLUSH = 1;
open(CURL, '-|', $curl,) or die "error: $ERRNO";
while (<CURL>) { say; }
}
not the code I am most proud of but ...
Related
I am using LWP Useragent to make multiple POST calls with basic Authorization, wherein POST URL parameters are read from a CSV file. Here is my code:
use strict;
use warnings;
use LWP::UserAgent;
use JSON 'from_json';
use MIME::Base64 'encode_base64';
use Data::Dumper;
my #assets;
my %data;
my $response;
my $csvfile = 'ScrappedData_Coins.csv';
my $dir = "CurrencyImages";
open (my $csv, '<', "$dir/$csvfile") || die "cant open";
foreach (<$csv>) {
chomp;
my #currencyfields = split(/\,/);
push(#assets, \#currencyfields);
}
close $csv;
my $url = 'https://example.org/objects?';
my %options = (
"username" => 'API KEY',
"password" => '' ); # Password field is left blank
my $ua = LWP::UserAgent->new(keep_alive=>1);
$ua->agent("MyApp/0.1");
$ua->default_header(
Authorization => 'Basic '. encode_base64( $options{username} . ':' . $options{password} )
);
my $count =0;
foreach my $row (#cryptoassets) {
$response = $ua->post(
$url,
Content_Type => 'multipart/form-data',
Content => {
'name'=>${$row}[1],
'lang' => 'en',
'description' => ${$row}[6],
'parents[0][Objects][id]' => 42100,
'Objects[imageFiles][0]' =>[${$row}[4]],
}
);
if ( $response->is_success ) {
my $json = eval { from_json( $response->decoded_content ) };
print Dumper $json;
}
else {
$response->status_line;
print $response;
}
}
sleep(2);
}
Basically, I want to reuse the LWP object. For this, I am creating the LWP object, its headers, and response objects once with the option of keep_alive true, so that connection is kept open between server and client. However, the response from the server is not what I want to achieve. One parameter value ('parents[0][Objects][id]' => 42100) seems to not get passed to the server in HTTP POST calls. In fact, its behavior is random, sometimes the parentID object value is passed, and sometimes not, while all other param values are passing correctly. Is this a problem due to the reusing of the LWP agent object or is there some other problem? Because when I make a single HTTP POST call, all the param values are passed correctly, which is not the case when doing it in a loop. I want to make 50+ POST calls.
Reusing the user-agent object would not be my first suspicion.
Mojo::UserAgent returns a complete transaction object when you make a request. It's easy for me to inspect the request even after I've sent it. It's one of the huge benefits that always annoyed my about LWP. You can do it, but you have to break down the work to form the request first.
In this case, create the query hash first, then look at it before you send it off. Does it have everything that you expect?
Then, look at the request. Does the request match the hash you just gave it?
Also, when does it go wrong? Is the first request okay but the second fails, or several are okay then one fails?
Instead of testing against your live system, you might try httpbin.org. You can send it requests in various ways
use Mojo::UserAgent;
use Mojo::Util qw(dumper);
my $hash = { ... };
say dumper( $hash );
my $ua = Mojo::UserAgent->new;
$ua->on( prepare => sub { ... } ); # add default headers, etc
my $tx = $ua->post( $url, form => $hash );
say "Request: " . $tx->req->to_string;
I found the solution myself. I was passing form parameter data (key/value pairs) using hashref to POST method. I changed it to arrayref and the problem was solved. I read how to pass data to POST method on CPAN page. Thus, reusing LWP object is not an issue as pointed out by #brian d foy.
CPAN HTTP LWP::UserAgent API
CPAN HTTP Request Common API
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.
I believe I have a general Perl problem, rather than an LWP::UserAgent problem... however its somewhat complex.
The task is to write a test-script that does a SWORD deposit.
I create tests by first writing code to prove the thing works, then add in the Test::More wrappers to make it a test.
BACKGROUND
A SWORD deposit is simply an http post request with a bunch of defined headers, and the content of the body being the thing to be ingested. This all works fine, I can perform the actions through CURL, and I've written scripts to do this.... but within a a larger application environment (that'll be EPrints.)
CODE
My problem, I believe, comes when I try to attach the contents of the file on the disk.
#!/home/cpan/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
##use WWW::Mechanize;
use File::Slurp;
use MIME::Base64;
my $auth = 'username:password';
my $domain = 'devel.example.com';
my $ua = LWP::UserAgent->new();
my $basedir = "./test_files";
my $package = 'http://opendepot.org/europePMC/2.0';
my $filename = "$basedir/PMC165035.zip";
my $mime = 'application/zip';
print "filename: $filename\n";
my $deposit_url = $domain . '/sword-app/deposit/archive';
my $file = read_file( $filename, { binmode => ':raw' } );
# Set up the SWORD deposit
my $autho = "Basic " . MIME::Base64::encode( $auth, '' );
my %headers = (
'X-Packaging' => $package,
'X-No-Op' => 'false',
'X-Verbose' => 'true',
'Content-Disposition' => "filename=$filename",
'Content-Type' => $mime,
'User-Agent' => 'Broker Test Harness',
'Authorization' => $autho,
);
my $r = $ua->post( $deposit_url, %headers, Content => $file );
# DEBUG TEST
write_file('foo.zip', $file);
my $ret = $r->decoded_content;
print "Content: $ret\n";
if ( $r->is_success ) { print "Deposited $package successfully" }
WHAT WORKS, WHAT DOESN'T
This code is lifted pretty much directly from working code I have - the only difference is that the working code gets the content for $file via an object-call within EPrints.
I know the file exists on the disk, if I do an ls -l on the filename printed, I can see the file, and its readable
In the code above, there is a line write_file('foo.zip', $file); - that writes a file which unzip -l foo.zip happily tells me has 3 files in it.
The line print "Content: $ret\n"; should print an atom response - for me, it prints nothing....
The Access log reports an error 500, but there's diddly-squat in the error-log.
The help
What I need to know is how I get the actual contents of the .zip file into the content part of the LWP::UserAgent post request...
(I'm going to spend much time not trying to dig into EPrints, to track where the error-500 is coming from, and why nothing appears in the log file.... but that's probably going to be down to an issue with what's been posted)
The solution lies in realizing what LWP POST is doing.
my $filename = "$basedir/PMC165035.zip";
my $file = read_file( $filename, { binmode => ':raw' } );
my %headers = (
'X-Packaging' => $package,
'X-No-Op' => 'false',
'X-Verbose' => 'true',
'Content-Disposition' => "filename=$filename",
'Content-Type' => $mime,
'User-Agent' => 'Broker Test Harness',
'Authorization' => $autho,
);
All work by setting $filename to be something like /home/services/foo/testing/test_files/PMC165035.zip, and passing this (full) filename to the server example.com.
The problem is that the server is looking for a filename, not a filename-with-path... so when the service does its thing with the file by dumping the content into its temporary upload location, and then it looks for ~~~temp_location/home/services/foo/testing/test_files/PMC165035.zip, it can't find it!
The solution is to read in the file, but ensure that the filename given in the headers is just the filename, not with-a-path
I'm sure this has been asked but I could not find a good question to my answer. I've got two scripts, one makes a post using LWP::UserAgent and the other basically receives the data, in this case I'm just looking to write a file. The file does get written but it can't be opened and the size is 1262 which leads me to believe only some of it is being read.
Here's what I'm doing (It's worth noting, I was uri/base64 encoding the file and passing everything via json, which was working, but my new task is the split the files out and pass everything as form params):
post script:
open (IMAGE, "./flower.jpg") or die "$!";
$raw_string1 = do{ local $/ = undef; <IMAGE>; };
my $req = HTTP::Request->new(POST => $url);
$req->content_type("application/x-www-form-urlencoded");
$req->content("json_string=$json&file_1=$raw_string1");
my $ua = LWP::UserAgent->new;
$res = $ua->request($req);
print $res->content;
Receiver script:
$cgi = CGI->new;
my $json_post = $cgi->param('json_string');
my $file_1 = $cgi->param('file_1');
open my $fh, '>', "$path/flower.jpg" or die $!;
binmode $fh;
print $fh $file_1;
close $fh;
Thanks for help in advance!
As previously mentioned, you have an encoding problem. The solution is simple:
my $req = HTTP::Request->new(POST => $url, [
json_string => $json,
file_1 => $raw_string1,
]);
which is short for
my $req = HTTP::Request->new(POST => $url,
Content_Type => 'application/x-www-form-urlencoded',
Content => [
json_string => $json,
file_1 => $raw_string1,
]
);
It's far more typical to use multipart/form-data to upload files, though. And if you do, you can even let HTTP::Request load the file for you!
my $req = HTTP::Request->new(POST => $url,
Content_Type => 'multipart/form-data',
Content => [
json_string => $json,
file_1 => [ 'flower.jpg' ],
]
);
CGI.pm will handle that no problem. See the section of the docs titled "PROCESSING A FILE UPLOAD FIELD".
You're not encoding the $raw_string1 data before sticking it into the HTTP POST body. That means that if the data in flower.jpg includes a hex 0x26 byte (the & char) -- at position 1263, let's say -- then the POST data will look like this:
json_string={ ... JSON data ... }&file_1=...1262 bytes of raw JPEG data...&...more JPEG data...
... which means that anything parsing the form body for form variables will truncate file_1 after 1262 bytes.
I'd recommend continuing to encode the $raw_string1 data with base64 or something similar, even if you pass it through as its own POST variable rather than adding it to the JSON data.
I have a Perl script trying to send a zip file like so with LWP UserAgent module
my $req = POST $url, Content_Type => 'form-data',
Content => [
submit => 1,
upfile => [ $fname ]
];
where $fname is the path of the file. On the server side though it seems my POST array only has "submit".
Should I base64 encode the file and assign it to a variable? What's the best way to do this?
Make sure the filename can be resolved. You should get an error if it cannot be, though. At least I do in my version of HTTP::Request::Common.
You don't have to encode the binary content as Base64. (Unless, of course, the server-side app happens to expect that format.)
Here's a complete sample script:
use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request::Common 'POST';
my $ua = LWP::UserAgent->new;
my $url = 'http://localhost:8888'; # Fiddler
my $req = POST $url,
Content_Type => 'form-data',
Content => [
submit => 1,
upfile => [ 'C:\temp\bla.zip' ],
];
my $line = '=' x 78 . "\n";
print $line, $req->as_string;
my $rsp = $ua->request( $req );
print $line, $rsp->as_string;