glish.xs

linux 下的源代码分析阅读器 red hat公司新版

					{
					SV **vp = hv_fetch(hash,(char*)keys[myoff+XX],key_lens[myoff+XX],0);
					if ( vp )
						{
						/** Get type **/
						strcpy(type_str,TYPEs);
						strcat(type_str,keys[myoff+XX]);
						SV **tp = hv_fetch(hash,type_str,key_lens[myoff+XX]+TY_AT_len,0);
						glish_type type_s = TYPE_ERROR;
						if ( tp && SvIOK(*tp) )
							type_s = get_type(SvIV(*tp));

						/** Create Glish Value **/
						Value *newval = pv2gv(*vp,get_type(type_s));
						ret->SetField(keys[myoff+XX],newval);

						/** Set attributes **/
						strcpy(type_str,ATTRs);
						strcat(type_str,keys[myoff+XX]);
						SV **ap = hv_fetch(hash,type_str,key_lens[myoff+XX]+TY_AT_len,0);
						if ( ap )
							{
							Value *newattr = pv2gv(*ap);
							if ( newattr && newattr->Type() == TYPE_RECORD )
								newval->AssignAttributes(newattr);
							else
								Unref(newattr);
							}
						}
					}
				}
			offset -= X;			// Decrement stack pointer
			return ret;
			}
		}
	}

#/***************************************************
#* Perl array -> Glish vector.                      *
#***************************************************/
static Value*
pv2gv_array(AV *array, glish_type type)
	{
	if ( av_len(array) == -1 )
		return empty_glish_value();

	if ( type == TYPE_ERROR )
		{
		SV **vp = av_fetch(array,0,0);
		SV *v = *vp;
		type = get_type(v);
		}
	switch (type)
		{
#define pv2gv_array_action(TYPE,builtin,check,accessor,setup,rest,COPY,cleanup)	\
	case TYPE:							\
		{							\
		builtin *ret_ary = new builtin[av_len(array)+1];	\
		for ( I32 cnt=0; cnt <= av_len(array); cnt++ )		\
			{						\
			SV **vp = av_fetch(array,cnt,0);		\
			SV *v = *vp;					\
			if ( check(v) )					\
				{					\
				setup					\
				ret_ary[cnt] = (builtin) COPY(accessor(v rest));\
				}					\
			else						\
				{					\
				cleanup					\
				delete ret_ary;				\
				return empty_glish_value();		\
				}					\
			}						\
			return new Value(ret_ary,(int)av_len(array)+1);	\
		}							\
		break;

pv2gv_array_action(TYPE_INT,int,SvIOK,SvIV,,,,)
pv2gv_array_action(TYPE_SHORT,short,SvIOK,SvIV,,,,)
pv2gv_array_action(TYPE_BYTE,byte,SvIOK,SvIV,,,,)
pv2gv_array_action(TYPE_FLOAT,float,SvNOK,SvNV,,,,)
pv2gv_array_action(TYPE_DOUBLE,double,SvNOK,SvNV,,,,)
pv2gv_array_action(TYPE_STRING,charptr,SvPOK,SvPV,size_t len;,COMMA(len),
			strdup,for(int XX=0;XX<cnt;XX++) delete (char*)ret_ary[XX];)
		default:
			return empty_glish_value();
		}
	}

#/***************************************************
#* Perl scalar -> Glish vector.                     *
#***************************************************/
static Value*
pv2gv_scalar(SV *val,glish_type type)
	{

	if ( type == TYPE_ERROR )
		type = get_type(val);

	switch (type)
		{
#define pv2gv_scalar_action(TYPE,type,check,accessor,setup,extra)\
	case TYPE:						\
		{						\
		if ( check(val) )				\
			{					\
			setup					\
			type t = (type) accessor(val extra );	\
			return new Value( t );			\
			}					\
		else						\
			return empty_glish_value();		\
		}						\
		break;

pv2gv_scalar_action(TYPE_INT,int,SvIOK,SvIV,,)
pv2gv_scalar_action(TYPE_SHORT,short,SvIOK,SvIV,,)
pv2gv_scalar_action(TYPE_BYTE,byte,SvIOK,SvIV,,)
pv2gv_scalar_action(TYPE_FLOAT,float,SvNOK,SvNV,,)
pv2gv_scalar_action(TYPE_DOUBLE,double,SvNOK,SvNV,,)
pv2gv_scalar_action(TYPE_STRING,charptr,SvPOK,SvPV,STRLEN len;,COMMA(len))
		}
	}


#/***************************************************
#* Convert a Perl value to a Glish value.           *
#***************************************************/
static Value*
pv2gv(SV *val, glish_type type)
	{
	if ( !val )
		return 0;

	if ( SvROK(val) )
		return pv2gv(SvRV(val),type);

	switch( SvTYPE(val) )
		{
		case SVt_PVAV:
			{
			AV *array = (AV*) val;
			return pv2gv_array(array,type);
			}
		case SVt_PVHV:
			{
			HV *hash = (HV*) val;
			return pv2gv_hash(hash,type);
			}
		case SVt_PVCV:
			return empty_glish_value();
		default:
			return pv2gv_scalar(val,type);
		}
	return empty_glish_value();
	}

