/* maxlen 0 = read one text line */ I32 Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) { filter_t funcp; SV *datasv = NULL; if (!PL_rsfp_filters) return -1; if (idx > AvFILLp(PL_rsfp_filters)) { /* Any more filters? */ /* Provide a default input filter to make life easy. */ /* Note that we append to the line. This is handy. */ DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_read %d: from rsfp\n", idx)); if (maxlen) { /* Want a block */ int len ; const int old_len = SvCUR(buf_sv); /* ensure buf_sv is large enough */ SvGROW(buf_sv, (STRLEN)(old_len + maxlen)) ; if ((len = PerlIO_read(PL_rsfp, SvPVX(buf_sv) + old_len, maxlen)) <= 0){ if (PerlIO_error(PL_rsfp)) return -1; /* error */ else return 0 ; /* end of file */ } SvCUR_set(buf_sv, old_len + len) ; } else { /* Want a line */ if (sv_gets(buf_sv, PL_rsfp, SvCUR(buf_sv)) == NULL) { if (PerlIO_error(PL_rsfp)) return -1; /* error */ else return 0 ; /* end of file */ } } return SvCUR(buf_sv); } /* Skip this filter slot if filter has been deleted */ if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef) { DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_read %d: skipped (filter deleted)\n", idx)); return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */ } /* Get function pointer hidden within datasv */ funcp = DPTR2FPTR(filter_t, IoANY(datasv)); DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_read %d: via function %p (%s)\n", idx, datasv, SvPV_nolen_const(datasv))); /* Call function. The function is expected to */ /* call "FILTER_READ(idx+1, buf_sv)" first. */ /* Return: <0:error, =0:eof, >0:not eof */ return (*funcp)(aTHX_ idx, buf_sv, maxlen); }
STATIC char * S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) { #ifdef PERL_CR_FILTER if (!PL_rsfp_filters) { filter_add(S_cr_textfilter,NULL); } #endif if (PL_rsfp_filters) { if (!append) SvCUR_set(sv, 0); /* start with empty line */ if (FILTER_READ(0, sv, 0) > 0) return ( SvPVX(sv) ) ; else return Nullch ; } else return (sv_gets(sv, fp, append)); }
START_MY_CXT #define fdebug (MY_CXT.x_fdebug) #define current_idx (MY_CXT.x_current_idx) static I32 filter_call(pTHX_ int idx, SV *buf_sv, int maxlen) { dMY_CXT; SV *my_sv = FILTER_DATA(idx); char *nl = "\n"; char *p; char *out_ptr; int n; if (fdebug) warn("**** In filter_call - maxlen = %d, out len buf = %d idx = %d my_sv = %d [%s]\n", maxlen, SvCUR(buf_sv), idx, SvCUR(my_sv), SvPVX(my_sv) ) ; while (1) { /* anything left from last time */ if ((n = SvCUR(my_sv))) { out_ptr = SvPVX(my_sv) + BUF_OFFSET(my_sv) ; if (maxlen) { /* want a block */ if (fdebug) warn("BLOCK(%d): size = %d, maxlen = %d\n", idx, n, maxlen) ; sv_catpvn(buf_sv, out_ptr, maxlen > n ? n : maxlen ); if(n <= maxlen) { BUF_OFFSET(my_sv) = 0 ; SET_LEN(my_sv, 0) ; } else { BUF_OFFSET(my_sv) += maxlen ; SvCUR_set(my_sv, n - maxlen) ; } return SvCUR(buf_sv); } else { /* want lines */ if ((p = ninstr(out_ptr, out_ptr + n, nl, nl + 1))) { sv_catpvn(buf_sv, out_ptr, p - out_ptr + 1); n = n - (p - out_ptr + 1); BUF_OFFSET(my_sv) += (p - out_ptr + 1); SvCUR_set(my_sv, n) ; if (fdebug) warn("recycle %d - leaving %d, returning %d [%s]", idx, n, SvCUR(buf_sv), SvPVX(buf_sv)) ; return SvCUR(buf_sv); } else /* no EOL, so append the complete buffer */ sv_catpvn(buf_sv, out_ptr, n) ; } } SET_LEN(my_sv, 0) ; BUF_OFFSET(my_sv) = 0 ; if (FILTER_ACTIVE(my_sv)) { dSP ; int count ; if (fdebug) warn("gonna call %s::filter\n", PERL_MODULE(my_sv)) ; ENTER ; SAVETMPS; SAVEINT(current_idx) ; /* save current idx */ current_idx = idx ; SAVESPTR(DEFSV) ; /* save $_ */ /* make $_ use our buffer */ DEFSV = sv_2mortal(newSVpv("", 0)) ; PUSHMARK(sp) ; if (CODE_REF(my_sv)) { /* if (SvROK(PERL_OBJECT(my_sv)) && SvTYPE(SvRV(PERL_OBJECT(my_sv))) == SVt_PVCV) { */ count = perl_call_sv((SV*)PERL_OBJECT(my_sv), G_SCALAR); } else { XPUSHs((SV*)PERL_OBJECT(my_sv)) ; PUTBACK ; count = perl_call_method("filter", G_SCALAR); } SPAGAIN ; if (count != 1) croak("Filter::Util::Call - %s::filter returned %d values, 1 was expected \n", PERL_MODULE(my_sv), count ) ; n = POPi ; if (fdebug) warn("status = %d, length op buf = %d [%s]\n", n, SvCUR(DEFSV), SvPVX(DEFSV) ) ; if (SvCUR(DEFSV)) sv_setpvn(my_sv, SvPVX(DEFSV), SvCUR(DEFSV)) ; PUTBACK ; FREETMPS ; LEAVE ; } else n = FILTER_READ(idx + 1, my_sv, maxlen) ; if (n <= 0) { /* Either EOF or an error */ if (fdebug) warn ("filter_read %d returned %d , returning %d\n", idx, n, (SvCUR(buf_sv)>0) ? SvCUR(buf_sv) : n); /* PERL_MODULE(my_sv) ; */ /* PERL_OBJECT(my_sv) ; */ filter_del(filter_call); /* If error, return the code */ if (n < 0) return n ; /* return what we have so far else signal eof */ return (SvCUR(buf_sv)>0) ? SvCUR(buf_sv) : n; } } }