view release on metacpan or  search on metacpan

lib/C/Blocks.xs  view on Meta::CPAN

	/* keep collecting if the current character looks like a valid
	 * identifier character */
	if (_is_id_cont(pstate->data->end[0])) return PR_NON_SIGIL;
	
	/* make sure we have the PerlAPI loaded */
	ensure_perlapi(aTHX_ pstate->data);
	
	/* We just identified the character that is one past the end of our
	 * Perl variable name. Identify the type and construct the mangled
	 * name for the C-side variable. */
	char backup = *pstate->data->end;
	*pstate->data->end = '\0';
	char * type;
	char * long_name;
	if (*pstate->sigil_start == '$') {
		type = "SV";
		long_name = savepv(form("_PERL_SCALAR_%s", 
			pstate->sigil_start + 1));
	}
	else if (*pstate->sigil_start == '@') {
		type = "AV";
		long_name = savepv(form("_PERL_ARRAY_%s", 
			pstate->sigil_start + 1));
	}
	else if (*pstate->sigil_start == '%') {
		type = "HV";
		long_name = savepv(form("_PERL_HASH_%s", 
			pstate->sigil_start + 1));
	}
	else {
		/* should never happen */
		*pstate->data->end = backup;
		croak("C::Blocks internal error: unknown sigil %c\n",
			*pstate->sigil_start);
	}
	
	/* replace any double-colons */
	int is_package_global = direct_replace_double_colons(long_name);
	
	/* Check if we need to add a declaration for the C-side variable */
	if (strstr(SvPVbyte_nolen(pstate->data->code_top), long_name) == NULL) {
		/* Add a new declaration for it */

lib/C/Blocks.xs  view on Meta::CPAN

				  *pstate->sigil_start == '$' ? "get_sv"
				: *pstate->sigil_start == '@' ? "get_av"
				:                               "get_hv",
				pstate->sigil_start + 1);
		}
		else {
			int var_offset = (int)pad_findmy_pv(pstate->sigil_start, 0);
			/* Ensure that the variable exists in the pad */
			if (var_offset == NOT_IN_PAD) {
				CopLINE(PL_curcop) += pstate->data->N_newlines;
				*pstate->data->end = backup;
				croak("Could not find lexically scoped \"%s\"",
					pstate->sigil_start);
			}
			
			/* If the variable has an annotated type, use the type's
			 * code builder. Otherwise, declare the basic type. */
			if (!call_init_cleanup_builder_method(aTHX_ pstate, type,
					long_name, var_offset))
			{
				sv_catpvf(pstate->data->code_top, "%s * %s = (%s*)PAD_SV(%d); ",
					type, long_name, type, var_offset);
			}
		}
	}
	
	/* Reset the character just following the var name */
	*pstate->data->end = backup;
	
	/* Add the long name to the main code block in place of the sigiled
	 * expression, and remove the sigiled varname from the buffer. */
	sv_catpv_nomg(pstate->data->code_main, long_name);
	lex_unstuff(pstate->data->end);
	pstate->data->end = PL_bufptr;
	
	/* Cleanup memory */
	Safefree(long_name);
	

lib/C/Blocks.xs  view on Meta::CPAN

	 * don't copy (or unstuff) that. */
	lex_unstuff(data->end);
	data->end = PL_bufptr;
	/* Add the closing bracket to the end, if appropriate */
	if (data->keep_curly_brackets) sv_catpvn(data->code_bottom, "}", 1);
}

void run_filters (pTHX_ c_blocks_data * data, int keyword_type) {
	/* Get $_ and place the code in it */
	SV * underbar = find_rundefsv();
	SV * under_backup = newSVsv(underbar);
	sv_setpvf(underbar, "%s%s%s", SvPVbyte_nolen(data->code_top),
		SvPVbyte_nolen(data->code_main), SvPVbyte_nolen(data->code_bottom));
	
	/* Apply the different filters */
	SV * filters_SV = cophh_fetch_pvs(data->hints_hash, "C::Blocks/filters", 0);
	if (filters_SV != &PL_sv_placeholder) {
		dSP;
		char * filters = SvPVbyte_nolen(filters_SV);
		char * start = filters;
		char backup;
		while(1) {
			if (*filters == '\0' && start == filters) break;
			if (*filters == '|') {
				backup = *filters;
				*filters = '\0';
				/* construct the function name to call */
				char * full_method;
				/* if it starts with an ampersand, it's a function name */
				if (*start == '&') {
					full_method = start + 1;
				}
				else {
					/* we have the package name; append the normal method */
					full_method = form("%s::c_blocks_filter", start);
				}
				PUSHMARK(SP);
				call_pv(full_method, G_DISCARD|G_NOARGS);
				start = filters + 1;
				*filters = backup;
			}
			filters++;
		}
	}
	
	/* copy contents of underbar into main */
	sv_setsv(data->code_main, underbar);
	
	/* restore underbar when done */
	sv_setsv(underbar, under_backup);
}

/*************************/
/**** Keyword plugin ****/
/************************/

void initialize_c_blocks_data(pTHX_ c_blocks_data* data) {
	data->N_newlines = 0;
	data->xs_c_name = 0;
	data->xs_perl_name = 0;