Cris Bailiff's and Georg Horn's big improvements

5 files changed, 893 insertions, 71 deletions

diff --git a/perl/Curl_easy/Changes b/perl/Curl_easy/Changes
index a38cc34a4..647017c54 100644
--- a/perl/Curl_easy/Changes
+++ b/perl/Curl_easy/Changes
@@ -1,6 +1,40 @@
 Revision history for Perl extension Curl::easy.
 Check out the file README for more info.
 
+1.1.3  Wed Apr 18 2001: - Cris Bailiff <c.bailiff@devsecure.com>
+	- Change/shorten module function names:
+		Curl::easy::curl_easy_setopt  becomes Curl::easy::setopt etc.
+		This requires minor changes to existing scripts....
+    - Added callback function support to pass arbitrary SV * (including
+	  FILE globs) from perl through libcurl to the perl callback.
+	- Make callbacks still work with existing scripts which use STDIO
+	- Initial support for libcurl 7.7.2 HEADERFUNCTION callback feature
+	- Minor API cleanups/changes in the callback function signatures
+	- Added Curl::easy::version function to return curl version string
+	- Callback documentation added in easy.pm
+    - More tests in test.pl
+
+1.1.2  Mon Apr 16 2001: - Georg Horn <horn@koblenz-net.de>
+    - Added support for callback functions. This is for the curl_easy_setopt()
+      options WRITEFUNCTION, READFUNCTION, PROGRESSFUNCTION and PASSWDFUNCTION.
+      Still missing, but not really neccessary: Passing a FILE * pointer,
+      that is passed in from libcurl, on to the perl callback function.
+    - Various cleanups, fixes and enhancements to easy.xs and test.pl.
+
+1.1.1  Thu Apr 12 2001:
+    - Made more options of curl_easy_setopt() work: Options that require
+      a list of curl_slist structs to be passed in, like CURLOPT_HTTPHEADER,
+      are now working by passing a perl array containing the list elements.
+      As always, look at the test script test.pl for an example.
+
+1.1.0  Wed Apr 11 2001:
+    - tested against libcurl 7.7
+    - Added new function Curl::easy::internal_setopt(). By calling
+      Curl::easy::internal_setopt(Curl::easy::USE_INTERNAL_VARS, 1);
+      the headers and content of the fetched page are no longer stored
+      into files (or written to stdout) but are stored into internal
+      Variables $Curl::easy::headers and $Curl::easy::content.
+
 1.0.2  Tue Oct 10 2000:
     - runs with libcurl 7.4
     - modified curl_easy_getinfo(). It now calls curl_getinfo() that has
diff --git a/perl/Curl_easy/Makefile.PL b/perl/Curl_easy/Makefile.PL
index c0d6c2ddf..58a8528ad 100644
--- a/perl/Curl_easy/Makefile.PL
+++ b/perl/Curl_easy/Makefile.PL
@@ -8,7 +8,7 @@ WriteMakefile(
     'NAME'	=> 'Curl::easy',
     'VERSION_FROM' => 'easy.pm', # finds $VERSION
     'LIBS'	=> ['-lcurl '],   # e.g., '-lm' 
-    'DEFINE'	=> '-Wall',     # e.g., '-DHAVE_SOMETHING' 
+    'DEFINE'	=> '',     # e.g., '-DHAVE_SOMETHING' 
     'INC'	=> '',     # e.g., '-I/usr/include/other' 
     'clean'	=> {FILES => "head.out body.out"}
 );
diff --git a/perl/Curl_easy/easy.pm b/perl/Curl_easy/easy.pm
index 126be14a9..e484a28f2 100644
--- a/perl/Curl_easy/easy.pm
+++ b/perl/Curl_easy/easy.pm
@@ -29,6 +29,7 @@ CURLOPT_FTPASCII
 CURLOPT_FTPLISTONLY
 CURLOPT_FTPPORT
 CURLOPT_HEADER
