From 150e8c2e5ddf9ff8b9991902236826d128bcfb94 Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Mon, 6 Sep 2004 09:31:34 +0000 Subject: [PATCH] Sync with 1_3_16_branch. Fix bug 128. --- recctrl/perlread.c | 434 +++++++++++++++++++++++++++------------------------- 1 file changed, 226 insertions(+), 208 deletions(-) diff --git a/recctrl/perlread.c b/recctrl/perlread.c index 7cdc5c0..bdfb35b 100644 --- a/recctrl/perlread.c +++ b/recctrl/perlread.c @@ -1,5 +1,5 @@ -/* $Id: perlread.c,v 1.8 2003-03-05 16:43:48 adam Exp $ - Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002 +/* $Id: perlread.c,v 1.9 2004-09-06 09:31:34 adam Exp $ + Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004 Index Data Aps This file is part of the Zebra server. @@ -40,41 +40,41 @@ Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA /* Context information for the filter */ struct perl_context { - PerlInterpreter *perli; - PerlInterpreter *origi; - int perli_ready; - char filterClass[GRS_PERL_MODULE_NAME_MAXLEN]; - SV *filterRef; - - int (*readf)(void *, char *, size_t); - off_t (*seekf)(void *, off_t); - off_t (*tellf)(void *); - void (*endf)(void *, off_t); - - void *fh; - data1_handle dh; - NMEM mem; - data1_node *res; + PerlInterpreter *perli; + PerlInterpreter *origi; + int perli_ready; + char filterClass[GRS_PERL_MODULE_NAME_MAXLEN]; + SV *filterRef; + + int (*readf)(void *, char *, size_t); + off_t (*seekf)(void *, off_t); + off_t (*tellf)(void *); + void (*endf)(void *, off_t); + + void *fh; + data1_handle dh; + NMEM mem; + data1_node *res; }; /* Constructor call for the filter object */ void Filter_create (struct perl_context *context) { - dSP; - SV *msv; - - PUSHMARK(SP) ; - XPUSHs(sv_2mortal(newSVpv(context->filterClass, + dSP; + SV *msv; + + PUSHMARK(SP) ; + XPUSHs(sv_2mortal(newSVpv(context->filterClass, strlen(context->filterClass)))) ; - msv = sv_newmortal(); - sv_setref_pv(msv, "_p_perl_context", (void*)context); - XPUSHs(msv) ; - PUTBACK ; - call_method("new", G_EVAL); - - SPAGAIN ; - context->filterRef = POPs; - PUTBACK ; + msv = sv_newmortal(); + sv_setref_pv(msv, "_p_perl_context", (void*)context); + XPUSHs(msv) ; + PUTBACK ; + call_method("new", G_EVAL); + + SPAGAIN ; + context->filterRef = POPs; + PUTBACK ; } /* @@ -87,26 +87,26 @@ void Filter_create (struct perl_context *context) int Filter_process (struct perl_context *context) { - - int res; - - dSP; - - ENTER; - SAVETMPS; - - PUSHMARK(SP) ; - XPUSHs(context->filterRef); - PUTBACK ; - call_method("_process", 0); - SPAGAIN ; - res = POPi; - PUTBACK ; - - FREETMPS; - LEAVE; - - return (res); + + int res; + + dSP; + + ENTER; + SAVETMPS; + + PUSHMARK(SP) ; + XPUSHs(context->filterRef); + PUTBACK ; + call_method("_process", 0); + SPAGAIN ; + res = POPi; + PUTBACK ; + + FREETMPS; + LEAVE; + + return (res); } /* @@ -143,199 +143,217 @@ int Filter_process (struct perl_context *context) can hide this whole compexity behind. */ -void Filter_store_buff (struct perl_context *context, char *buff, size_t len) { - dSP; - - ENTER; - SAVETMPS; - - PUSHMARK(SP) ; - XPUSHs(context->filterRef); - XPUSHs(sv_2mortal(newSVpv(buff, len))); - PUTBACK ; - call_method("_store_buff", 0); - SPAGAIN ; - PUTBACK ; - - FREETMPS; - LEAVE; +void Filter_store_buff (struct perl_context *context, char *buff, size_t len) +{ + dSP; + + ENTER; + SAVETMPS; + + PUSHMARK(SP) ; + XPUSHs(context->filterRef); + XPUSHs(sv_2mortal(newSVpv(buff, len))); + PUTBACK ; + call_method("_store_buff", 0); + SPAGAIN ; + PUTBACK ; + + FREETMPS; + LEAVE; } + /* The "file" manipulation function wrappers */ -int grs_perl_readf(struct perl_context *context, size_t len) { - int r; - char *buf = (char *) xmalloc (len+1); - r = (*context->readf)(context->fh, buf, len); - if (r > 0) Filter_store_buff (context, buf, r); - xfree (buf); - return (r); +int grs_perl_readf(struct perl_context *context, size_t len) +{ + int r; + char *buf = (char *) xmalloc (len+1); + r = (*context->readf)(context->fh, buf, len); + if (r > 0) Filter_store_buff (context, buf, r); + xfree (buf); + return (r); } -int grs_perl_readline(struct perl_context *context) { - int r; - char *buf = (char *) xmalloc (4096); - char *p = buf; - - while ((r = (*context->readf)(context->fh,p,1)) && (p-buf < 4095)) { - p++; - if (*(p-1) == 10) break; - } - - *p = 0; - - if (p != buf) Filter_store_buff (context, buf, p - buf); - xfree (buf); - return (p - buf); +int grs_perl_readline(struct perl_context *context) +{ + int r; + char *buf = (char *) xmalloc (4096); + char *p = buf; + + while ((r = (*context->readf)(context->fh,p,1)) && (p-buf < 4095)) { + p++; + if (*(p-1) == 10) break; + } + + *p = 0; + + if (p != buf) Filter_store_buff (context, buf, p - buf); + xfree (buf); + return (p - buf); } -char grs_perl_getc(struct perl_context *context) { - int r; - char *p; - if ((r = (*context->readf)(context->fh,p,1))) { - return (*p); - } else { - return (0); - } +char grs_perl_getc(struct perl_context *context) +{ + int r; + char *p; + if ((r = (*context->readf)(context->fh,p,1))) { + return (*p); + } else { + return (0); + } } -off_t grs_perl_seekf(struct perl_context *context, off_t offset) { - return ((*context->seekf)(context->fh, offset)); +off_t grs_perl_seekf(struct perl_context *context, off_t offset) +{ + return ((*context->seekf)(context->fh, offset)); } -off_t grs_perl_tellf(struct perl_context *context) { - return ((*context->tellf)(context->fh)); +off_t grs_perl_tellf(struct perl_context *context) +{ + return ((*context->tellf)(context->fh)); } -void grs_perl_endf(struct perl_context *context, off_t offset) { - (*context->endf)(context->fh, offset); +void grs_perl_endf(struct perl_context *context, off_t offset) +{ + (*context->endf)(context->fh, offset); } /* Get pointers from the context. Easyer to wrap this by SWIG */ -data1_handle *grs_perl_get_dh(struct perl_context *context) { - return(&context->dh); +data1_handle *grs_perl_get_dh(struct perl_context *context) +{ + return(&context->dh); } -NMEM *grs_perl_get_mem(struct perl_context *context) { - return(&context->mem); +NMEM *grs_perl_get_mem(struct perl_context *context) +{ + return(&context->mem); } /* Set the result in the context */ -void grs_perl_set_res(struct perl_context *context, data1_node *n) { - context->res = n; +void grs_perl_set_res(struct perl_context *context, data1_node *n) +{ + context->res = n; } /* The filter handlers (init, destroy, read) */ static void *grs_init_perl(void) { - struct perl_context *context = - (struct perl_context *) xmalloc (sizeof(*context)); - - /* If there is an interpreter (context) running, - we are calling - indexing and retrieval from the perl API - we don't create a new one. */ - context->origi = PERL_GET_CONTEXT; - if (context->origi == NULL) { - context->perli = perl_alloc(); - PERL_SET_CONTEXT(context->perli); - logf (LOG_LOG, "Initializing new perl interpreter context (%p)",context->perli); - } else { - logf (LOG_LOG, "Using existing perl interpreter context (%p)",context->origi); - } - context->perli_ready = 0; - strcpy(context->filterClass, ""); - return (context); + struct perl_context *context = + (struct perl_context *) xmalloc (sizeof(*context)); + + /* If there is an interpreter (context) running, - we are calling + indexing and retrieval from the perl API - we don't create a new one. */ + context->origi = PL_curinterp; + + if (!context->origi) { + context->perli = perl_alloc(); + PERL_SET_CONTEXT(context->perli); + logf (LOG_LOG, "Initializing new perl interpreter context (%p)",context->perli); + } else { + logf (LOG_LOG, "Using existing perl interpreter context (%p)",context->origi); + } + context->perli_ready = 0; + strcpy(context->filterClass, ""); + return (context); } void grs_destroy_perl(void *clientData) { - struct perl_context *context = (struct perl_context *) clientData; - - logf (LOG_LOG, "Destroying perl interpreter context"); - if (context->perli_ready) { - /* - FREETMPS; - LEAVE; - */ - if (context->origi == NULL) perl_destruct(context->perli); - } - if (context->origi == NULL) perl_free(context->perli); - xfree (context); + struct perl_context *context = (struct perl_context *) clientData; + + logf (LOG_LOG, "Destroying perl interpreter context"); + if (context->perli_ready) { + /* + FREETMPS; + LEAVE; + */ + if (context->origi == NULL) perl_destruct(context->perli); + } + if (context->origi == NULL) perl_free(context->perli); + xfree (context); } static data1_node *grs_read_perl (struct grs_read_info *p) { - struct perl_context *context = (struct perl_context *) p->clientData; - char *filterClass = p->type; - - /* The "file" manipulation function wrappers */ - context->readf = p->readf; - context->seekf = p->seekf; - context->tellf = p->tellf; - context->endf = p->endf; - - /* The "file", data1 and NMEM handles */ - context->fh = p->fh; - context->dh = p->dh; - context->mem = p->mem; - - /* If the class was not interpreted before... */ - /* This is not too efficient, when indexing with many different filters... */ - if (strcmp(context->filterClass,filterClass)) { - - char modarg[GRS_PERL_MODULE_NAME_MAXLEN + 2]; - char initarg[GRS_PERL_MODULE_NAME_MAXLEN + 2]; - char *arglist[6] = { "", "-I", "", "-M", "-e", "" }; + struct perl_context *context = (struct perl_context *) p->clientData; + char *filterClass = p->type; + + /* The "file" manipulation function wrappers */ + context->readf = p->readf; + context->seekf = p->seekf; + context->tellf = p->tellf; + context->endf = p->endf; + + /* The "file", data1 and NMEM handles */ + context->fh = p->fh; + context->dh = p->dh; + context->mem = p->mem; + + /* If the class was not interpreted before... */ + /* This is not too efficient, when indexing with many different filters... */ + if (strcmp(context->filterClass,filterClass)) { + + char modarg[GRS_PERL_MODULE_NAME_MAXLEN + 2]; + char initarg[GRS_PERL_MODULE_NAME_MAXLEN + 2]; + char *arglist[6] = { "", "-I", "", "-M", "-e", "" }; + + if (context->perli_ready) { + /* + FREETMPS; + LEAVE; + */ + if (context->origi == NULL) { + perl_destruct(context->perli); + } + } + if (context->origi == NULL) { + perl_construct(context->perli); + } + + + /* + ENTER; + SAVETMPS; + */ + context->perli_ready = 1; + + /* parse, and run the init call */ + if (context->origi == NULL) { + logf (LOG_LOG, "Interpreting filter class:%s", filterClass); + + arglist[2] = (char *) data1_get_tabpath(p->dh); + sprintf(modarg,"-M%s",filterClass); + arglist[3] = (char *) &modarg; + sprintf(initarg,"%s->init;",filterClass); + arglist[5] = (char *) &initarg; + + perl_parse(context->perli, PERL_XS_INIT, 6, arglist, NULL); + perl_run(context->perli); + } + + strcpy(context->filterClass, filterClass); + + /* create the filter object as a filterClass blessed reference */ + Filter_create(context); + } + + /* Wow... if calling with individual update_record calls from perl, + the filter object reference may go out of scope... */ + if (!sv_isa(context->filterRef, context->filterClass)) { + Filter_create(context); + logf (LOG_DEBUG,"Filter recreated"); + } - if (context->perli_ready) { - /* - FREETMPS; - LEAVE; - */ - if (context->origi == NULL) perl_destruct(context->perli); + if (!SvTRUE(context->filterRef)) + { + logf (LOG_WARN,"Failed to initialize perl filter %s",context->filterClass); + return (0); } - if (context->origi == NULL) perl_construct(context->perli); - /* - ENTER; - SAVETMPS; - */ - context->perli_ready = 1; - - /* parse, and run the init call */ - if (context->origi == NULL) { - logf (LOG_LOG, "Interpreting filter class:%s", filterClass); - - arglist[2] = (char *) data1_get_tabpath(p->dh); - sprintf(modarg,"-M%s",filterClass); - arglist[3] = (char *) &modarg; - sprintf(initarg,"%s->init;",filterClass); - arglist[5] = (char *) &initarg; - - perl_parse(context->perli, PERL_XS_INIT, 6, arglist, NULL); - perl_run(context->perli); - } - - strcpy(context->filterClass, filterClass); - - /* create the filter object as a filterClass blessed reference */ - Filter_create(context); - } - - /* Wow... if calling with individual update_record calls from perl, - the filter object reference may go out of scope... */ - if (!sv_isa(context->filterRef, context->filterClass)) { - Filter_create(context); - logf (LOG_DEBUG,"Filter recreated"); - } - - if (!SvTRUE(context->filterRef)) { - logf (LOG_WARN,"Failed to initialize perl filter %s",context->filterClass); - return (0); - } - - /* call the process method */ - Filter_process(context); - - /* return the created data1 node */ - return (context->res); + /* call the process method */ + Filter_process(context); + + /* return the created data1 node */ + return (context->res); } static struct recTypeGrs perl_type = { -- 1.7.10.4