X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=recctrl%2Fperlread.c;h=7cdc5c01e1473253066548ba68e6a23cb732ff17;hb=5f196d5c2d38a50f3b986438fad5aa3c3a3f04c6;hp=e1cdef366585f4fc1d4d2e335cf2408ffcc7491a;hpb=af03c4a4f5320b52c7cc5f47bab7c9ad4b3e384d;p=idzebra-moved-to-github.git

diff --git a/recctrl/perlread.c b/recctrl/perlread.c
index e1cdef3..7cdc5c0 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.8 2003-03-05 16:43:48 adam 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 <stdio.h>
-#include <assert.h>
 #include <string.h>
 #include <ctype.h>
 
@@ -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,10 @@ int Filter_process (struct perl_context *context)
   SPAGAIN ;
   res = POPi;
   PUTBACK ;
+
+  FREETMPS;
+  LEAVE;
+
   return (res);
 }
 
@@ -120,6 +145,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 +156,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) {
@@ -138,6 +170,33 @@ int grs_perl_readf(struct perl_context *context, size_t len) {
   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);
+}
+
+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));
 }
@@ -151,12 +210,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 +229,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 +250,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 +265,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 +285,21 @@ 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 +315,26 @@ 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...
-  if (!SvOK(context->filterRef)) 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 
+  /* call the process method */
   Filter_process(context);
 
-  // return the created data1 node
+  /* return the created data1 node */
   return (context->res);
 }