+CURLOPT_HEADERFUNCTION
 CURLOPT_HTTPHEADER
 CURLOPT_HTTPPOST
 CURLOPT_HTTPPROXYTUNNEL
@@ -44,6 +45,8 @@ CURLOPT_NETRC
 CURLOPT_NOBODY
 CURLOPT_NOPROGRESS
 CURLOPT_NOTHING
+CURLOPT_PASSWDDATA
+CURLOPT_PASSWDFUNCTION
 CURLOPT_PORT
 CURLOPT_POST
 CURLOPT_POSTFIELDS
@@ -88,8 +91,14 @@ CURLINFO_SPEED_DOWNLOAD
 CURLINFO_SPEED_UPLOAD
 CURLINFO_HEADER_SIZE
 CURLINFO_REQUEST_SIZE
+
+USE_INTERNAL_VARS
 );
-$VERSION = '1.0.1';
+
+$VERSION = '1.1.3';
+
+$Curl::easy::headers = "";
+$Curl::easy::content = "";
 
 sub AUTOLOAD {
     # This AUTOLOAD is used to 'autoload' constants from the constant()
@@ -116,21 +125,122 @@ Curl::easy - Perl extension for libcurl
 =head1 SYNOPSIS
 
   use Curl::easy;
-  
-  $CURL = curl_easy_init();
-  $CURLcode = curl_easy_setopt($CURL, CURLoption, Value);
-  $CURLcode = curl_easy_perform($CURL);
-  curl_easy_cleanup($CURL);
-  
-
+ 
+  $curl = Curl::easy::init();
+  $CURLcode = Curl::easy::setopt($curl, CURLoption, Value);
+  $CURLcode = Curl::easy::perform($curl);
+  Curl::easy::cleanup($curl);
+ 
 =head1 DESCRIPTION
-
+ 
 This perl module provides an interface to the libcurl C library. See
 http://curl.haxx.se/ for more information on cURL and libcurl.
+ 
+=head1 FILES and CALLBACKS
 
-=head1 AUTHOR
+Curl::easy supports the various options of curl_easy_setopt which require either a FILE * or
+a callback function.
+
+The perl callback functions are handled through a C wrapper which takes care of converting
+from C to perl variables and back again. This wrapper simplifies some C arguments to make
+them behave in a more 'perl' like manner. In particular, the read and write callbacks do not
+look just like the 'fread' and 'fwrite' C functions - perl variables do not need separate length
+parameters, and perl functions can return a list of variables, instead of needing a pointer
+to modify. The details are described below.
+
+=head2 FILE handles (GLOBS)
+ 
+Curl options which take a FILE, such as CURLOPT_FILE, CURLOPT_WRITEHEADER, CURLOPT_INFILE
+can be passed a perl file handle:
+ 
+  open BODY,">body.out";
+  $CURLcode = Curl::easy::setopt($curl, CURLOPT_FILE, BODY);
+
+=head2 WRITE callback
+
+The CUROPT_WRITEFUNCTION option may be set which will cause libcurl to callback to
+the given subroutine:
+
+  sub chunk { my ($data,$pointer)=@_; ...; return length($data) }
+  $CURLcode = Curl::easy::setopt($curl, CURLOPT_WRITEFUNCTION, \&chunk );
+  $CURLcode = Curl::easy::setopt($curl, CURLOPT_FILE, );
+
+In this case, the subroutine will be passed whatever is defined by CURLOPT_FILE. This can be
+a ref to a scalar, or a GLOB or anything else you like.
+
+The callback function must return the number of bytes 'handled' ( length($data) ) or the transfer
+will abort. A transfer can be aborted by returning a 'length' of '-1'.
+
+The option CURLOPT_WRITEHEADER can be set to pass a different '$pointer' into the CURLOPT_WRITEFUNCTION 
+for header values. This lets you collect the headers and body separately:
+
+  my $headers="";
+  my $body="";
+  sub chunk { my ($data,$pointer)=@_; ${$pointer}.=$data; return length($data) }
+
+  $CURLcode = Curl::easy::setopt($curl, CURLOPT_WRITEFUNCTION, \&chunk );
+  $CURLcode = Curl::easy::setopt($curl, CURLOPT_WRITEHEADER, \$header );
+  $CURLcode = Curl::easy::setopt($curl, CURLOPT_FILE, \$body );
 
+If you have libcurl > 7.7.1, then you could instead set CURLOPT_HEADERFUNCTION to a different callback,
+and have the header collected that way.
+
+=head2 READ callback
+
+Curl::easy supports CURLOPT_READFUNCTION. This function should look something like this:
+
+    sub read_callback {
+        my ($maxlength,$pointer)=@_;
+
+		....
+
+        return $data;
+    }
+
+The subroutine must return an empty string "" at the end of the data. Note that this function
+isn't told how much data to provide - $maxlength is just the maximum size of the buffer
+provided by libcurl. If you are doing an HTTP POST or PUT for example, it is important that this
+function only returns as much data as the 'Content-Length' header specifies, followed by a
+an empty (0 length) buffer.
+
+=head2 PROGRESS callback
+
+Curl::easy supports CURLOPT_PROGRESSFUNCTION. This function should look something like this:
+
+    sub prog_callb
+    {
+        my ($clientp,$dltotal,$dlnow,$ultotal,$ulnow)=@_;
+		....
+        return 0;
+    }                        
+
+The function should return 0 normally, or -1 which will abort/cancel the transfer. $clientp is whatever
+value/scalar is set using the CURLOPT_PROGRESSDATA option.
+
+=head2 PASSWD callback
+
+Curl::easy supports CURLOPT_PASSWDFUNCTION. This function should look something like this:
+ 
+    sub passwd_callb
+    {
+		my ($clientp,$prompt,$buflen)=@_;
+		...
+    	return (0,$data);
+    }                    
+
+$clientp is whatever scalar is set using the CURLOPT_PASSWDDATA option.
+$prompt is a text string which can be used to prompt for a password.
+$buflen is the maximum accepted password reply.
+
+The function must return 0 (for 'OK') and the password data as a list. Return (-1,"") to
+indicate an error.
+
+=head1 AUTHOR
+ 
 Georg Horn <horn@koblenz-net.de>
+ 
+Additional callback,pod and tes work by Cris Bailiff <c.bailiff@devsecure.com>
+and Forrest Cahoon <forrest.cahoon@merrillcorp.com>
 
 =head1 SEE ALSO
 
diff --git a/perl/Curl_easy/easy.xs b/perl/Curl_easy/easy.xs
index c7f19b026..4fff2b332 100644
--- a/perl/Curl_easy/easy.xs
+++ b/perl/Curl_easy/easy.xs
@@ -7,6 +7,17 @@
 #include <curl/curl.h>
 #include <curl/easy.h>
 
+#if (LIBCURL_VERSION_NUM<0x070702)
+#define CURLOPT_HEADERFUNCTION 79
+#define header_callback_func write_callback_func
+#else
+#define header_callback_func writeheader_callback_func
+#endif
+
+/* Lists that can be set via curl_easy_setopt() */
+
+static struct curl_slist *httpheader = NULL, *quote = NULL, *postquote = NULL;
+
 
 /* Buffer and varname for option CURLOPT_ERRORBUFFER */
 
@@ -14,6 +25,341 @@ static char errbuf[CURL_ERROR_SIZE];
 static char *errbufvarname = NULL;
 
 
+/* Callback functions */
+
+static SV *read_callback = NULL, *write_callback = NULL,
+          *progress_callback = NULL, *passwd_callback = NULL,
+	      *header_callback = NULL; 
+		  /* *closepolicy_callback = NULL; */
+
+
+/* For storing the content */
+
+static char *contbuf = NULL, *bufptr = NULL;
+static int bufsize = 32768, contlen = 0;
+
+
+/* Internal options for this perl module */
+
+#define USE_INTERNAL_VARS 0x01
+
+static int internal_options = 0;
+
+
+/* Setup these global vars */
+
+static void init_globals(void)
+{
+    if (httpheader) curl_slist_free_all(httpheader);
+    if (quote) curl_slist_free_all(quote);
+    if (postquote) curl_slist_free_all(postquote);
+    httpheader = quote = postquote = NULL;
+    if (errbufvarname) free(errbufvarname);
+    errbufvarname = NULL;
+    if (contbuf == NULL) {
+	contbuf = malloc(bufsize + 1);
+    }
+    bufptr = contbuf;
+    *bufptr = '\0';
+    contlen = 0;
+    internal_options = 0;
+}
+
+
+/* Register a callback function */
+
+static void register_callback(SV **callback, SV *function)
+{
+    if (*callback == NULL) {
+	/* First time, create new SV */
+	*callback = newSVsv(function);
+    } else {
+	/* Been there, done that. Just overwrite the SV */
+	SvSetSV(*callback, function);
+    }
+}
+
+/* generic fwrite callback, which decides which callback to call */
+static size_t
+fwrite_wrapper (const void *ptr,
+		size_t size,
+		size_t nmemb,
+		void *stream,
+		void *call_function)
+{
+    dSP ;
+    int count,status;
+    SV *sv;
+
+    if (call_function) {
+        /* then we are doing a callback to perl */
+
+        ENTER ;
+        SAVETMPS ;
+	 
+        PUSHMARK(SP) ;
+
+        if (stream == stdout) {
+            sv = newSViv(0); /* FIXME: should cast stdout to GLOB somehow? */
+        } else { /* its already an SV */
+            sv = stream;
+        }
+	
+        if (ptr != NULL) {
+            XPUSHs(sv_2mortal(newSVpvn(ptr, size * nmemb))); 
+	} else {
+            XPUSHs(sv_2mortal(newSVpv("",0)));
+        }
+        XPUSHs(sv_2mortal(newSVsv(sv)));  /* CURLOPT_FILE SV* */
+        PUTBACK ;
+
+        count = call_sv((SV *)call_function, G_SCALAR);
+	 
+        SPAGAIN;
+        if (count != 1)
+            croak("Big trouble, perl_call_sv(write_callback) didn't return status\n");
+
+		status = POPi;
+
+        PUTBACK ;
+	 
+        FREETMPS ;
+        LEAVE ;
+        return status;
+
+     } else {
+            /* default to a normal 'fwrite' */
+            /* stream could be a FILE * or an SV * */
+            FILE *f;
+	
+            if (stream == stdout) { /* the only possible FILE ? Think so*/
+                f = stream;
+            } else { /* its a GLOB */
+                f = IoIFP(sv_2io(stream)); /* may barf if not a GLOB */
+            }
+
+            return fwrite(ptr,size,nmemb,f);
+    }
+}
+
+/* Write callback for calling a perl callback */
+size_t
+write_callback_func( const void *ptr, size_t size,
+                                size_t nmemb, void *stream)
+{
+    return fwrite_wrapper(ptr,size,nmemb,stream,
+        write_callback);
+}
+
+/* header callback for calling a perl callback */
+size_t
+writeheader_callback_func( const void *ptr, size_t size,
+                              size_t nmemb, void *stream)
+{
+    return fwrite_wrapper(ptr,size,nmemb,stream,
+        header_callback);
+}
+
+size_t
+read_callback_func( void *ptr, size_t size,
+                    size_t nmemb, void *stream)
+{
+    dSP ;
+
+    int count;
+    SV *sv;
+    STRLEN len;
+    size_t maxlen,mylen;
+    char *p;
+
+    maxlen = size*nmemb;
+
+    if (read_callback) {
+        /* we are doing a callback to perl */
+
+        ENTER ;
+        SAVETMPS ;
+ 
+        PUSHMARK(SP) ;
+	
+        if (stream == stdin) {
+            sv = newSViv(0); /* should cast stdin to GLOB somehow? */
+        } else { /* its an SV */
+            sv = stream;
+        }
+	
+        XPUSHs(sv_2mortal(newSViv(maxlen))); /* send how many bytes please */
+        XPUSHs(sv_2mortal(newSVsv(sv))); /* CURLOPT_INFILE SV*  */
+        PUTBACK ;
+
+        count = call_sv(read_callback, G_SCALAR);
+	 
+        SPAGAIN;
+        if (count != 1)
+            croak("Big trouble, perl_call_sv(read_callback) didn't return data\n");
+
+        sv = POPs;
+        p = SvPV(sv,len);
+
+        /* only allowed to return the number of bytes asked for */
+        mylen = len<maxlen ? len : maxlen;
+        memcpy(ptr,p,(size_t)mylen);
+        PUTBACK ;
+ 
+        FREETMPS ;
+        LEAVE ;
+        return (size_t) (mylen/size);
+
+    } else {
+       /* default to a normal 'fread' */
+       /* stream could be a FILE * or an SV * */
+       FILE *f;
+
+       if (stream == stdin) { /* the only possible FILE ? Think so*/
+           f = stream;
+       } else { /* its a GLOB */
+           f = IoIFP(sv_2io(stream)); /* may barf if not a GLOB */
+       }
+
+       return fread(ptr,size,nmemb,f);
+    }
+}
+
+/* Porgress callback for calling a perl callback */
+
+static int progress_callback_func(void *clientp, size_t dltotal, size_t dlnow,
+    size_t ultotal, size_t ulnow)
+{
+    dSP;
+    int count;
+
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(sp);
+    if (clientp != NULL) {
+	XPUSHs(sv_2mortal(newSVpv(clientp, 0)));
+    } else {
+	XPUSHs(sv_2mortal(newSVpv("", 0)));
+    }
+    XPUSHs(sv_2mortal(newSViv(dltotal)));
+    XPUSHs(sv_2mortal(newSViv(dlnow)));
+    XPUSHs(sv_2mortal(newSViv(ultotal)));
+    XPUSHs(sv_2mortal(newSViv(ulnow)));
+    PUTBACK;
+    count = perl_call_sv(progress_callback, G_SCALAR);
+    SPAGAIN;
+    if (count != 1)
+	croak("Big trouble, perl_call_sv(progress_callback) didn't return 1\n");
+    count = POPi;
+    PUTBACK;
+    FREETMPS;
+    LEAVE;
+    return count;
+}
+
+
+/* Password callback for calling a perl callback */
+
+static int passwd_callback_func(void *clientp, char *prompt, char *buffer,
+    int buflen)
+{
+    dSP;
+    int count;
+    SV *sv;
+    STRLEN len;
+    size_t mylen;
+    char *p;            
+
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(sp);
+    if (clientp != NULL) {
+        XPUSHs(sv_2mortal(newSVsv(clientp)));
+    } else {
+        XPUSHs(sv_2mortal(newSVpv("", 0)));
+    }
+    XPUSHs(sv_2mortal(newSVpv(prompt, 0)));
+    XPUSHs(sv_2mortal(newSViv(buflen)));
+    PUTBACK;
+    count = perl_call_sv(passwd_callback, G_ARRAY);
+    SPAGAIN;
+    if (count != 2)
+	    croak("Big trouble, perl_call_sv(passwd_callback) didn't return status + data\n");
+
+    sv = POPs;
+    count = POPi;
+
+    p = SvPV(sv,len);
+ 
+    /* only allowed to return the number of bytes asked for */
+    mylen = len<(buflen-1) ? len : (buflen-1);
+    memcpy(buffer,p,mylen);
+	buffer[buflen]=0; /* ensure C string terminates */
+
+    PUTBACK;
+    FREETMPS;
+    LEAVE;
+    return count;
+}
+
+
+#if 0
+/* awaiting closepolicy prototype */
+int 
+closepolicy_callback_func(void *clientp)
+{
+   dSP;
+   int argc, status;
+   SV *pl_status;
+
+   ENTER;
+   SAVETMPS;
+
+   PUSHMARK(SP);
+   PUTBACK;
+
+   argc = call_sv(closepolicy_callback, G_SCALAR);
+   SPAGAIN;
+
+   if (argc != 1) {
+      croak
+         ("Unexpected number of arguments returned from closefunction callback\n");
+   }
+   pl_status = POPs;
+   status = SvTRUE(pl_status) ? 0 : 1;
+
+   PUTBACK;
+   FREETMPS;
+   LEAVE;
+
+   return status;
+}
+#endif
+
+
+
+/* Internal write callback. Only used if USE_INTERNAL_VARS was specified */
+
+static size_t internal_write_callback(char *data, size_t size, size_t num,
+    FILE *fp)
+{
+    int i;
+
+    size *= num;
+    if ((contlen + size) >= bufsize) {
+	bufsize *= 2;
+	contbuf = realloc(contbuf, bufsize + 1);
+	bufptr = contbuf + contlen;
+    }
+    contlen += size;
+    for (i = 0; i < size; i++) {
+	*bufptr++ = *data++;
+    }
+    *bufptr = '\0';
+    return size;
+}
+
+
 static int
 constant(char *name, int arg)
 {
@@ -97,6 +443,7 @@ constant(char *name, int arg)
 	case 'G':
 	case 'H':
 	    if (strEQ(name, "HEADER")) return CURLOPT_HEADER;
+        if (strEQ(name, "HEADERFUNCTION")) return CURLOPT_HEADERFUNCTION;
 	    if (strEQ(name, "HTTPHEADER")) return CURLOPT_HTTPHEADER;
 	    if (strEQ(name, "HTTPPOST")) return CURLOPT_HTTPPOST;
 	    if (strEQ(name, "HTTPPROXYTUNNEL")) return CURLOPT_HTTPPROXYTUNNEL;
@@ -124,6 +471,8 @@ constant(char *name, int arg)
 	    break;
 	case 'O':
 	case 'P':
+	    if (strEQ(name, "PASSWDDATA")) return CURLOPT_PASSWDDATA;
+	    if (strEQ(name, "PASSWDFUNCTION")) return CURLOPT_PASSWDFUNCTION;
 	    if (strEQ(name, "PORT")) return CURLOPT_PORT;
 	    if (strEQ(name, "POST")) return CURLOPT_POST;
 	    if (strEQ(name, "POSTFIELDS")) return CURLOPT_POSTFIELDS;
@@ -173,12 +522,13 @@ constant(char *name, int arg)
 	    break;
 	}
     }
