Cris Bailiff's and Georg Horn's big improvements

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";