X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=recctrl%2Fperlread.c;h=7cdc5c01e1473253066548ba68e6a23cb732ff17;hb=75c42e4eb33630b36c990d47db7549c5bd5045aa;hp=40e2a61d291134c2f7f764b7aadb03ca03b90eda;hpb=5b0f4f6cb31f0678fcf7ba9abc58ed9392b34a04;p=idzebra-moved-to-github.git diff --git a/recctrl/perlread.c b/recctrl/perlread.c index 40e2a61..7cdc5c0 100644 --- a/recctrl/perlread.c +++ b/recctrl/perlread.c @@ -1,4 +1,4 @@ -/* $Id: perlread.c,v 1.5 2003-02-26 11:40:04 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 @@ -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)); } @@ -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,7 +321,10 @@ 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);