view release on metacpan or  search on metacpan

Curl_Multi.xsh  view on Meta::CPAN

	AV *array;
	int array_len, i;
	char **blacklist;

	if ( !SvOK( arrayref ) )
		return NULL;
	if ( !SvROK( arrayref ) )
		croak( "not an array" );

	array = (AV *) SvRV( arrayref );
	array_len = av_len( array );
	if ( array_len == -1 )
		return NULL;

	Newxz( blacklist, array_len + 2, char * );

	for ( i = 0; i <= array_len; i++ ) {
		SV **sv;

		sv = av_fetch( array, i, 0 );
		if ( !SvOK( *sv ) )
			continue;
		blacklist[i] = SvPV_nolen( *sv );
	}

	return blacklist;
}

static MGVTBL perl_curl_multi_vtbl = {
	NULL, NULL, NULL, NULL
	,perl_curl_multi_magic_free
	,NULL
	,perl_curl_any_magic_nodup
#ifdef MGf_LOCAL
	,NULL
#endif
};


#define MULTI_DIE( ret )		\
	STMT_START {				\
		CURLMcode code = (ret);	\
		if ( code != CURLM_OK )	\
			die_code( "Multi", code ); \
	} STMT_END


MODULE = Net::Curl	PACKAGE = Net::Curl::Multi

INCLUDE: const-multi-xs.inc

PROTOTYPES: ENABLE

void
new( sclass="Net::Curl::Multi", base=HASHREF_BY_DEFAULT )
	const char *sclass
	SV *base
	PREINIT:
		perl_curl_multi_t *multi;
		HV *stash;
	PPCODE:
		if ( ! SvOK( base ) || ! SvROK( base ) )
			croak( "object base must be a valid reference\n" );

		multi = perl_curl_multi_new();
		perl_curl_setptr( aTHX_ base, &perl_curl_multi_vtbl, multi );

		/* those must be set or else socket_action() segfaults */
		curl_multi_setopt( multi->handle, CURLMOPT_SOCKETFUNCTION,
			cb_multi_socket );
		curl_multi_setopt( multi->handle, CURLMOPT_SOCKETDATA, multi );

		stash = gv_stashpv( sclass, 0 );
		ST(0) = sv_bless( base, stash );

		multi->perl_self = SvRV( ST(0) );

		XSRETURN(1);


void
add_handle( multi, easy )
	Net::Curl::Multi multi
	Net::Curl::Easy easy
	PREINIT:
		CURLMcode ret;
	CODE:
		if ( easy->multi )
			croak( "Specified easy handle is attached to %s multi handle already",
				easy->multi == multi ? "this" : "another" );

		ret = curl_multi_add_handle( multi->handle, easy->handle );
		if ( !ret ) {
			SV **easysv_ptr;
			easysv_ptr = perl_curl_simplell_add( aTHX_ &multi->easies,
				PTR2nat( easy ) );
			*easysv_ptr = SELF2PERL( easy );
			easy->multi = multi;
		}
		MULTI_DIE( ret );

void
remove_handle( multi, easy )
	Net::Curl::Multi multi
	Net::Curl::Easy easy
	PREINIT:
		CURLMcode ret;
	CODE:
		CLEAR_ERRSV();
		if ( easy->multi != multi )
			croak( "Specified easy handle is not attached to %s multi handle",
				easy->multi ? "this" : "any" );

		ret = perl_curl_easy_remove_from_multi( aTHX_ easy );

		/* rethrow errors */
		if ( SvTRUE( ERRSV ) )
			croak( NULL );

		MULTI_DIE( ret );


void
info_read( multi )
	Net::Curl::Multi multi
	PREINIT:
		int queue;
		CURLMsg *msg;
	PPCODE:
		CLEAR_ERRSV();
		while ( (msg = curl_multi_info_read( multi->handle, &queue ) ) ) {
			/* most likely CURLMSG_DONE */
			if ( msg->msg != CURLMSG_NONE && msg->msg != CURLMSG_LAST ) {
				Net__Curl__Easy easy;
				SV *errsv;

				curl_easy_getinfo( msg->easy_handle,
					CURLINFO_PRIVATE, (void *) &easy );

				EXTEND( SP, 3 );
				mPUSHs( newSViv( msg->msg ) );
				mPUSHs( SELF2PERL( easy ) );

				errsv = sv_newmortal();
				sv_setref_iv( errsv, "Net::Curl::Easy::Code",
					msg->data.result );
				PUSHs( errsv );

				/* cannot rethrow errors, because we want to make sure we
				 * return the easy, but $@ should be set */

				XSRETURN( 3 );
			}

			/* rethrow errors */
			if ( SvTRUE( ERRSV ) )
				croak( NULL );
		};

		/* rethrow errors */
		if ( SvTRUE( ERRSV ) )
			croak( NULL );

		XSRETURN_EMPTY;


