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_noinc((SV*)gv));
 140             sv_bless(ST(0), gv_stashpv(packname, TRUE));
 141         }
 142         else {
 143             ST(0) = &sv_undef;
 144             SvREFCNT_dec(gv);
 145         }
 146
 147 MODULE = IO     PACKAGE = IO::Handle    PREFIX = f
 148
 149 SV *
 150 constant(name)
 151         char *          name
 152     CODE:
 153         IV i;
 154         if (constant(name, &i))
 155             ST(0) = sv_2mortal(newSViv(i));
 156         else
 157             ST(0) = &sv_undef;
 158
 159 int
 160 ungetc(handle, c)
 161         InputStream     handle
 162         int             c
 163     CODE:
 164         if (handle)
 165 #ifdef PerlIO
 166             RETVAL = PerlIO_ungetc(handle, c);
 167 #else
 168             RETVAL = ungetc(c, handle);
 169 #endif
 170         else {
 171             RETVAL = -1;
 172             errno = EINVAL;
 173         }
 174     OUTPUT:
 175         RETVAL
 176
 177 int
 178 ferror(handle)
 179         InputStream     handle
 180     CODE:
 181         if (handle)
 182 #ifdef PerlIO
 183             RETVAL = PerlIO_error(handle);
 184 #else
 185             RETVAL = ferror(handle);
 186 #endif
 187         else {
 188             RETVAL = -1;
 189             errno = EINVAL;
 190         }
 191     OUTPUT:
 192         RETVAL
 193
 194 int
 195 clearerr(handle)
 196         InputStream     handle
 197     CODE:
 198         if (handle) {
 199 #ifdef PerlIO
 200             PerlIO_clearerr(handle);
 201 #else
 202             clearerr(handle);
 203 #endif
 204             RETVAL = 0;
 205         }
 206         else {
 207             RETVAL = -1;
 208             errno = EINVAL;
 209         }
 210     OUTPUT:
 211         RETVAL
 212
 213 int
 214 untaint(handle)
 215        SV *     handle
 216     CODE:
 217 #ifdef IOf_UNTAINT
 218         IO * io;
 219         io = sv_2io(handle);
 220         if (io) {
 221             IoFLAGS(io) |= IOf_UNTAINT;
 222             RETVAL = 0;
 223         }
 224         else {
 225 #endif
 226             RETVAL = -1;
 227             errno = EINVAL;
 228 #ifdef IOf_UNTAINT
 229         }
 230 #endif
 231     OUTPUT:
 232         RETVAL
 233
 234 SysRet
 235 fflush(handle)
 236         OutputStream    handle
 237     CODE:
 238         if (handle)
 239 #ifdef PerlIO
 240             RETVAL = PerlIO_flush(handle);
 241 #else
 242             RETVAL = Fflush(handle);
 243 #endif
 244         else {
 245             RETVAL = -1;
 246             errno = EINVAL;
 247         }
 248     OUTPUT:
 249         RETVAL
 250
 251 void
 252 setbuf(handle, buf)
 253         OutputStream    handle
 254         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
 255     CODE:
 256         if (handle)
 257 #ifdef PERLIO_IS_STDIO
 258             setbuf(handle, buf);
 259 #else
 260             not_here("IO::Handle::setbuf");
 261 #endif
 262
 263 SysRet
 264 setvbuf(handle, buf, type, size)
 265         OutputStream    handle
 266         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
 267         int             type
 268         int             size
 269     CODE:
 270 #ifdef PERLIO_IS_STDIO
 271 #ifdef _IOFBF   /* Should be HAS_SETVBUF once Configure tests for that */
 272         if (handle)
 273             RETVAL = setvbuf(handle, buf, type, size);
 274         else {
 275             RETVAL = -1;
 276             errno = EINVAL;
 277         }
 278 #else
 279             RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
 280 #endif /* _IOFBF */
 281 #else
 282             not_here("IO::Handle::setvbuf");
 283 #endif
 284     OUTPUT:
 285         RETVAL
 286
 287