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         char *p;
 110         if (handle && (p = SvPVx(pos, na)) && na == sizeof(Fpos_t))
 111 #ifdef PerlIO
 112             RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
 113 #else
 114             RETVAL = fsetpos(handle, (Fpos_t*)p);
 115 #endif
 116         else {
 117             RETVAL = -1;
 118             errno = EINVAL;
 119         }
 120     OUTPUT:
 121         RETVAL
 122
 123 MODULE = IO     PACKAGE = IO::File      PREFIX = f
 124
 125 SV *
 126 new_tmpfile(packname = "IO::File")
 127     char *              packname
 128     PREINIT:
 129         OutputStream fp;
 130         GV *gv;
 131     CODE:
 132 #ifdef PerlIO
 133         fp = PerlIO_tmpfile();
 134 #else
 135         fp = tmpfile();
 136 #endif
 137         gv = (GV*)SvREFCNT_inc(newGVgen(packname));
 138         hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
 139         if (do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) {
 140             ST(0) = sv_2mortal(newRV((SV*)gv));
 141             sv_bless(ST(0), gv_stashpv(packname, TRUE));
 142             SvREFCNT_dec(gv);   /* undo increment in newRV() */
 143         }
 144         else {
 145             ST(0) = &sv_undef;
 146             SvREFCNT_dec(gv);
 147         }
 148
 149 MODULE = IO     PACKAGE = IO::Handle    PREFIX = f
 150
 151 SV *
 152 constant(name)
 153         char *          name
 154     CODE:
 155         IV i;
 156         if (constant(name, &i))
 157             ST(0) = sv_2mortal(newSViv(i));
 158         else
 159             ST(0) = &sv_undef;
 160
 161 int
 162 ungetc(handle, c)
 163         InputStream     handle
 164         int             c
 165     CODE:
 166         if (handle)
 167 #ifdef PerlIO
 168             RETVAL = PerlIO_ungetc(handle, c);
 169 #else
 170             RETVAL = ungetc(c, handle);
 171 #endif
 172         else {
 173             RETVAL = -1;
 174             errno = EINVAL;
 175         }
 176     OUTPUT:
 177         RETVAL
 178
 179 int
 180 ferror(handle)
 181         InputStream     handle
 182     CODE:
 183         if (handle)
 184 #ifdef PerlIO
 185             RETVAL = PerlIO_error(handle);
 186 #else
 187             RETVAL = ferror(handle);
 188 #endif
 189         else {
 190             RETVAL = -1;
 191             errno = EINVAL;
 192         }
 193     OUTPUT:
 194         RETVAL
 195
 196 int
 197 clearerr(handle)
 198         InputStream     handle
 199     CODE:
 200         if (handle) {
 201 #ifdef PerlIO
 202             PerlIO_clearerr(handle);
 203 #else
 204             clearerr(handle);
 205 #endif
 206             RETVAL = 0;
 207         }
 208         else {
 209             RETVAL = -1;
 210             errno = EINVAL;
 211         }
 212     OUTPUT:
 213         RETVAL
 214
 215 int
 216 untaint(handle)
 217        SV *     handle
 218     CODE:
 219 #ifdef IOf_UNTAINT
 220         IO * io;
 221         io = sv_2io(handle);
 222         if (io) {
 223             IoFLAGS(io) |= IOf_UNTAINT;
 224             RETVAL = 0;
 225         }
 226         else {
 227 #endif
 228             RETVAL = -1;
 229             errno = EINVAL;
 230 #ifdef IOf_UNTAINT
 231         }
 232 #endif
 233     OUTPUT:
 234         RETVAL
 235
 236 SysRet
 237 fflush(handle)
 238         OutputStream    handle
 239     CODE:
 240         if (handle)
 241 #ifdef PerlIO
 242             RETVAL = PerlIO_flush(handle);
 243 #else
 244             RETVAL = Fflush(handle);
 245 #endif
 246         else {
 247             RETVAL = -1;
 248             errno = EINVAL;
 249         }
 250     OUTPUT:
 251         RETVAL
 252
 253 void
 254 setbuf(handle, buf)
 255         OutputStream    handle
 256         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
 257     CODE:
 258         if (handle)
 259 #ifdef PERLIO_IS_STDIO
 260             setbuf(handle, buf);
 261 #else
 262             not_here("IO::Handle::setbuf");
 263 #endif
 264
 265 SysRet
 266 setvbuf(handle, buf, type, size)
 267         OutputStream    handle
 268         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
 269         int             type
 270         int             size
 271     CODE:
 272 /* Should check HAS_SETVBUF once Configure tests for that */
 273 #if defined(PERLIO_IS_STDIO) && defined(_IOFBF)
 274         if (handle)
 275             RETVAL = setvbuf(handle, buf, type, size);
 276         else {
 277             RETVAL = -1;
 278             errno = EINVAL;
 279         }
 280 #else
 281         RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
 282 #endif
 283     OUTPUT:
 284         RETVAL
 285
 286