void
fdset( multi )
	Net::Curl::Multi multi
	PREINIT:
		CURLMcode ret;
		fd_set fdread, fdwrite, fdexcep;
		int maxfd, i;
		int readsize, writesize, excepsize;
		unsigned char readset[ sizeof( fd_set ) ] = { 0 };
		unsigned char writeset[ sizeof( fd_set ) ] = { 0 };
		unsigned char excepset[ sizeof( fd_set ) ] = { 0 };
	PPCODE:
		FD_ZERO( &fdread );
		FD_ZERO( &fdwrite );
		FD_ZERO( &fdexcep );

		ret = curl_multi_fdset( multi->handle,
			&fdread, &fdwrite, &fdexcep, &maxfd );
		MULTI_DIE( ret );

		readsize = writesize = excepsize = 0;

		/* TODO: this is rather slow, should copy whole bytes instead, but
		 * some fdset implementations may be hard to predict */
		if ( maxfd != -1 ) {
			for ( i = 0; i <= maxfd; i++ ) {
				if ( FD_ISSET( i, &fdread ) ) {
					readsize = i / 8 + 1;
					readset[ i / 8 ] |= 1 << ( i % 8 );
				}
				if ( FD_ISSET( i, &fdwrite ) ) {
					writesize = i / 8 + 1;
					writeset[ i / 8 ] |= 1 << ( i % 8 );
				}
				if ( FD_ISSET( i, &fdexcep ) ) {
					excepsize = i / 8 + 1;
					excepset[ i / 8 ] |= 1 << ( i % 8 );
				}
			}
		}

		EXTEND( SP, 3 );
		mPUSHs( newSVpvn( (char *) readset, readsize ) );
		mPUSHs( newSVpvn( (char *) writeset, writesize ) );
		mPUSHs( newSVpvn( (char *) excepset, excepsize ) );


long
timeout( multi )
	Net::Curl::Multi multi
	PREINIT:
		long timeout;
		CURLMcode ret;
	CODE:
		ret = curl_multi_timeout( multi->handle, &timeout );
		MULTI_DIE( ret );

		RETVAL = timeout;
	OUTPUT:
		RETVAL

void
setopt( multi, option, value )
	Net::Curl::Multi multi
	int option
	SV *value
	PREINIT:
		CURLMcode ret1 = CURLM_OK, ret2 = CURLM_OK;
#ifdef CURLMOPT_PIPELINING_SERVER_BL
#ifdef CURLMOPT_PIPELINING_SITE_BL
		char **blacklist;
#endif

Curl_Multi.xsh  view on Meta::CPAN

		RETVAL = remaining;
	OUTPUT:
		RETVAL


#if LIBCURL_VERSION_NUM >= 0x070f05

void
assign( multi, sockfd, value=NULL )
	Net::Curl::Multi multi
	unsigned long sockfd
	SV *value
	PREINIT:
		CURLMcode ret;
		void *sockptr;
	CODE:
		if ( value && SvOK( value ) ) {
			SV **valueptr;
			valueptr = perl_curl_simplell_add( aTHX_ &multi->socket_data,
				sockfd );
			if ( !valueptr )
				croak( "internal Net::Curl error" );
			if ( *valueptr )
				sv_2mortal( *valueptr );
			sockptr = *valueptr = newSVsv( value );
		} else {
			SV *oldvalue;
			oldvalue = perl_curl_simplell_del( aTHX_ &multi->socket_data, sockfd );
			if ( oldvalue )
				sv_2mortal( oldvalue );
			sockptr = NULL;
		}
		ret = curl_multi_assign( multi->handle, sockfd, sockptr );
		MULTI_DIE( ret );

#endif


SV *
strerror( ... )
	PROTOTYPE: $;$
	PREINIT:
		const char *errstr;
	CODE:
		if ( items < 1 || items > 2 )
			croak( "Usage: Net::Curl::Multi::strerror( [multi], errnum )" );
		errstr = curl_multi_strerror( SvIV( ST( items - 1 ) ) );
		RETVAL = newSVpv( errstr, 0 );
	OUTPUT:
		RETVAL


# /* Extensions: Functions that do not have libcurl equivalents. */


void
handles( multi )
	Net::Curl::Multi multi
	PREINIT:
			simplell_t *now;
	PPCODE:
		if ( GIMME_V == G_VOID )
			XSRETURN( 0 );

		now = multi->easies;

		if ( GIMME_V == G_SCALAR ) {
			IV i = 0;
			while ( now ) {
				i++;
				now = now->next;
			}
			ST(0) = newSViv( i );
			XSRETURN( 1 );
		}
		while ( now ) {
			XPUSHs( newSVsv( now->value ) );
			now = now->next;
		}


int
CLONE_SKIP( pkg )
	SV *pkg
	CODE:
		(void ) pkg;
		RETVAL = 1;
	OUTPUT:
		RETVAL