MODULE = Glish PACKAGE = Glish

BOOT:
#
# Added to the bootstrap code
#
AV* argv_av = perl_get_av("ARGV",FALSE);
I32 argv_cnt = 0;
I32 argv_len = av_len(argv_av);
argv_len += 1;				/* PERL length -1 <-> 0  */
char **argv_real = new char*[argv_len+1];
SV** argv_val;
SV* prog_name = perl_get_sv("0", FALSE);
argv_real[0] = SvPV(prog_name, na);
for ( argv_cnt = 0; argv_cnt < argv_len; argv_cnt++ )
	{
	argv_val = av_fetch(argv_av, argv_cnt, 0);
	argv_real[argv_cnt+1] = SvPV(*argv_val,na);
	}
argv_len += 1;				/* Program name included  */
int al_tmp = (int) argv_len;		/* Temporary arg_len so   */
client = new Client(al_tmp,argv_real);	/*   Client can modify it */
delete argv_real;
if ( ! client )
	{
	croak("Couldn't initialize Glish Client");
	}

#/*****************************************************************
#* Get the next event. Used as follows:                           *
#*                                                                *
#*      ($key,$val,$attr) = nextevent();                          *
#*      ($key,$val,$attr) = nextevent($val_type);                 *
#*      ($key,$val,$attr) = nextevent($val_type,$isrequest);      *
#*                                                                *
#*****************************************************************/
void
nextevent(...)
	PPCODE:
	{
	SV *svtype = 0;
	SV *request = 0;
	GlishEvent* event;
	glish_type type;

	if (items >= 1)
		svtype = ST(0);
	if (items >= 2)
		request = ST(1);

	EXTEND(sp,3);
	event = client->NextEvent();

	if ( event )
		{
		Value *val = event->value;
		PUSHs(sv_2mortal(newSVpv((char*)event->name,strlen(event->name))));
		SV *pv = gv2pv(val,type);
		if ( svtype )
			sv_setiv(svtype,type);
		if ( request )
			sv_setiv(request,(IV)event->IsRequest());
		PUSHs(sv_2mortal(pv));
		const attributeptr aptr = val->AttributePtr();
		if ( aptr )
			{
			SV *svattr = gv2pv_hash(aptr);
			PUSHs(sv_2mortal(svattr));
			}
		else
			{
			PUSHs(&sv_undef);
			}
		}
	else
		{
		type = TYPE_ERROR;
		char *err_str = "Connection closed";
		PUSHs(&sv_undef);
		if ( svtype )
			sv_setiv(svtype,type);
		if ( request )
			sv_setiv(request,0);
		PUSHs(sv_2mortal(newSVpv((char*)err_str,strlen(err_str))));
		PUSHs(&sv_undef);
		}
	}

#/***************************************************
#* Returns the next event; blocks until an event is *
#* available. Invocation format:                    *
#*                                                  *
#*      # Figures out the type from the value       *
#*      postevent(name,value)                       *
#*      # Force a particular Glish type             *
#*      postevent(name,value,type)                  *
#*      # Specify an attribute for the value        *
#*      postevent(name,value,type,$attr)            *
#*                                                  *
#***************************************************/
void
postevent(...)
	PPCODE:
	{
	EXTEND(sp,1);
	if ( items < 2 || !SvPOK(ST(0)) || !SvOK(ST(1)) )
		{
		PUSHs(sv_2mortal(newSViv((IV)0)));
		}
	else if ( items == 2 )
		{
		Value *v = pv2gv(ST(1));
		STRLEN len;
	        char *name = SvPV(ST(0),len);
		client->PostEvent(name,v);
		Unref(v);
		PUSHs(sv_2mortal(newSViv((IV)1)));
		}
	else if ( SvIOK(ST(2)) ) {
	        IV type = SvIV(ST(2));
		Value *v = pv2gv(ST(1),get_type(type));
		STRLEN len;
	        char *name = SvPV(ST(0),len);
		/* handle attribute*/
		if ( items >= 4 && ST(3) != &sv_undef && SvOK(ST(3)) )
			{
			Value *attr = pv2gv(ST(3));
			if (attr->Type() == TYPE_RECORD)
				v->AssignAttributes(attr);
			else
				Unref(attr);
			}
		client->PostEvent(name,v);
		Unref(v);
		PUSHs(sv_2mortal(newSViv((IV)1)));
		}
	else 
		{
		PUSHs(sv_2mortal(newSViv((IV)0)));
		}
	}

