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