view release on metacpan or  search on metacpan

Curl.xs  view on Meta::CPAN

#ifdef CURLOPT_RESOLVE
    SLIST_RESOLVE,
#endif
    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;
    I32 strings_index;
    char* strings[CURLOPTTYPE_FUNCTIONPOINT - 10000];

} perl_curl_easy;


typedef struct {
    struct curl_httppost * post;
    struct curl_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;
#ifdef CURLOPT_RESOLVE
        case CURLOPT_RESOLVE:
            return SLIST_RESOLVE;
            break;
#endif
    }
    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);
    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);
    self->curl=curl_easy_duphandle(orig->curl);
    return self;
}

static void perl_curl_easy_delete(perl_curl_easy *self)
{
    dTHX;
    perl_curl_easy_slist_code index;

Curl.xs  view on Meta::CPAN

constant(name)
    char * name


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]);
        };
	
	for (i=0;i<=self->strings_index;i++) {
		if (self->strings[i] != NULL) {
			clone->strings[i] = savepv(self->strings[i]);
			curl_easy_setopt(clone->curl, 10000 + i, clone->strings[i]);
		}
	}
	clone->strings_index = self->strings_index;
        XSRETURN(1);

char *
curl_easy_version(...)
    CODE:
        RETVAL=curl_version();
    OUTPUT:
        RETVAL

int
curl_easy_setopt(self, option, value, push=0)
        WWW::Curl::Easy self
        int option
        SV * value
        int push
    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:
#ifdef CURLOPT_RESOLVE
            case CURLOPT_RESOLVE:
#endif
            {
                /* 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 && !push) {
                    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 */