diff options
Diffstat (limited to 'Curl.xs')
| -rw-r--r-- | Curl.xs | 1190 |
1 files changed, 1190 insertions, 0 deletions
@@ -0,0 +1,1190 @@ + +/* + * Perl interface for libcurl. Check out the file README for more info. + */ + +/* + * Copyright (C) 2000, 2001, 2002, 2005, 2008 Daniel Stenberg, Cris Bailiff, et al. + * You may opt to use, copy, modify, merge, publish, distribute and/or + * sell copies of the Software, and permit persons to whom the + * Software is furnished to do so, under the terms of the MPL or + * the MIT/X-derivate licenses. You may pick one of these licenses. + */ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include <curl/curl.h> +#include <curl/easy.h> +#include <curl/multi.h> + +#define header_callback_func writeheader_callback_func + +/* Do a favor for older perl versions */ +#ifndef Newxz +# define Newxz(v,n,t) Newz(0,v,n,t) +#endif + +typedef enum { + CALLBACK_WRITE = 0, + CALLBACK_READ, + CALLBACK_HEADER, + CALLBACK_PROGRESS, + CALLBACK_DEBUG, + CALLBACK_LAST +} perl_curl_easy_callback_code; + +typedef enum { + SLIST_HTTPHEADER = 0, + SLIST_QUOTE, + SLIST_POSTQUOTE, + SLIST_LAST +} perl_curl_easy_slist_code; + + +typedef struct { + /* The main curl handle */ + struct CURL *curl; + I32 *y; + /* Lists that can be set via curl_easy_setopt() */ + struct curl_slist *slist[SLIST_LAST]; + SV *callback[CALLBACK_LAST]; + SV *callback_ctx[CALLBACK_LAST]; + + /* copy of error buffer var for caller*/ + char errbuf[CURL_ERROR_SIZE+1]; + char *errbufvarname; + +} perl_curl_easy; + + +typedef struct { + struct HttpPost * post; + struct HttpPost * last; +} perl_curl_form; + + +typedef struct { +#ifdef __CURL_MULTI_H + struct CURLM *curlm; +#else + struct void *curlm; +#endif +} perl_curl_multi; + +typedef struct { + struct CURLSH *curlsh; +} perl_curl_share; + + +/* switch from curl option codes to the relevant callback index */ +static perl_curl_easy_callback_code callback_index(int option) +{ + switch(option) { + case CURLOPT_WRITEFUNCTION: + case CURLOPT_FILE: + return CALLBACK_WRITE; + break; + + case CURLOPT_READFUNCTION: + case CURLOPT_INFILE: + return CALLBACK_READ; + break; + + case CURLOPT_HEADERFUNCTION: + case CURLOPT_WRITEHEADER: + return CALLBACK_HEADER; + break; + + case CURLOPT_PROGRESSFUNCTION: + case CURLOPT_PROGRESSDATA: + return CALLBACK_PROGRESS; + break; + case CURLOPT_DEBUGFUNCTION: + case CURLOPT_DEBUGDATA: + return CALLBACK_DEBUG; + break; + } + croak("Bad callback index requested\n"); + return CALLBACK_LAST; +} + +/* switch from curl slist names to an slist index */ +static perl_curl_easy_slist_code slist_index(int option) +{ + switch(option) { + case CURLOPT_HTTPHEADER: + return SLIST_HTTPHEADER; + break; + case CURLOPT_QUOTE: + return SLIST_QUOTE; + break; + case CURLOPT_POSTQUOTE: + return SLIST_POSTQUOTE; + break; + } + croak("Bad slist index requested\n"); + return SLIST_LAST; +} + +static perl_curl_easy * perl_curl_easy_new() +{ + perl_curl_easy *self; + Newz(1, self, 1, perl_curl_easy); + if (!self) + croak("out of memory"); + self->curl=curl_easy_init(); + return self; +} + +static perl_curl_easy * perl_curl_easy_duphandle(perl_curl_easy *orig) +{ + perl_curl_easy *self; + Newz(1, self, 1, perl_curl_easy); + if (!self) + croak("out of memory"); + self->curl=curl_easy_duphandle(orig->curl); + return self; +} + +static void perl_curl_easy_delete(perl_curl_easy *self) +{ + perl_curl_easy_slist_code index; + perl_curl_easy_callback_code i; + + if (self->curl) + curl_easy_cleanup(self->curl); + + *self->y = *self->y - 1; + if (*self->y <= 0) { + for (index=0;index<SLIST_LAST;index++) { + if (self->slist[index]) curl_slist_free_all(self->slist[index]); + }; + Safefree(self->y); + } + for(i=0;i<CALLBACK_LAST;i++) { + sv_2mortal(self->callback[i]); + } + for(i=0;i<CALLBACK_LAST;i++) { + sv_2mortal(self->callback_ctx[i]); + } + + + if (self->errbufvarname) + free(self->errbufvarname); + + Safefree(self); + +} + +/* Register a callback function */ + +static void perl_curl_easy_register_callback(perl_curl_easy *self, SV **callback, SV *function) +{ + if (function && SvOK(function)) { + /* FIXME: need to check the ref-counts here */ + if (*callback == NULL) { + *callback = newSVsv(function); + } else { + SvSetSV(*callback, function); + } + } else { + if (*callback != NULL) { + sv_2mortal(*callback); + *callback = NULL; + } + } +} + +/* start of form functions - very un-finished! */ +static perl_curl_form * perl_curl_form_new() +{ + perl_curl_form *self; + Newz(1, self, 1, perl_curl_form); + if (!self) + croak("out of memory"); + self->post=NULL; + self->last=NULL; + return self; +} + +static void perl_curl_form_delete(perl_curl_form *self) +{ +#if 0 + if (self->post) { + curl_formfree(self->post); + } +#endif + Safefree(self); +} + +/* make a new multi */ +static perl_curl_multi * perl_curl_multi_new() +{ + perl_curl_multi *self; + Newz(1, self, 1, perl_curl_multi); + if (!self) + croak("out of memory"); +#ifdef __CURL_MULTI_H + self->curlm=curl_multi_init(); +#else + croak("curl version too old to support curl_multi_init()"); +#endif + return self; +} + +/* delete the multi */ +static void perl_curl_multi_delete(perl_curl_multi *self) +{ +#ifdef __CURL_MULTI_H + if (self->curlm) + curl_multi_cleanup(self->curlm); + Safefree(self); +#endif + +} + +/* make a new share */ +static perl_curl_share * perl_curl_share_new() +{ + perl_curl_share *self; + Newz(1, self, 1, perl_curl_share); + if (!self) + croak("out of memory"); + self->curlsh=curl_share_init(); + return self; +} + +/* delete the share */ +static void perl_curl_share_delete(perl_curl_share *self) +{ + if (self->curlsh) + curl_share_cleanup(self->curlsh); + Safefree(self); +} + + +/* generic fwrite callback, which decides which callback to call */ +static size_t +fwrite_wrapper ( + const void *ptr, + size_t size, + size_t nmemb, + perl_curl_easy *self, + void *call_function, + void *call_ctx) +{ + dSP; + + if (call_function) { /* We are doing a callback to perl */ + int count, status; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + + if (ptr) { + XPUSHs(sv_2mortal(newSVpvn((char *)ptr, (STRLEN)(size * nmemb)))); + } else { /* just in case */ + XPUSHs(&PL_sv_undef); + } + if (call_ctx) { + XPUSHs(sv_2mortal(newSVsv(call_ctx))); + } else { /* should be a stdio glob ? */ + XPUSHs(&PL_sv_undef); + } + + PUTBACK; + count = perl_call_sv((SV *) call_function, G_SCALAR); + SPAGAIN; + + if (count != 1) + croak("callback for CURLOPT_WRITEFUNCTION didn't return a status\n"); + + status = POPi; + + PUTBACK; + FREETMPS; + LEAVE; + return status; + + } else { + /* perform write directly, via PerlIO */ + + PerlIO *handle; + if (call_ctx) { /* Assume the context is a GLOB */ + handle = IoOFP(sv_2io(call_ctx)); + + } else { /* punt to stdout */ + handle = PerlIO_stdout(); + } + return PerlIO_write(handle,ptr,size*nmemb); + } +} + +/* debug fwrite callback */ +static size_t +fwrite_wrapper2 ( + const void *ptr, + size_t size, + perl_curl_easy *self, + void *call_function, + void *call_ctx, + int curl_infotype) +{ + dSP; + + if (call_function) { /* We are doing a callback to perl */ + int count, status; + SV *sv; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + + if (ptr) { + XPUSHs(sv_2mortal(newSVpvn((char *)ptr, (STRLEN)(size * sizeof(char))))); + } else { /* just in case */ + XPUSHs(&PL_sv_undef); + } + + if (call_ctx) { + XPUSHs(sv_2mortal(newSVsv(call_ctx))); + } else { /* should be a stdio glob ? */ + XPUSHs(&PL_sv_undef); + } + + XPUSHs(sv_2mortal(newSViv(curl_infotype))); + + PUTBACK; + count = perl_call_sv((SV *) call_function, G_SCALAR); + SPAGAIN; + + if (count != 1) + croak("callback for CURLOPT_*FUNCTION didn't return a status\n"); + + status = POPi; + + PUTBACK; + FREETMPS; + LEAVE; + return status; + + } else { + /* perform write directly, via PerlIO */ + + PerlIO *handle; + if (call_ctx) { /* Assume the context is a GLOB */ + handle = IoOFP(sv_2io(call_ctx)); + + } else { /* punt to stdout */ + handle = PerlIO_stdout(); + } + return PerlIO_write(handle,ptr,size*sizeof(char)); + } +} + +/* Write callback for calling a perl callback */ +size_t +write_callback_func(const void *ptr, size_t size, size_t nmemb, void *stream) +{ + perl_curl_easy *self; + self=(perl_curl_easy *)stream; + return fwrite_wrapper(ptr,size,nmemb,self, + self->callback[CALLBACK_WRITE],self->callback_ctx[CALLBACK_WRITE]); +} + +/* header callback for calling a perl callback */ +size_t +writeheader_callback_func(const void *ptr, size_t size, size_t nmemb, void *stream) +{ + perl_curl_easy *self; + self=(perl_curl_easy *)stream; + + return fwrite_wrapper(ptr,size,nmemb,self, + self->callback[CALLBACK_HEADER],self->callback_ctx[CALLBACK_HEADER]); +} + +/* debug callback for calling a perl callback */ +size_t +debug_callback_func(CURL* handle, int curl_infotype, const void *ptr, size_t size, void *stream) +{ + perl_curl_easy *self; + self=(perl_curl_easy *)stream; + + return fwrite_wrapper2(ptr,size,self, + self->callback[CALLBACK_DEBUG],self->callback_ctx[CALLBACK_DEBUG],curl_infotype); +} + +/* read callback for calling a perl callback */ +size_t +read_callback_func( void *ptr, size_t size, size_t nmemb, void *stream) +{ + dSP ; + + size_t maxlen; + perl_curl_easy *self; + self=(perl_curl_easy *)stream; + + maxlen = size*nmemb; + + if (self->callback[CALLBACK_READ]) { /* We are doing a callback to perl */ + char *data; + int count; + SV *sv; + STRLEN len; + + ENTER ; + SAVETMPS ; + + PUSHMARK(SP) ; + + if (self->callback_ctx[CALLBACK_READ]) { + sv = self->callback_ctx[CALLBACK_READ]; + } else { + sv = &PL_sv_undef; + } + + XPUSHs(sv_2mortal(newSViv(maxlen))); + XPUSHs(sv_2mortal(newSVsv(sv))); + + PUTBACK ; + count = perl_call_sv(self->callback[CALLBACK_READ], G_SCALAR); + SPAGAIN; + + if (count != 1) + croak("callback for CURLOPT_READFUNCTION didn't return any data\n"); + + sv = POPs; + data = SvPV(sv,len); + + /* only allowed to return the number of bytes asked for */ + len = (len<maxlen ? len : maxlen); + /* memcpy(ptr,data,(size_t)len); */ + Copy(data,ptr,len,char); + + PUTBACK ; + FREETMPS ; + LEAVE ; + return (size_t) (len/size); + + } else { + /* read input directly */ + PerlIO *f; + if (self->callback_ctx[CALLBACK_READ]) { /* hope its a GLOB! */ + f = IoIFP(sv_2io(self->callback_ctx[CALLBACK_READ])); + } else { /* punt to stdin */ + f = PerlIO_stdin(); + } + return PerlIO_read(f,ptr,maxlen); + } +} + +/* Progress callback for calling a perl callback */ + +static int progress_callback_func(void *clientp, double dltotal, double dlnow, + double ultotal, double ulnow) +{ + dSP; + + int count; + perl_curl_easy *self; + self=(perl_curl_easy *)clientp; + + ENTER; + SAVETMPS; + PUSHMARK(sp); + if (self->callback_ctx[CALLBACK_PROGRESS]) { + XPUSHs(sv_2mortal(newSVsv(self->callback_ctx[CALLBACK_PROGRESS]))); + } else { + XPUSHs(&PL_sv_undef); + } + XPUSHs(sv_2mortal(newSVnv(dltotal))); + XPUSHs(sv_2mortal(newSVnv(dlnow))); + XPUSHs(sv_2mortal(newSVnv(ultotal))); + XPUSHs(sv_2mortal(newSVnv(ulnow))); + + PUTBACK; + count = perl_call_sv(self->callback[CALLBACK_PROGRESS], G_SCALAR); + SPAGAIN; + + if (count != 1) + croak("callback for CURLOPT_PROGRESSFUNCTION didn't return 1\n"); + + count = POPi; + + 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 = perl_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 + +#include "curlopt-constants.c" + +typedef perl_curl_easy * WWW__Curl__Easy; + +typedef perl_curl_form * WWW__Curl__Form; + +typedef perl_curl_multi * WWW__Curl__Multi; + +typedef perl_curl_share * WWW__Curl__Share; + +MODULE = WWW::Curl PACKAGE = WWW::Curl::Easy PREFIX = curl_easy_ + +BOOT: + curl_global_init(CURL_GLOBAL_ALL); /* FIXME: does this need a mutex for ithreads? */ + + +PROTOTYPES: ENABLE + +int +constant(name,arg) + char * name + int arg + + +void +curl_easy_init(...) + ALIAS: + new = 1 + PREINIT: + perl_curl_easy *self; + char *sclass = "WWW::Curl::Easy"; + + PPCODE: + if (items>0 && !SvROK(ST(0))) { + STRLEN dummy; + sclass = SvPV(ST(0),dummy); + } + + self=perl_curl_easy_new(); /* curl handle created by this point */ + ST(0) = sv_newmortal(); + sv_setref_pv(ST(0), sclass, (void*)self); + SvREADONLY_on(SvRV(ST(0))); + + Newxz(self->y,1,I32); + if (!self->y) { croak ("out of memory"); } + (*self->y)++; + /* configure curl to always callback to the XS interface layer */ + curl_easy_setopt(self->curl, CURLOPT_WRITEFUNCTION, write_callback_func); + curl_easy_setopt(self->curl, CURLOPT_READFUNCTION, read_callback_func); + + /* set our own object as the context for all curl callbacks */ + curl_easy_setopt(self->curl, CURLOPT_FILE, self); + curl_easy_setopt(self->curl, CURLOPT_INFILE, self); + + /* we always collect this, in case it's wanted */ + curl_easy_setopt(self->curl, CURLOPT_ERRORBUFFER, self->errbuf); + + XSRETURN(1); + +void +curl_easy_duphandle(self) + WWW::Curl::Easy self + PREINIT: + perl_curl_easy *clone; + char *sclass = "WWW::Curl::Easy"; + perl_curl_easy_callback_code i; + + PPCODE: + clone=perl_curl_easy_duphandle(self); + clone->y = self->y; + (*self->y)++; + + ST(0) = sv_newmortal(); + sv_setref_pv(ST(0), sclass, (void*)clone); + SvREADONLY_on(SvRV(ST(0))); + + /* configure curl to always callback to the XS interface layer */ + + curl_easy_setopt(clone->curl, CURLOPT_WRITEFUNCTION, write_callback_func); + curl_easy_setopt(clone->curl, CURLOPT_READFUNCTION, read_callback_func); + if (self->callback[callback_index(CURLOPT_HEADERFUNCTION)] || self->callback_ctx[callback_index(CURLOPT_WRITEHEADER)]) { + curl_easy_setopt(clone->curl, CURLOPT_HEADERFUNCTION, header_callback_func); + curl_easy_setopt(clone->curl, CURLOPT_WRITEHEADER, clone); + } + + if (self->callback[callback_index(CURLOPT_PROGRESSFUNCTION)] || self->callback_ctx[callback_index(CURLOPT_PROGRESSDATA)]) { + curl_easy_setopt(clone->curl, CURLOPT_PROGRESSFUNCTION, progress_callback_func); + curl_easy_setopt(clone->curl, CURLOPT_PROGRESSDATA, clone); + } + + if (self->callback[callback_index(CURLOPT_DEBUGFUNCTION)] || self->callback_ctx[callback_index(CURLOPT_DEBUGDATA)]) { + curl_easy_setopt(clone->curl, CURLOPT_DEBUGFUNCTION, debug_callback_func); + curl_easy_setopt(clone->curl, CURLOPT_DEBUGDATA, clone); + } + + /* set our own object as the context for all curl callbacks */ + curl_easy_setopt(clone->curl, CURLOPT_FILE, clone); + curl_easy_setopt(clone->curl, CURLOPT_INFILE, clone); + curl_easy_setopt(clone->curl, CURLOPT_ERRORBUFFER, clone->errbuf); + + for(i=0;i<CALLBACK_LAST;i++) { + perl_curl_easy_register_callback(clone,&(clone->callback[i]), self->callback[i]); + perl_curl_easy_register_callback(clone,&(clone->callback_ctx[i]), self->callback_ctx[i]); + }; + + XSRETURN(1); + +char * +curl_easy_version(...) + CODE: + RETVAL=curl_version(); + OUTPUT: + RETVAL + +int +curl_easy_setopt(self, option, value) + WWW::Curl::Easy self + int option + SV * value + CODE: + RETVAL=CURLE_OK; + switch(option) { + /* SV * to user contexts for callbacks - any SV (glob,scalar,ref) */ + case CURLOPT_FILE: + case CURLOPT_INFILE: + perl_curl_easy_register_callback(self, + &(self->callback_ctx[callback_index(option)]), value); + break; + case CURLOPT_WRITEHEADER: + curl_easy_setopt(self->curl, CURLOPT_HEADERFUNCTION, SvOK(value) ? header_callback_func : NULL); + curl_easy_setopt(self->curl, option, SvOK(value) ? self : NULL); + perl_curl_easy_register_callback(self,&(self->callback_ctx[callback_index(option)]),value); + break; + case CURLOPT_PROGRESSDATA: + curl_easy_setopt(self->curl, CURLOPT_PROGRESSFUNCTION, SvOK(value) ? progress_callback_func : NULL); + curl_easy_setopt(self->curl, option, SvOK(value) ? self : NULL); + perl_curl_easy_register_callback(self,&(self->callback_ctx[callback_index(option)]), value); + break; + case CURLOPT_DEBUGDATA: + curl_easy_setopt(self->curl, CURLOPT_DEBUGFUNCTION, SvOK(value) ? debug_callback_func : NULL); + curl_easy_setopt(self->curl, option, SvOK(value) ? self : NULL); + perl_curl_easy_register_callback(self,&(self->callback_ctx[callback_index(option)]), value); + break; + + /* SV * to a subroutine ref */ + case CURLOPT_WRITEFUNCTION: + case CURLOPT_READFUNCTION: + perl_curl_easy_register_callback(self,&(self->callback[callback_index(option)]), value); + break; + case CURLOPT_HEADERFUNCTION: + curl_easy_setopt(self->curl, option, SvOK(value) ? header_callback_func : NULL); + curl_easy_setopt(self->curl, CURLOPT_WRITEHEADER, SvOK(value) ? self : NULL); + perl_curl_easy_register_callback(self,&(self->callback[callback_index(option)]), value); + break; + case CURLOPT_PROGRESSFUNCTION: + curl_easy_setopt(self->curl, option, SvOK(value) ? progress_callback_func : NULL); + curl_easy_setopt(self->curl, CURLOPT_PROGRESSDATA, SvOK(value) ? self : NULL); + perl_curl_easy_register_callback(self,&(self->callback[callback_index(option)]), value); + break; + case CURLOPT_DEBUGFUNCTION: + curl_easy_setopt(self->curl, option, SvOK(value) ? debug_callback_func : NULL); + curl_easy_setopt(self->curl, CURLOPT_DEBUGDATA, SvOK(value) ? self : NULL); + perl_curl_easy_register_callback(self,&(self->callback[callback_index(option)]), value); + break; + + /* slist cases */ + case CURLOPT_HTTPHEADER: + case CURLOPT_QUOTE: + case CURLOPT_POSTQUOTE: + { + /* This is an option specifying a list, which we put in a curl_slist struct */ + AV *array = (AV *)SvRV(value); + struct curl_slist **slist = NULL; + int last = av_len(array); + int i; + + /* We have to find out which list to use... */ + slist = &(self->slist[slist_index(option)]); + + /* free any previous list */ + if (*slist) { + curl_slist_free_all(*slist); + *slist=NULL; + } + /* copy perl values into this slist */ + for (i=0;i<=last;i++) { + SV **sv = av_fetch(array,i,0); + STRLEN len = 0; + char *string = SvPV(*sv, len); + if (len == 0) /* FIXME: is this correct? */ + break; + *slist = curl_slist_append(*slist, string); + } + /* pass the list into curl_easy_setopt() */ + RETVAL = curl_easy_setopt(self->curl, option, *slist); + }; + break; + + /* Pass in variable name for storing error messages. Yuck. */ + case CURLOPT_ERRORBUFFER: + { + STRLEN dummy; + if (self->errbufvarname) + free(self->errbufvarname); + self->errbufvarname = strdup((char *)SvPV(value, dummy)); + }; + break; + + /* tell curl to redirect STDERR - value should be a glob */ + case CURLOPT_STDERR: + RETVAL = curl_easy_setopt(self->curl, option, IoOFP(sv_2io(value)) ); + break; + + /* not working yet... + case CURLOPT_HTTPPOST: + if (sv_derived_from(value, "WWW::Curl::Form")) { + WWW__Curl__form wrapper; + IV tmp = SvIV((SV*)SvRV(value)); + wrapper = INT2PTR(WWW__Curl__form,tmp); + RETVAL = curl_easy_setopt(self->curl, option, wrapper->post); + } else + croak("value is not of type WWW::Curl::Form"); + break; + */ + + /* Curl share support from Anton Fedorov */ +#if (LIBCURL_VERSION_NUM>=0x070a03) + case CURLOPT_SHARE: + if (sv_derived_from(value, "WWW::Curl::Share")) { + WWW__Curl__Share wrapper; + IV tmp = SvIV((SV*)SvRV(value)); + wrapper = INT2PTR(WWW__Curl__Share,tmp); + RETVAL = curl_easy_setopt(self->curl, option, wrapper->curlsh); + } else + croak("value is not of type WWW::Curl::Share"); + break; +#endif + case CURLOPT_PRIVATE: + RETVAL = curl_easy_setopt(self->curl, option, (long)SvIV(value)); + break; + + /* default cases */ + default: + if (option < CURLOPTTYPE_OBJECTPOINT) { /* A long (integer) value */ + RETVAL = curl_easy_setopt(self->curl, option, (long)SvIV(value)); + } + else if (option < CURLOPTTYPE_FUNCTIONPOINT) { /* An objectpoint - string */ + /* FIXME: Does curl really want NULL for empty strings? */ + STRLEN dummy; + char *pv = SvPV(value, dummy); + RETVAL = curl_easy_setopt(self->curl, option, SvOK(value) ? pv : NULL); + } +#ifdef CURLOPTTYPE_OFF_T + else if (option < CURLOPTTYPE_OFF_T) { /* A function - notreached? */ + croak("Unknown curl option of type function"); + } + else { /* A LARGE file option using curl_off_t */ + RETVAL = curl_easy_setopt(self->curl, option, (curl_off_t)SvIV(value)); + } +#endif + ; + break; + }; + OUTPUT: + RETVAL + +int +internal_setopt(self, option, value) + WWW::Curl::Easy self + int option + int value + CODE: + croak("internal_setopt no longer supported - use a callback\n"); + RETVAL = 0; + OUTPUT: + RETVAL + +int +curl_easy_perform(self) + WWW::Curl::Easy self + CODE: + /* perform the actual curl fetch */ + RETVAL = curl_easy_perform(self->curl); + + if (RETVAL && self->errbufvarname) { + /* If an error occurred and a varname for error messages has been + specified, store the error message. */ + SV *sv = perl_get_sv(self->errbufvarname, TRUE | GV_ADDMULTI); + sv_setpv(sv, self->errbuf); + } + OUTPUT: + RETVAL + + +SV * +curl_easy_getinfo(self, option, ... ) + WWW::Curl::Easy self + int option + CODE: + switch (option & CURLINFO_TYPEMASK) { + case CURLINFO_STRING: + { + char * vchar; + curl_easy_getinfo(self->curl, option, &vchar); + RETVAL = newSVpv(vchar,0); + break; + } + case CURLINFO_LONG: + { + long vlong; + curl_easy_getinfo(self->curl, option, &vlong); + RETVAL = newSViv(vlong); + break; + } + case CURLINFO_DOUBLE: + { + double vdouble; + curl_easy_getinfo(self->curl, option, &vdouble); + RETVAL = newSVnv(vdouble); + break; + } + default: { + RETVAL = newSViv(CURLE_BAD_FUNCTION_ARGUMENT); + break; + } + } + if (items > 2) + sv_setsv(ST(2),RETVAL); + OUTPUT: + RETVAL + +char * +curl_easy_errbuf(self) + WWW::Curl::Easy self + CODE: + RETVAL = self->errbuf; + OUTPUT: + RETVAL + +int +curl_easy_cleanup(self) + WWW::Curl::Easy self + CODE: + /* does nothing anymore - cleanup is automatic when a curl handle goes out of scope */ + RETVAL = 0; + OUTPUT: + RETVAL + +void +curl_easy_DESTROY(self) + WWW::Curl::Easy self + CODE: + perl_curl_easy_delete(self); + +void +curl_easy_global_cleanup() + CODE: + curl_global_cleanup(); + +SV * +curl_easy_strerror(self, errornum) + WWW::Curl::Easy self + int errornum + CODE: + { +#if (LIBCURL_VERSION_NUM>=0x070C00) + const char * vchar = curl_easy_strerror(errornum); +#else + const char * vchar = "Unknown because curl_easy_strerror function not available}"; +#endif + RETVAL = newSVpv(vchar,0); + } + OUTPUT: + RETVAL + +MODULE = WWW::Curl PACKAGE = WWW::Curl::Form PREFIX = curl_form_ + +void +curl_form_new(...) + PREINIT: + perl_curl_form *self; + char *sclass = "WWW::Curl::Form"; + PPCODE: + if (items>0 && !SvROK(ST(0))) { + STRLEN dummy; + sclass = SvPV(ST(0),dummy); + } + + self=perl_curl_form_new(); + + ST(0) = sv_newmortal(); + sv_setref_pv(ST(0), sclass, (void*)self); + SvREADONLY_on(SvRV(ST(0))); + + XSRETURN(1); + +void +curl_form_add(self,name,value) + WWW::Curl::Form self + char *name + char *value + CODE: +#if 0 + curl_formadd(&(self->post),&(self->last), + CURLFORM_COPYNAME,name, + CURLFORM_COPYCONTENTS,value, + CURLFORM_END); +#endif + +void +curl_form_addfile(self,filename,description,type) + WWW::Curl::Form self + char *filename + char *description + char *type + CODE: +#if 0 + curl_formadd(&(self->post),&(self->last), + CURLFORM_FILE,filename, + CURLFORM_COPYNAME,description, + CURLFORM_CONTENTTYPE,type, + CURLFORM_END); +#endif + +void +curl_form_DESTROY(self) + WWW::Curl::Form self + CODE: + perl_curl_form_delete(self); + +MODULE = WWW::Curl PACKAGE = WWW::Curl::Multi PREFIX = curl_multi_ + +void +curl_multi_new(...) + PREINIT: + perl_curl_multi *self; + char *sclass = "WWW::Curl::Multi"; + PPCODE: + if (items>0 && !SvROK(ST(0))) { + STRLEN dummy; + sclass = SvPV(ST(0),dummy); + } + + self=perl_curl_multi_new(); + + ST(0) = sv_newmortal(); + sv_setref_pv(ST(0), sclass, (void*)self); + SvREADONLY_on(SvRV(ST(0))); + + XSRETURN(1); + +void +curl_multi_add_handle(curlm, curl) + WWW::Curl::Multi curlm + WWW::Curl::Easy curl + CODE: +#ifdef __CURL_MULTI_H + curl_multi_add_handle(curlm->curlm, curl->curl); +#endif + +void +curl_multi_remove_handle(curlm, curl) + WWW::Curl::Multi curlm + WWW::Curl::Easy curl + CODE: +#ifdef __CURL_MULTI_H + curl_multi_remove_handle(curlm->curlm, curl->curl); +#endif + +void +curl_multi_info_read(self) + WWW::Curl::Multi self + PREINIT: + CURL *easy = NULL; + CURLcode res; + long stashid; + int queue; + CURLMsg *msg; + PPCODE: + while ((msg = curl_multi_info_read(self->curlm, &queue))) { + if (msg->msg == CURLMSG_DONE) { + easy=msg->easy_handle; + res=msg->data.result; + break; + } + }; + if (easy) { + curl_easy_getinfo(easy, CURLINFO_PRIVATE, &stashid); + curl_easy_setopt(easy, CURLINFO_PRIVATE, NULL); + curl_multi_remove_handle(self->curlm, easy); + XPUSHs(sv_2mortal(newSViv(stashid))); + XPUSHs(sv_2mortal(newSViv(res))); + } else { + XSRETURN_EMPTY; + } + +int +curl_multi_perform(self) + WWW::Curl::Multi self + PREINIT: + int remaining; + CODE: +#ifdef __CURL_MULTI_H + while(CURLM_CALL_MULTI_PERFORM == + curl_multi_perform(self->curlm, &remaining)); + RETVAL = remaining; + /* while(remaining) { + struct timeval timeout; + int rc; + fd_set fdread; + fd_set fdwrite; + fd_set fdexcep; + int maxfd; + FD_ZERO(&fdread); + FD_ZERO(&fdwrite); + FD_ZERO(&fdexcep); + timeout.tv_sec = 1; + timeout.tv_usec = 0; + curl_multi_fdset(self->curlm, &fdread, &fdwrite, &fdexcep, &maxfd); + rc = select(maxfd+1, &fdread, &fdwrite, &fdexcep, &timeout); + switch(rc) { + case -1: + break; + default: + while(CURLM_CALL_MULTI_PERFORM == + curl_multi_perform(self->curlm, &remaining)); + break; + } + } */ +#endif + OUTPUT: + RETVAL + +void +curl_multi_DESTROY(self) + WWW::Curl::Multi self + CODE: + perl_curl_multi_delete(self); + +SV * +curl_multi_strerror(self, errornum) + WWW::Curl::Multi self + int errornum + CODE: + { +#if (LIBCURL_VERSION_NUM>=0x070C00) + const char * vchar = curl_multi_strerror(errornum); +#else + const char * vchar = "Unknown because curl_multi_strerror function not available}"; +#endif + RETVAL = newSVpv(vchar,0); + } + OUTPUT: + RETVAL + +MODULE = WWW::Curl PACKAGE = WWW::Curl::Share PREFIX = curl_share_ + +PROTOTYPES: ENABLE + +int +constant(name,arg) + char * name + int arg + +void +curl_share_new(...) + PREINIT: + perl_curl_share *self; + char *sclass = "WWW::Curl::Share"; + PPCODE: + if (items>0 && !SvROK(ST(0))) { + STRLEN dummy; + sclass = SvPV(ST(0),dummy); + } + + self=perl_curl_share_new(); + + ST(0) = sv_newmortal(); + sv_setref_pv(ST(0), sclass, (void*)self); + SvREADONLY_on(SvRV(ST(0))); + + XSRETURN(1); + +void +curl_share_DESTROY(self) + WWW::Curl::Share self + CODE: + perl_curl_share_delete(self); + +int +curl_share_setopt(self, option, value) + WWW::Curl::Share self + int option + SV * value + CODE: + RETVAL=CURLE_OK; +#if (LIBCURL_VERSION_NUM>=0x070a03) + switch(option) { + /* slist cases */ + case CURLSHOPT_SHARE: + case CURLSHOPT_UNSHARE: + if (option < CURLOPTTYPE_OBJECTPOINT) { /* An integer value: */ + RETVAL = curl_share_setopt(self->curlsh, option, (long)SvIV(value)); + } else { /* A char * value: */ + /* FIXME: Does curl really want NULL for empty strings? */ + STRLEN dummy; + char *pv = SvPV(value, dummy); + RETVAL = curl_share_setopt(self->curlsh, option, *pv ? pv : NULL); + }; + break; + }; +#else + croak("curl_share_setopt not supported in your libcurl version"); +#endif + OUTPUT: + RETVAL + +SV * +curl_share_strerror(self, errornum) + WWW::Curl::Share self + int errornum + CODE: + { +#if (LIBCURL_VERSION_NUM>=0x070C00) + const char * vchar = curl_share_strerror(errornum); +#else + const char * vchar = "Unknown because curl_share_strerror function not available}"; +#endif + RETVAL = newSVpv(vchar,0); + } + OUTPUT: + RETVAL |