+    if (strEQ(name, "USE_INTERNAL_VARS")) return USE_INTERNAL_VARS;
     errno = EINVAL;
     return 0;
 }
 
 
-MODULE = Curl::easy		PACKAGE = Curl::easy		
+MODULE = Curl::easy		PACKAGE = Curl::easy		PREFIX = curl_easy_
 
 int
 constant(name,arg)
@@ -189,56 +539,167 @@ constant(name,arg)
 void *
 curl_easy_init()
 CODE:
-    if (errbufvarname) free(errbufvarname);
-    errbufvarname = NULL;
+    init_globals();
     RETVAL = curl_easy_init();
+    curl_easy_setopt(RETVAL, CURLOPT_HEADERFUNCTION, header_callback_func);
+    curl_easy_setopt(RETVAL, CURLOPT_WRITEFUNCTION, write_callback_func);
 OUTPUT:
     RETVAL
 
+char *
+curl_easy_version()
+CODE:
+	RETVAL=curl_version();
+OUTPUT:
+	RETVAL
 
 int
 curl_easy_setopt(curl, option, value)
 void * curl
 int option
-char * value
+SV * value
 CODE:
     if (option < CURLOPTTYPE_OBJECTPOINT) {
+
 	/* This is an option specifying an integer value: */
-	long value = (long)SvIV(ST(2));
-	RETVAL = curl_easy_setopt(curl, option, value);
+	RETVAL = curl_easy_setopt(curl, option, (long)SvIV(value));
+
     } else if (option == CURLOPT_FILE || option == CURLOPT_INFILE ||
-	    option == CURLOPT_WRITEHEADER) {
-	/* This is an option specifying a FILE * value: */
-	FILE * value = IoIFP(sv_2io(ST(2)));
-	RETVAL = curl_easy_setopt(curl, option, value);
+	    option == CURLOPT_WRITEHEADER || option == CURLOPT_PROGRESSDATA ||
+        option == CURLOPT_PASSWDDATA) {
+	/* This is an option specifying an SV * value: */
+	RETVAL = curl_easy_setopt(curl, option, newSVsv(ST(2)));
+
     } else if (option == CURLOPT_ERRORBUFFER) {
-	SV *sv;
+	/* Pass in variable name for storing error messages... */
 	RETVAL = curl_easy_setopt(curl, option, errbuf);
 	if (errbufvarname) free(errbufvarname);
-	errbufvarname = strdup(value);
-	sv = perl_get_sv(errbufvarname, TRUE | GV_ADDMULTI);
+	errbufvarname = strdup((char *)SvPV(value, PL_na));
+
     } else if (option == CURLOPT_WRITEFUNCTION || option ==
-	    CURLOPT_READFUNCTION || option == CURLOPT_PROGRESSFUNCTION) {
+	    CURLOPT_READFUNCTION || option == CURLOPT_PROGRESSFUNCTION ||
+	    option == CURLOPT_PASSWDFUNCTION || option == CURLOPT_HEADERFUNCTION) {
 	/* This is an option specifying a callback function */
-	/* not yet implemented */
+	switch (option) {
+	case CURLOPT_WRITEFUNCTION:
+	    register_callback(&write_callback, value);
+	    curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, write_callback_func);
+	    break;
+	case CURLOPT_READFUNCTION:
+	    register_callback(&read_callback, value);
+	    curl_easy_setopt(curl, CURLOPT_READFUNCTION, read_callback_func);
+	    break;
+        case CURLOPT_HEADERFUNCTION:
+            register_callback(&header_callback, value);
+	    curl_easy_setopt(curl, CURLOPT_HEADERFUNCTION, header_callback_func);	
+	case CURLOPT_PROGRESSFUNCTION:
+	    register_callback(&progress_callback, value);
+	    curl_easy_setopt(curl, CURLOPT_PROGRESSFUNCTION, progress_callback_func);
+	    break;
+	case CURLOPT_PASSWDFUNCTION:
+	    register_callback(&passwd_callback, value);
+	    curl_easy_setopt(curl, CURLOPT_PASSWDFUNCTION, passwd_callback_func);
+	    break;
+        /* awaiting a prototype for the closepolicy function callback 
+        case CURLOPT_CLOSEFUNCTION:
+            register_callback(&closepolicy_callback, value);
+            curl_easy_setopt(curl, CURLOPT_CLOSEFUNCTION, closepolicy_callback_func);
+            break;
+        */
+	}
 	RETVAL = -1;
