mirror of https://github.com/moparisthebest/curl
Cris Bailiff's and Georg Horn's big improvements
This commit is contained in:
Daniel Stenberg
parent
8274bee963
commit
ebcafe73b3
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"}
|
||||
);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 = "e; 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
|
||||
|
|
|
|||
|
|
@ -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";
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue