use Benchmark;
use strict;
BEGIN { $| = 1; print "1..13\n"; }
END {print "not ok 1\n" unless $::loaded;}
use Curl::easy;
$::loaded = 1;
print "ok 1\n";
print "Testing curl version ",&Curl::easy::version(),"\n";
my $defurl = "http://localhost/cgi-bin/printenv";
my $url = "";
print "Please enter an URL to fetch [$defurl]: ";
$url = <STDIN>;
if ($url =~ /^\s*\n/) {
$url = $defurl;
}
my $curl;
if (($curl = Curl::easy::init()) != 0) {
print "ok 2\n";
} else {
print "ko 2\n";
}
Curl::easy::setopt($curl, CURLOPT_MUTE, 1);
Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1);
Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30);
Curl::easy::setopt($curl, CURLOPT_COOKIEFILE, "cookies");
open HEAD, ">head.out";
Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD);
print "ok 3\n";
print "ok 4\n";
my @myheaders;
$myheaders[0] = "Server: www";
$myheaders[1] = "User-Agent: Perl interface for libcURL";
Curl::easy::setopt($curl, Curl::easy::CURLOPT_HTTPHEADER, \@myheaders);
Curl::easy::setopt($curl, CURLOPT_ERRORBUFFER, "errbuf");
Curl::easy::setopt($curl, CURLOPT_URL, $url);
print "ok 5\n";
my $bytes;
my $realurl;
my $httpcode;
my $errbuf;
if (Curl::easy::perform($curl) == 0) {
Curl::easy::getinfo($curl, CURLINFO_SIZE_DOWNLOAD, $bytes);
print "ok 6: $bytes bytes read\n";
Curl::easy::getinfo($curl, CURLINFO_EFFECTIVE_URL, $realurl);
Curl::easy::getinfo($curl, CURLINFO_HTTP_CODE, $httpcode);
print "effective fetched url (http code: $httpcode) was: $url\n";
} else {
print "not ok 6: '$errbuf'\n";
die "basic url access failed";
}
my $header_called=0;
sub header_callback { print "header callback called\n"; $header_called=1; return length($_[0])};
Curl::easy::setopt($curl, CURLOPT_HEADERFUNCTION, \&header_callback);
print "ok 7\n";
if (Curl::easy::perform($curl) != 0) {
print "not ";
};
print "ok 8\n";
print "next test will fail on libcurl < 7.7.2\n";
print "not " if (!$header_called); print "ok 9\n";
my $body_called=0;
sub body_callback {
my ($chunk,$handle)=@_;
print "body callback called with ",length($chunk)," bytes\n";
print "data=$chunk\n";
$body_called++;
return length($chunk); }
my $body_ref=\&body_callback;
Curl::easy::setopt($curl, CURLOPT_WRITEFUNCTION, $body_ref);
if (Curl::easy::perform($curl) != 0) {
print "not ";
};
print "ok 10\n";
print "not " if (!$body_called);
print "ok 11\n";
my $body_abort_called=0;
sub body_abort_callback {
my ($chunk,$sv)=@_;
print "body abort callback called with ",length($chunk)," bytes\n";
$body_abort_called++;
return -1; }
my $body_abort_ref=\&body_abort_callback;
Curl::easy::setopt($curl, CURLOPT_WRITEFUNCTION, $body_abort_ref);
if (Curl::easy::perform($curl) == 0) { print "not ";
};
print "ok 12\n";
print "not " if (!$body_abort_called); print "ok 13\n";
Curl::easy::setopt($curl,CURLOPT_WRITEFUNCTION, sub { return length($_[0])} );
my $progress_called=0;
sub prog_callb
{
my ($clientp,$dltotal,$dlnow,$ultotal,$ulnow)=@_;
print "\nperl progress_callback has been called!\n";
print "clientp: $clientp, dltotal: $dltotal, dlnow: $dlnow, ultotal: $ultotal, ";
print "ulnow: $ulnow\n";
$progress_called++;
return 0;
}
Curl::easy::setopt($curl, CURLOPT_PROGRESSFUNCTION, \&prog_callb);
Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 0);
if (Curl::easy::perform($curl) != 0) {
print "not ";
};
print "ok 14\n";
print "not " if (!$progress_called);
print "ok 15\n";
my $read_max=10;
sub read_callb
{
my ($maxlen,$sv)=@_;
print "\nperl read_callback has been called!\n";
print "max data size: $maxlen\n";
print "(upload needs $read_max bytes)\n";
print "context: ".$sv."\n";
if ($read_max > 0) {
print "\nEnter max ", $read_max, " characters to be uploaded.\n";
my $data = <STDIN>;
chomp $data;
$read_max=$read_max-length($data);
return $data;
} else {
return "";
}
}
Curl::easy::setopt($curl,CURLOPT_READFUNCTION,\&read_callb);
Curl::easy::setopt($curl,CURLOPT_INFILESIZE,$read_max );
Curl::easy::setopt($curl,CURLOPT_UPLOAD,1 );
Curl::easy::setopt($curl,CURLOPT_CUSTOMREQUEST,"POST" );
if (Curl::easy::perform($curl) != 0) {
print "not ";
};
print "ok 16\n";
sub passwd_callb
{
my ($clientp,$prompt,$buflen)=@_;
print "\nperl passwd_callback has been called!\n";
print "clientp: $clientp, prompt: $prompt, buflen: $buflen\n";
print "\nEnter max $buflen characters for $prompt ";
my $data = <STDIN>;
chomp($data);
return (0,$data);
}
Curl::easy::cleanup($curl);
$defurl = "ftp://horn\@localhost//tmp/bla";
print "\n\nPlease enter an URL for ftp upload [$defurl]: ";
$url = <STDIN>;
if ($url =~ /^\s*\n/) {
$url = $defurl;
}
if (($curl = Curl::easy::init()) != 0) {
print "ok 17\n";
} else {
print "not ok 17\n";
}
if (Curl::easy::setopt($curl, Curl::easy::CURLOPT_URL, $url) == 0) {
print "ok 18\n";
} else {
print "not ok 18\n";
}
Curl::easy::setopt($curl, Curl::easy::CURLOPT_UPLOAD, 1);
Curl::easy::setopt($curl, Curl::easy::CURLOPT_PROGRESSFUNCTION, \&prog_callb);
Curl::easy::setopt($curl, Curl::easy::CURLOPT_MUTE, 1);
Curl::easy::setopt($curl, Curl::easy::CURLOPT_ERRORBUFFER, "errbuf");
$read_max=10;
Curl::easy::setopt($curl, Curl::easy::CURLOPT_READFUNCTION,
\&read_callb);
Curl::easy::setopt($curl, Curl::easy::CURLOPT_PASSWDFUNCTION, \&passwd_callb);
print "ok 19\n";
if (Curl::easy::perform($curl) == 0) {
Curl::easy::getinfo($curl, Curl::easy::CURLINFO_SIZE_UPLOAD, $bytes);
print "ok 20: $bytes bytes transferred\n\n";
} else {
print "not ok 20: '$errbuf'\n";
}
Curl::easy::cleanup($curl);
print "ok 21\n";