aboutsummaryrefslogtreecommitdiff
path: root/perl/Curl_easy/test.pl
diff options
context:
space:
mode:
Diffstat (limited to 'perl/Curl_easy/test.pl')
-rw-r--r--perl/Curl_easy/test.pl296
1 files changed, 255 insertions, 41 deletions
diff --git a/perl/Curl_easy/test.pl b/perl/Curl_easy/test.pl
index a93b05692..1d52e3c24 100644
--- a/perl/Curl_easy/test.pl
+++ b/perl/Curl_easy/test.pl
@@ -8,11 +8,14 @@
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
+use Benchmark;
+use strict;
-BEGIN { $| = 1; print "1..5\n"; }
-END {print "not ok 1\n" unless $loaded;}
+BEGIN { $| = 1; print "1..13\n"; }
+END {print "not ok 1\n" unless $::loaded;}
use Curl::easy;
-$loaded = 1;
+
+$::loaded = 1;
print "ok 1\n";
######################### End of black magic.
@@ -21,81 +24,292 @@ print "ok 1\n";
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
+print "Testing curl version ",&Curl::easy::version(),"\n";
+
# Read URL to get
-$defurl = "http://www/";
-$url = "";
+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;
}
-# Use this for simple benchmarking
-#for ($i=0; $i<1000; $i++) {
-
# Init the curl session
-if (($curl = Curl::easy::curl_easy_init()) != 0) {
+my $curl;
+if (($curl = Curl::easy::init()) != 0) {
print "ok 2\n";
} else {
print "ko 2\n";
}
-# Set URL to get
-if (Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_URL, $url) == 0) {
- print "ok 3\n";
-} else {
- print "ko 3\n";
-}
# No progress meter please
-Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_NOPROGRESS, 1);
+# !! Need this on for all tests, as once disabled, can't re-enable it...
+#Curl::easy::setopt($curl, CURLOPT_NOPROGRESS, 1);
# Shut up completely
-Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_MUTE, 1);
+Curl::easy::setopt($curl, CURLOPT_MUTE, 1);
# Follow location headers
-Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_FOLLOWLOCATION, 1);
+Curl::easy::setopt($curl, CURLOPT_FOLLOWLOCATION, 1);
# Set timeout
-Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_TIMEOUT, 30);
+Curl::easy::setopt($curl, CURLOPT_TIMEOUT, 30);
# Set file where to read cookies from
-Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_COOKIEFILE, "cookies");
+Curl::easy::setopt($curl, CURLOPT_COOKIEFILE, "cookies");
# Set file where to store the header
open HEAD, ">head.out";
-Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_WRITEHEADER, HEAD);
+Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, *HEAD);
+print "ok 3\n";
# Set file where to store the body
-open BODY, ">body.out";
-Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_FILE, BODY);
+# Send body to stdout - test difference between FILE * and SV *
+#open BODY, ">body.out";
+#Curl::easy::setopt($curl, CURLOPT_FILE,*BODY);
+print "ok 4\n";
+# Add some additional headers to the http-request:
+my @myheaders;
+$myheaders[0] = "Server: www";
+$myheaders[1] = "User-Agent: Perl interface for libcURL";
+Curl::easy::setopt($curl, Curl::easy::CURLOPT_HTTPHEADER, \@myheaders);
+
# Store error messages in variable $errbuf
# NOTE: The name of the variable is passed as a string!
-# curl_easy_setopt() creates a perl variable with that name, and
-# curl_easy_perform() stores the errormessage into it if an error occurs.
-Curl::easy::curl_easy_setopt($curl, Curl::easy::CURLOPT_ERRORBUFFER, "errbuf");
+# setopt() creates a perl variable with that name, and
+# perform() stores the errormessage into it if an error occurs.
+
+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;
# Go get it
-if (Curl::easy::curl_easy_perform($curl) == 0) {
- Curl::easy::curl_easy_getinfo($curl, Curl::easy::CURLINFO_SIZE_DOWNLOAD, $bytes);
- print "ok 4: $bytes bytes read\n";
- print "check out the files head.out and body.out\n";
- print "for the headers and content of the URL you just fetched...\n";
- Curl::easy::curl_easy_getinfo($curl, Curl::easy::CURLINFO_EFFECTIVE_URL, $realurl);
- Curl::easy::curl_easy_getinfo($curl, Curl::easy::CURLINFO_HTTP_CODE, $httpcode);
+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 {
+ # We can acces the error message in $errbuf here
+ print "not ok 6: '$errbuf'\n";
+ die "basic url access failed";
+}
+
+# cleanup
+#close HEAD;
+# test here - BODY is still expected to be the output
+# Curl-easy-1.0.2.pm core dumps if we 'perform' with a closed output FD...
+#close BODY;
+#exit;
+#
+# The header callback will only be called if your libcurl has the
+# CURLOPT_HEADERFUNCTION supported, otherwise your headers
+# go to CURLOPT_WRITEFUNCTION instead...
+#
+
+my $header_called=0;
+sub header_callback { print "header callback called\n"; $header_called=1; return length($_[0])};
+
+# test for sub reference and head callback
+Curl::easy::setopt($curl, CURLOPT_HEADERFUNCTION, \&header_callback);
+print "ok 7\n"; # so far so good
+
+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); # ok if you have a libcurl <7.7.2
+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); # OK
+}
+
+# test for ref to sub and body callback
+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; # signal a failure
+}
+
+# test we can abort a request mid-way
+my $body_abort_ref=\&body_abort_callback;
+Curl::easy::setopt($curl, CURLOPT_WRITEFUNCTION, $body_abort_ref);
+
+if (Curl::easy::perform($curl) == 0) { # reverse test - this should have failed
+ print "not ";
+};
+print "ok 12\n";
+
+print "not " if (!$body_abort_called); # should have been called
+print "ok 13\n";
+
+# reset to a working 'write' function for next tests
+Curl::easy::setopt($curl,CURLOPT_WRITEFUNCTION, sub { return length($_[0])} );
+
+# inline progress function
+# tests for inline subs and progress callback
+# - progress callback must return 'true' on each call.
+
+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);
+
+# Turn progress meter back on - this doesn't work - once its off, its off.
+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 "";
+ }
+}
+
+#
+# test post/read callback functions - requires a url which accepts posts, or it fails!
+#
+
+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);
+
+# Now do an ftp upload:
+
+$defurl = "ftp://horn\@localhost//tmp/bla";
+print "\n\nPlease enter an URL for ftp upload [$defurl]: ";
+$url = <STDIN>;
+if ($url =~ /^\s*\n/) {
+ $url = $defurl;
+}
+
+# Init the curl session
+if (($curl = Curl::easy::init()) != 0) {
+ print "ok 17\n";
+} else {
+ print "not ok 17\n";
+}
+
+# Set URL to get
+if (Curl::easy::setopt($curl, Curl::easy::CURLOPT_URL, $url) == 0) {
+ print "ok 18\n";
+} else {
+ print "not ok 18\n";
+
+}
+
+# Tell libcurl to to an upload
+Curl::easy::setopt($curl, Curl::easy::CURLOPT_UPLOAD, 1);
+
+# No progress meter please
+#Curl::easy::setopt($curl, Curl::easy::CURLOPT_NOPROGRESS, 1);
+
+# Use our own progress callback
+Curl::easy::setopt($curl, Curl::easy::CURLOPT_PROGRESSFUNCTION, \&prog_callb);
+
+# Shut up completely
+Curl::easy::setopt($curl, Curl::easy::CURLOPT_MUTE, 1);
+
+# Store error messages in $errbuf
+Curl::easy::setopt($curl, Curl::easy::CURLOPT_ERRORBUFFER, "errbuf");
+
+$read_max=10;
+# Use perl read callback to read data to be uploaded
+Curl::easy::setopt($curl, Curl::easy::CURLOPT_READFUNCTION,
+ \&read_callb);
+
+# Use perl passwd callback to read password for login to ftp server
+Curl::easy::setopt($curl, Curl::easy::CURLOPT_PASSWDFUNCTION, \&passwd_callb);
+
+print "ok 19\n";
+
+# Go get it
+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 {
# We can acces the error message in $errbuf here
- print "ko 4: '$errbuf'\n";
+ print "not ok 20: '$errbuf'\n";
}
# Cleanup
-close HEAD;
-close BODY;
-Curl::easy::curl_easy_cleanup($curl);
-print "ok 5\n";
-
-# Use this for simple benchmarking
-#}
+Curl::easy::cleanup($curl);
+print "ok 21\n";