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;
}
SV *
PerlIOVia_method(pTHX_ PerlIO * f, char *method, CV ** save, int flags,
...)
{
PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
CV *cv =
(*save) ? *save : PerlIOVia_fetchmethod(aTHX_ s, method, save);
SV *result = Nullsv;
va_list ap;
va_start(ap, flags);
if (cv != (CV *) - 1) {
IV count;
dSP;
SV *arg;
PUSHSTACKi(PERLSI_MAGIC);
ENTER;
SPAGAIN;
PUSHMARK(sp);
XPUSHs(s->obj);
while ((arg = va_arg(ap, SV *))) {
XPUSHs(arg);
}
if (*PerlIONext(f)) {
if (!s->fh) {
GV *gv = newGVgen(HvNAME(s->stash));
GvIOp(gv) = newIO();
s->fh = newRV_noinc((SV *) gv);
s->io = GvIOp(gv);
}
IoIFP(s->io) = PerlIONext(f);
IoOFP(s->io) = PerlIONext(f);
XPUSHs(s->fh);
}
else {
PerlIO_debug("No next\n");
/* FIXME: How should this work for OPEN etc? */
}
PUTBACK;
count = call_sv((SV *) cv, flags);
if (count) {
SPAGAIN;
result = POPs;
PUTBACK;
}
else {
result = &PL_sv_undef;
}
LEAVE;
POPSTACK;
}
