The following minimal example defines a wrapper around PerlIO_write
:
MODULE = My::FH PACKAGE = My::FH
INCLUDE: const-xs.inc
int
write_fh (SV* fh, SV* str)
CODE:
STRLEN len
char* buf = SvPV(str, len);
PerlIO* io = IoIFP(sv_2io(fh));
if (io) {
RETVAL = PerlIO_write(io, buf, len);
} else {
croak("cannot use fh as a PerlIO handle");
}
OUTPUT:
RETVAL
Using the write_fh
function on a filehandle that has been created using open $fh, '<', \\$buf
works as expected. However, a tied filehandle created using the following snippet is not turned into a PerlIO handle:
my $fh = Symbol::gensym;
tie *$fh, 'My::TIEFH', \$buf;
My::TIEFH
contains the required methods and writing to it via print $fh $str
works just as expected.
What do I need to do to write to the tied filehandle from XS land?
print
uses call_method
to call PRINT
when
io && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
is true. The blessed object to place on the stack is
SvTIED_obj(MUTABLE_SV(io), mg)
By the way, the XS compiler can place non-declaration code before the content of CODE
, so the content of CODE
cannot start with declarations.
CODE:
STRLEN len
char* buf = SvPV(str, len);
PerlIO* io = IoIFP(sv_2io(fh));
if (io) {
...
should be
CODE:
{
STRLEN len
char* buf = SvPV(str, len);
PerlIO* io = IoIFP(sv_2io(fh));
if (io) {
...
}
or
PREINIT:
STRLEN len
char* buf = SvPV(str, len);
PerlIO* io = IoIFP(sv_2io(fh));
CODE:
if (io) {
...
After trying to make sense of the definition of print
in pp_hot.c
and reading perlcall(3)
, I have come up with the following piece of code. Does that make sense?
MODULE = My::FH PACKAGE = My::FH
INCLUDE: const-xs.inc
int
write_fh (SV* fh, SV* str)
INIT:
STRLEN len;
char* buf = SvPV(str, len);
PerlIO* pio = IoIFP(sv_2io(fh));
CODE:
if (pio) {
RETVAL = PerlIO_write(pio, buf, len);
} else {
if (!SvROK(fh))
croak("fh is not a reference");
IO* io = GvIO(SvRV(fh));
if (io == NULL)
croak("fh is not a GLOB reference");
MAGIC* mg = SvTIED_mg((const SV*)io, PERL_MAGIC_tiedscalar);
if (mg == NULL)
croak("fh is not a tied filehandle");
SV* obj = SvTIED_obj(MUTABLE_SV(io), mg);
if (obj == NULL)
croak("???");
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(obj);
XPUSHs(str);
PUTBACK;
RETVAL = call_method("PRINT", G_SCALAR);
if (i != 1)
croak("wrong number of return values (%i)", RETVAL);
SPAGAIN;
RETVAL=POPi;
PUTBACK;
FREETEMPS;
LEAVE;
}
OUTPUT:
RETVAL
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.