#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#undef NO_PERLIO
#ifndef PerlIO
# define NO_PERLIO
# ifdef USE_SFIO
# define PerlIO Sfio_t
# define PerlIO_ungetc(f,c) sfungetc(f,c)
# else
# define PerlIO FILE
# define PerlIO_ungetc(f,c) ungetc(c,f)
# endif
#endif
MODULE = IO::Unread PACKAGE = IO::Unread
PROTOTYPES: ENABLE
BOOT:
#if PERLIO_LAYERS
newCONSTSUB(NULL, "IO::Unread::HAVE_PERLIO_LAYERS", &PL_sv_yes);
#else
newCONSTSUB(NULL, "IO::Unread::HAVE_PERLIO_LAYERS", &PL_sv_no);
#endif
SV *
_check_fh (SV *rv)
CODE:
{
GV *gv = (GV*)SvRV(rv);
IO *io = GvIO(gv);
if(!io)
RETVAL = &PL_sv_undef;
else if (IoTYPE(io) == IoTYPE_WRONLY) {
const char *const name =
gv && isGV_with_GP(gv) ? GvENAME(gv) : NULL;
Perl_warner(aTHX_ packWARN(WARN_IO),
"Filehandle %s opened only for output", name);
RETVAL = &PL_sv_no;
}
else
RETVAL = &PL_sv_yes;
}
OUTPUT:
RETVAL
IV
_PerlIO_unread (PerlIO *io, SV *str)
PROTOTYPE: *$
CODE:
#ifdef NO_PERLIO
PERL_UNUSED_VAR(str);
Perl_croak(aTHX_ "IO::Unread::_PerlIO_unread called in non-PerlIO perl");
#else
{
char *pv;
STRLEN len;
pv = SvPV(str, len);
RETVAL = PerlIO_unread(io, pv, len);
if (RETVAL == -1)
XSRETURN_UNDEF;
}
#endif
OUTPUT:
RETVAL
char
_PerlIO_ungetc (PerlIO *io, char chr)
PROTOTYPE: *$
CODE:
RETVAL = PerlIO_ungetc(io, chr);
if (RETVAL == -1)
XSRETURN_UNDEF;
OUTPUT:
RETVAL