/* 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 IV
PerlIOFlock_pushed(pTHX_ PerlIO* fp, const char* mode, SV* arg,
PerlIO_funcs* tab){
int lock_mode;
int fd;
int ret;
PERL_UNUSED_ARG(mode);
PERL_UNUSED_ARG(tab);
if(!PerlIOValid(fp)){
SETERRNO(EBADF, SS_IVCHAN);
return -1;
}
lock_mode = IOLflag(fp, PERLIO_F_CANWRITE) ? LOCK_EX : LOCK_SH;
if(arg && SvOK(arg)){
const char* const blocking = SvPV_nolen_const(arg);
if(strEQ(blocking, "blocking")){
/* noop */
}
else if(strEQ(blocking, "non-blocking")
|| strEQ(blocking, "LOCK_NB")){
lock_mode |= LOCK_NB;
}
else{
Perl_croak(aTHX_ "Unrecognized :flock handler '%s' "
"(it must be 'blocking' or 'non-blocking')",
blocking);
}
}
fd = PerlIO_fileno(fp);
if(fd == -1){ /* :scalar, :dir, etc. */
return 0; /* success */
}
PerlIO_flush(fp);
ret = PerlLIO_flock(fd, lock_mode);
PerlIO_debug(STRINGIFY(FLOCK) "(%d, %s) -> %d\n", fd,
( lock_mode == (LOCK_SH) ? "LOCK_SH"
: lock_mode == (LOCK_SH|LOCK_NB) ? "LOCK_SH|LOCK_NB"
: lock_mode == (LOCK_EX) ? "LOCK_EX"
: lock_mode == (LOCK_EX|LOCK_NB) ? "LOCK_EX|LOCK_NB"
: "(UNKNOWN)" ),
ret);
return ret;
}
void sv2idcval(SV *sv, idc_value_t *val)
{
switch(val->vtype)
{
// note: idc_value_t calls qfree in it's destructor.
// problem: if ST is '$1' this somehow does not work.
case VT_STR: val->str= qstrdup(SvPV_nolen_const(sv)); break;
case VT_LONG: val->num= SvIV(sv); break;
case VT_FLOAT: double nv= SvNV(sv);
ph.realcvt(&nv, val->e, 3);
break;
}
}
static void
restore_sigmask(pTHX_ SV *save_sv)
{
const sigset_t * const ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
(void)sigprocmask(SIG_SETMASK, ossetp, NULL);
}