X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=recctrl%2Fperlread.c;h=7cdc5c01e1473253066548ba68e6a23cb732ff17;hb=0f32a55fdb9d34efa61f330a3354f74b763bfbf5;hp=3a088260cc4b03051bb2e4b5e7aeee73c4539dbe;hpb=8c7947050502fe0e1d15a65ee21247cac594d310;p=idzebra-moved-to-github.git

diff --git a/recctrl/perlread.c b/recctrl/perlread.c
index 3a08826..7cdc5c0 100644
--- a/recctrl/perlread.c
+++ b/recctrl/perlread.c
@@ -1,4 +1,4 @@
-/* $Id: perlread.c,v 1.3 2002-11-16 00:24:36 pop 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
 
@@ -70,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;
@@ -92,6 +92,9 @@ int Filter_process (struct perl_context *context)
 
   dSP;
 
+  ENTER;
+  SAVETMPS;
+
   PUSHMARK(SP) ;
   XPUSHs(context->filterRef);
   PUTBACK ;
@@ -99,6 +102,10 @@ int Filter_process (struct perl_context *context)
   SPAGAIN ;
   res = POPi;
   PUTBACK ;
+
+  FREETMPS;
+  LEAVE;
+
   return (res);
 }
 
@@ -138,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)));  
@@ -145,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) {
@@ -156,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));
 }
@@ -169,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 */
@@ -209,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);
@@ -242,13 +285,18 @@ 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 */
@@ -273,8 +321,15 @@ static data1_node *grs_read_perl (struct grs_read_info *p)
 
   /* 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 (!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);