#/***************************************************
#* Sends the reply (Client::Reply) to the last      *
#* request that was recieved. Invocation format:    *
#*                                                  *
#*      # Figures out the type from the value       *
#*      reply(value)                                *
#*      # Force a particular Glish type             *
#*	reply(value,type)                           *
#*      # Specify attributes for value              *
#*	reply(value,type,attr)                      *
#*                                                  *
#***************************************************/
void
reply(...)
	PPCODE:
	{
	EXTEND(sp,1);
	if ( items < 1 || !SvOK(ST(0)) )
		{
		PUSHs(sv_2mortal(newSViv((IV)0)));
		}
	else if ( items == 1 )
		{
		Value *v = pv2gv(ST(0));
		client->Reply(v);
		Unref(v);
		PUSHs(sv_2mortal(newSViv((IV)1)));
		}
	else if ( SvIOK(ST(1)) ) {
	        IV type = SvIV(ST(1));
		Value *v = pv2gv(ST(0),get_type(type));
		/* handle attribute*/
		if ( items >= 3 && ST(2) != &sv_undef && SvOK(ST(2)) )
			{
			Value *attr = pv2gv(ST(2));
			if (attr->Type() == TYPE_RECORD)
				v->AssignAttributes(attr);
			else
				Unref(attr);
			}
		client->Reply(v);
		Unref(v);
		PUSHs(sv_2mortal(newSViv((IV)1)));
		}
	else 
		{
		PUSHs(sv_2mortal(newSViv((IV)0)));
		}
	}

#/***************************************************
#* Returns a non-zero value when an event is        *
#* available. Invocation format:                    *
#*                                                  *
#*      waitingevent()                              *
#*                                                  *
#***************************************************/
void
waitingevent()
	PPCODE:
	{
	EXTEND(sp,1);
	fd_set selectSet;
	timeval tv;
	tv.tv_sec = 0;
	tv.tv_usec = 0;
	FD_ZERO(&selectSet);
	client->AddInputMask(&selectSet);
	if ( select(FD_SETSIZE, &selectSet, 0, 0, &tv) > 0 &&
			client->HasClientInput(&selectSet) )
		{
		PUSHs(sv_2mortal(newSViv((IV)1)));
		}
	else
		{	
		PUSHs(sv_2mortal(newSViv((IV)0)));
		}
	}

#/***************************************************
#* Returns a non-zero value when the client is      *
#* running stand-alone. Invocation format:          *
#*                                                  *
#*      standalone()                                *
#*                                                  *
#***************************************************/
void
standalone()
	PPCODE:
	{
	EXTEND(sp,1);
	if ( client->HasInterpreterConnection() )
		{
		PUSHs(sv_2mortal(newSViv((IV)0)));
		}
	else
		{
		PUSHs(sv_2mortal(newSViv((IV)1)));
		}
	}

#/***************************************************
#* Adds the file descriptors used by the client to  *
#* a string which is treated as a bit vector, as    *
#* with Perl's "vec()". The result should be in a   *
#* form usable by Perl's "select()". Invocation     *
#* format:                                          *
#*                                                  *
#*	addfds(vec)                                 *
#*	addfds(vec,offset)                          *
#*                                                  *
#***************************************************/
void
addfds(...)
	PPCODE:
	{
	EXTEND(sp,1);
	register IV offset = 0;
	if ( items < 1)
		{
		PUSHs(sv_2mortal(newSViv((IV)0)));
		}
	else if ( SvPOK(ST(0)) )
		{
		fd_set selectSet;
		FD_ZERO(&selectSet);
		int num_fd = client->AddInputMask(&selectSet);
		if ( num_fd )
			{
			if ( items > 1 && SvIOK(ST(1)) )
				{
				offset = SvIV(ST(1));
				}

			SV *src = ST(0);

			/* len <- the physical allocated length */
			STRLEN len = SvLEN(src);
			/* srclen <- the length of the pre-existing string */
			STRLEN srclen;
			unsigned char *s = (unsigned char*)SvPV(src, srclen);

			STRLEN req_size = (offset + FD_SETSIZE + BITS_PER_BYTE - 1) / BITS_PER_BYTE;

			int failed = 0;

			if ( srclen < req_size )
				{
				/* added one because I believe Perl likes having an extra character */
				if (len < req_size+1)
					{
					SvGROW(src,req_size+1);
					len = SvLEN(src);
					}
				if (len >= req_size+1)
					{
					STRLEN origlen = srclen;
					SvCUR_set(src, req_size); 	/* recognize new size */
					s = (unsigned char*)SvPV(src, srclen);
					memset(&s[origlen],0,len-origlen);
					}
				else
					failed = 1;
				}
			if (! failed )
				{
				/***************************************************************
				* The Perl "vec()" function operates on bytes from low bit to  *
				* high bit. As a result, here we must do the same.             *
				***************************************************************/
				int fd_cnt = 0;
				unsigned char mask = 1;
				int mask_off = 0;

				for (int cur=0; cur < FD_SETSIZE && fd_cnt < num_fd; cur++)
					{
					if ( FD_ISSET(cur,&selectSet) )
						{
						s[mask_off+offset] |= mask;
						fd_cnt++;
						}
					if ( ! (mask <<= 1) )
						{
						mask = 1;
						mask_off++;
						}
					}
				PUSHs(sv_2mortal(newSViv((IV)num_fd)));
				}
			else
				{
				PUSHs(sv_2mortal(newSViv((IV)0)));
				}
			}
		else
			{
			PUSHs(sv_2mortal(newSViv((IV)0)));
			}
		}
	else
		{
		PUSHs(sv_2mortal(newSViv((IV)0)));
		}
	}

int
type(name)
	char *	name