X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=recctrl%2Fperlread.c;h=ac09ed5bb228bd1d34544f3d9d5998252b2e49cf;hb=36403af0892015e79516d8cfc954d6f79f8ce1ca;hp=e1cdef366585f4fc1d4d2e335cf2408ffcc7491a;hpb=af03c4a4f5320b52c7cc5f47bab7c9ad4b3e384d;p=idzebra-moved-to-github.git diff --git a/recctrl/perlread.c b/recctrl/perlread.c index e1cdef3..ac09ed5 100644 --- a/recctrl/perlread.c +++ b/recctrl/perlread.c @@ -1,14 +1,32 @@ -/* $Id: perlread.c,v 1.1 2002-11-15 21:26:01 adam Exp $ */ +/* $Id: perlread.c,v 1.6 2003-02-27 23:21:40 pop Exp $ + Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002 + Index Data Aps + +This file is part of the Zebra server. + +Zebra is free software; you can redistribute it and/or modify it under +the terms of the GNU General Public License as published by the Free +Software Foundation; either version 2, or (at your option) any later +version. + +Zebra is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Zebra; see the file LICENSE.zebra. If not, write to the +Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA +02111-1307, USA. +*/ #if HAVE_PERL -#define PERL_IMPLICIT_CONTEXT #include "perlread.h" #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include -#include #include #include @@ -20,7 +38,7 @@ #define GRS_PERL_MODULE_NAME_MAXLEN 255 -// Context information for the filter +/* Context information for the filter */ struct perl_context { PerlInterpreter *perli; PerlInterpreter *origi; @@ -39,7 +57,7 @@ struct perl_context { data1_node *res; }; -// Constructor call for the filter object +/* Constructor call for the filter object */ void Filter_create (struct perl_context *context) { dSP; @@ -52,7 +70,7 @@ void Filter_create (struct perl_context *context) sv_setref_pv(msv, "_p_perl_context", (void*)context); XPUSHs(msv) ; PUTBACK ; - call_method("new", 0); + call_method("new", G_EVAL); SPAGAIN ; context->filterRef = POPs; @@ -74,6 +92,9 @@ int Filter_process (struct perl_context *context) dSP; + ENTER; + SAVETMPS; + PUSHMARK(SP) ; XPUSHs(context->filterRef); PUTBACK ; @@ -81,6 +102,9 @@ int Filter_process (struct perl_context *context) SPAGAIN ; res = POPi; PUTBACK ; + + FREETMPS; + LEAVE; return (res); } @@ -120,6 +144,10 @@ int Filter_process (struct perl_context *context) */ 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))); @@ -127,6 +155,9 @@ void Filter_store_buff (struct perl_context *context, char *buff, size_t len) { 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) { @@ -151,12 +182,12 @@ void grs_perl_endf(struct perl_context *context, off_t 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 */ @@ -170,8 +201,8 @@ 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. + /* 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(); @@ -191,8 +222,10 @@ void grs_destroy_perl(void *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); @@ -204,19 +237,19 @@ 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 + /* 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 + /* 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 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]; @@ -224,16 +257,20 @@ static data1_node *grs_read_perl (struct grs_read_info *p) 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 + /* parse, and run the init call */ if (context->origi == NULL) { logf (LOG_LOG, "Interpreting filter class:%s", filterClass); @@ -249,19 +286,23 @@ static data1_node *grs_read_perl (struct grs_read_info *p) strcpy(context->filterClass, filterClass); - // create the filter object as a filterClass blessed reference + /* 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... + /* Wow... if calling with individual update_record calls from perl, + the filter object reference may go out of scope... */ if (!SvOK(context->filterRef)) Filter_create(context); + if (!SvTRUE(context->filterRef)) { + logf (LOG_WARN,"Failed to initialize perl filter %s",context->filterClass); + return (0); + } - // call the process method + /* call the process method */ Filter_process(context); - // return the created data1 node + /* return the created data1 node */ return (context->res); }