From: Adam Dickmeiss <adam@indexdata.dk>
Date: Mon, 6 Sep 2004 09:31:34 +0000 (+0000)
Subject: Sync with 1_3_16_branch. Fix bug 128.
X-Git-Tag: snippet.version.1~369
X-Git-Url: http://lists.indexdata.com/cgi-bin?a=commitdiff_plain;h=150e8c2e5ddf9ff8b9991902236826d128bcfb94;p=idzebra-moved-to-github.git

Sync with 1_3_16_branch. Fix bug 128.
---

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 = {