pdl_magic *pdl_add_svmagic(pdl *it,SV *func)
{
AV *av;
pdl_magic_perlfunc *ptr = malloc(sizeof(pdl_magic_perlfunc));
ptr->what = PDL_MAGIC_MARKCHANGED | PDL_MAGIC_DELAYED;
ptr->vtable = &svmagic_vtable;
ptr->sv = newSVsv(func);
ptr->pdl = it;
ptr->next = NULL;
pdl__magic_add(it,(pdl_magic *)ptr);
if(it->state & PDL_ANYCHANGED)
pdl_add_delayed_magic((pdl_magic *)ptr);
/* In order to have our SV destroyed in time for the interpreter, */
/* XXX Work this out not to memleak */
av = perl_get_av("PDL::disposable_svmagics",TRUE);
av_push(av,ptr->sv);
return (pdl_magic *)ptr;
}
void
define_constants(const char *pkg, constval_t *cvp)
{
HV *stash;
char *name;
AV *constants;
/* Create the new perl @_Constants variable. */
stash = gv_stashpv(pkg, TRUE);
name = New(0, name, strlen(pkg) + sizeof (CONST_NAME), char);
PERL_ASSERT(name != NULL);
strcpy(name, pkg);
strcat(name, CONST_NAME);
constants = perl_get_av(name, TRUE);
Safefree(name);
/* Populate @_Constants from the contents of the generated array. */
for (; cvp->name != NULL; cvp++) {
newCONSTSUB(stash, (char *)cvp->name, newSVuv(cvp->value));
av_push(constants, newSVpvn((char *)cvp->name, cvp->len));
}
}
int matches(char *string, char *pattern, char **match_list[])
{
char *command;
SV *current_match;
AV *array;
I32 num_matches;
STRLEN length;
int i;
command = malloc(sizeof(char) * strlen(string) + strlen(pattern) + 38);
sprintf(command, "$string = '%s'; @array = ($string =~ %s)",
string, pattern);
perl_eval_pv(command, TRUE);
free(command);
array = perl_get_av("array", FALSE);
num_matches = av_len(array) + 1; /** assume $[ is 0 **/
*match_list = (char **) malloc(sizeof(char *) * num_matches);
for (i = 0; i <= num_matches; i++) {
current_match = av_shift(array);
(*match_list)[i] = SvPV(current_match, length);
}
return num_matches;
}