ext/IO/IO.xs

   1 #include "EXTERN.h"
   2 #define PERLIO_NOT_STDIO 1
   3 #include "perl.h"
   4 #include "XSUB.h"
   5
   6 #ifdef I_UNISTD
   7 #  include <unistd.h>
   8 #endif
   9 #ifdef I_FCNTL
  10 #  include <fcntl.h>
  11 #endif
  12
  13 #ifdef PerlIO
  14 typedef int SysRet;
  15 typedef PerlIO * InputStream;
  16 typedef PerlIO * OutputStream;
  17 #else
  18 #define PERLIO_IS_STDIO 1
  19 typedef int SysRet;
  20 typedef FILE * InputStream;
  21 typedef FILE * OutputStream;
  22 #endif
  23
  24 static int
  25 not_here(char *s)
  26 {
  27     croak("%s not implemented on this architecture", s);
  28     return -1;
  29 }
  30
  31 static bool
  32 constant(char *name, IV *pval)
  33 {
  34     switch (*name) {
  35     case '_':
  36         if (strEQ(name, "_IOFBF"))
  37 #ifdef _IOFBF
  38             { *pval = _IOFBF; return TRUE; }
  39 #else
  40             return FALSE;
  41 #endif
  42         if (strEQ(name, "_IOLBF"))
  43 #ifdef _IOLBF
  44             { *pval = _IOLBF; return TRUE; }
  45 #else
  46             return FALSE;
  47 #endif
  48         if (strEQ(name, "_IONBF"))
  49 #ifdef _IONBF
  50             { *pval = _IONBF; return TRUE; }
  51 #else
  52             return FALSE;
  53 #endif
  54         break;
  55     case 'S':
  56         if (strEQ(name, "SEEK_SET"))
  57 #ifdef SEEK_SET
  58             { *pval = SEEK_SET; return TRUE; }
  59 #else
  60             return FALSE;
  61 #endif
  62         if (strEQ(name, "SEEK_CUR"))
  63 #ifdef SEEK_CUR
  64             { *pval = SEEK_CUR; return TRUE; }
  65 #else
  66             return FALSE;
  67 #endif
  68         if (strEQ(name, "SEEK_END"))
  69 #ifdef SEEK_END
  70             { *pval = SEEK_END; return TRUE; }
  71 #else
  72             return FALSE;
  73 #endif
  74         break;
  75     }
  76
  77     return FALSE;
  78 }
  79
  80
  81 MODULE = IO     PACKAGE = IO::Seekable  PREFIX = f
  82
  83 SV *
  84 fgetpos(handle)
  85         InputStream     handle
  86     CODE:
  87         if (handle) {
  88             Fpos_t pos;
  89 #ifdef PerlIO
  90             PerlIO_getpos(handle, &pos);
  91 #else
  92             fgetpos(handle, &pos);
  93 #endif
  94             ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
  95         }
  96         else {
  97             ST(0) = &sv_undef;
  98             errno = EINVAL;
  99         }
 100
 101 SysRet
 102 fsetpos(handle, pos)
 103         InputStream     handle
 104         SV *            pos
 105     CODE:
 106         char *p;
 107         if (handle && (p = SvPVx(pos, na)) && na == sizeof(Fpos_t))
 108 #ifdef PerlIO
 109             RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
 110 #else
 111             RETVAL = fsetpos(handle, (Fpos_t*)p);
 112 #endif
 113         else {
 114             RETVAL = -1;
 115             errno = EINVAL;
 116         }
 117     OUTPUT:
 118         RETVAL
 119
 120 MODULE = IO     PACKAGE = IO::File      PREFIX = f
 121
 122 SV *
 123 new_tmpfile(packname = "IO::File")
 124     char *              packname
 125     PREINIT:
 126         OutputStream fp;
 127         GV *gv;
 128     CODE:
 129 #ifdef PerlIO
 130         fp = PerlIO_tmpfile();
 131 #else
 132         fp = tmpfile();
 133 #endif
 134         gv = (GV*)SvREFCNT_inc(newGVgen(packname));
 135         hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
 136         if (do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) {
 137             ST(0) = sv_2mortal(newRV((SV*)gv));
 138             sv_bless(ST(0), gv_stashpv(packname, TRUE));
 139             SvREFCNT_dec(gv);   /* undo increment in newRV() */
 140         }
 141         else {
 142             ST(0) = &sv_undef;
 143             SvREFCNT_dec(gv);
 144         }
 145
 146 MODULE = IO     PACKAGE = IO::Handle    PREFIX = f
 147
 148 SV *
 149 constant(name)
 150         char *          name
 151     CODE:
 152         IV i;
 153         if (constant(name, &i))
 154             ST(0) = sv_2mortal(newSViv(i));
 155         else
 156             ST(0) = &sv_undef;
 157
 158 int
 159 ungetc(handle, c)
 160         InputStream     handle
 161         int             c
 162     CODE:
 163         if (handle)
 164 #ifdef PerlIO
 165             RETVAL = PerlIO_ungetc(handle, c);
 166 #else
 167             RETVAL = ungetc(c, handle);
 168 #endif
 169         else {
 170             RETVAL = -1;
 171             errno = EINVAL;
 172         }
 173     OUTPUT:
 174         RETVAL
 175
 176 int
 177 ferror(handle)
 178         InputStream     handle
 179     CODE:
 180         if (handle)
 181 #ifdef PerlIO
 182             RETVAL = PerlIO_error(handle);
 183 #else
 184             RETVAL = ferror(handle);
 185 #endif
 186         else {
 187             RETVAL = -1;
 188             errno = EINVAL;
 189         }
 190     OUTPUT:
 191         RETVAL
 192
 193 int
 194 clearerr(handle)
 195         InputStream     handle
 196     CODE:
 197         if (handle) {
 198 #ifdef PerlIO
 199             PerlIO_clearerr(handle);
 200 #else
 201             clearerr(handle);
 202 #endif
 203             RETVAL = 0;
 204         }
 205         else {
 206             RETVAL = -1;
 207             errno = EINVAL;
 208         }
 209     OUTPUT:
 210         RETVAL
 211
 212 int
 213 untaint(handle)
 214        SV *     handle
 215     CODE:
 216 #ifdef IOf_UNTAINT
 217         IO * io;
 218         io = sv_2io(handle);
 219         if (io) {
 220             IoFLAGS(io) |= IOf_UNTAINT;
 221             RETVAL = 0;
 222         }
 223         else {
 224 #endif
 225             RETVAL = -1;
 226             errno = EINVAL;
 227 #ifdef IOf_UNTAINT
 228         }
 229 #endif
 230     OUTPUT:
 231         RETVAL
 232
 233 SysRet
 234 fflush(handle)
 235         OutputStream    handle
 236     CODE:
 237         if (handle)
 238 #ifdef PerlIO
 239             RETVAL = PerlIO_flush(handle);
 240 #else
 241             RETVAL = Fflush(handle);
 242 #endif
 243         else {
 244             RETVAL = -1;
 245             errno = EINVAL;
 246         }
 247     OUTPUT:
 248         RETVAL
 249
 250 void
 251 setbuf(handle, buf)
 252         OutputStream    handle
 253         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
 254     CODE:
 255         if (handle)
 256 #ifdef PERLIO_IS_STDIO
 257             setbuf(handle, buf);
 258 #else
 259             not_here("IO::Handle::setbuf");
 260 #endif
 261
 262 SysRet
 263 setvbuf(handle, buf, type, size)
 264         OutputStream    handle
 265         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
 266         int             type
 267         int             size
 268     CODE:
 269 /* Should check HAS_SETVBUF once Configure tests for that */
 270 #if defined(PERLIO_IS_STDIO) && defined(_IOFBF)
 271         if (!handle)                    /* Try input stream. */
 272             handle = IoIFP(sv_2io(ST(0)));
 273         if (handle)
 274             RETVAL = setvbuf(handle, buf, type, size);
 275         else {
 276             RETVAL = -1;
 277             errno = EINVAL;
 278         }
 279 #else
 280         RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
 281 #endif
 282     OUTPUT:
 283         RETVAL
 284
 285