+
+    } else if (option == CURLOPT_HTTPHEADER || option == CURLOPT_QUOTE ||
+	    option == CURLOPT_POSTQUOTE) {
+	/* This is an option specifying a list of curl_slist structs: */
+	AV *array = (AV *)SvRV(value);
+	struct curl_slist **slist = NULL;
+	/* We have to find out which list to use... */
+	switch (option) {
+	case CURLOPT_HTTPHEADER:
+	    slist = &httpheader; break;
+	case CURLOPT_QUOTE:
+	    slist = &quote; break;
+	case CURLOPT_POSTQUOTE:
+	    slist = &postquote; break;
+	}
+	/* ...store the values into it... */
+	for (;;) {
+	    SV *sv = av_shift(array);
+	    int len = 0;
+	    char *str = SvPV(sv, len);
+	    if (len == 0) break;
+	    *slist = curl_slist_append(*slist, str);
+	}
+	/* ...and pass the list into curl_easy_setopt() */
+	RETVAL = curl_easy_setopt(curl, option, *slist);
     } else {
-	/* default, option specifying a char * value: */
-	RETVAL = curl_easy_setopt(curl, option, value);
+	/* This is an option specifying a char * value: */
+	RETVAL = curl_easy_setopt(curl, option, SvPV(value, PL_na));
     }
 OUTPUT:
     RETVAL
 
 
 int
+internal_setopt(option, value)
+int option
+int value
+CODE:
+    if (value == 1) {
+	internal_options |= option;
+    } else {
+	internal_options &= !option;
+    }
+    RETVAL = 0;
+OUTPUT:
+    RETVAL
+
+
+int
 curl_easy_perform(curl)
 void * curl 
 CODE:
+    if (internal_options & USE_INTERNAL_VARS) {
+	/* Use internal callback which just stores the content into a buffer. */
+	curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, internal_write_callback);
+	curl_easy_setopt(curl, CURLOPT_HEADER, 1);
+    }
     RETVAL = curl_easy_perform(curl);
     if (RETVAL && errbufvarname) {
+	/* If an error occurred and a varname for error messages has been
+	   specified, store the error message. */
 	SV *sv = perl_get_sv(errbufvarname, TRUE | GV_ADDMULTI);
 	sv_setpv(sv, errbuf);
     }
+    if (!RETVAL && (internal_options & USE_INTERNAL_VARS)) {
+	/* No error and internal variable for the content are to be used:
+	   Split the data into headers and content and store them into
+	   perl variables. */
+	SV *head_sv = perl_get_sv("Curl::easy::headers", TRUE | GV_ADDMULTI);
+	SV *cont_sv = perl_get_sv("Curl::easy::content", TRUE | GV_ADDMULTI);
+	char *p = contbuf;
+	int nl = 0, found = 0;
+	while (p < bufptr) {
+	    if (nl && (*p == '\n' || *p == '\r')) {
+		/* found empty line, end of headers */
+		*p++ = '\0';
+		sv_setpv(head_sv, contbuf);
+		while (*p == '\n' || *p == '\r') {
+		    p++;
+		}
+		sv_setpv(cont_sv, p);
+		found = 1;
+		break;
+	    }
+	    nl = (*p == '\n');
+	    p++;
+	}
+	if (!found) {
+	    sv_setpv(head_sv, "");
+	    sv_setpv(cont_sv, contbuf);
+	}
+    }
 OUTPUT:
     RETVAL
 
@@ -249,6 +710,10 @@ void * curl
 int option
 double value
 CODE:
+#ifdef __GNUC__
+    /* a(void) warnig about unnused variable */
+    (void) value;
+#endif
     switch (option & CURLINFO_TYPEMASK) {
 	case CURLINFO_STRING: {
 	    char * value = (char *)SvPV(ST(2), PL_na);
@@ -282,8 +747,7 @@ curl_easy_cleanup(curl)
 void * curl 
 CODE:
     curl_easy_cleanup(curl);
-    if (errbufvarname) free(errbufvarname);
-    errbufvarname = NULL;
+    init_globals();
     RETVAL = 0;
 OUTPUT:
     RETVAL
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";