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 typedef int SysRet;
  14 typedef PerlIO * InputStream;
  15 typedef PerlIO * OutputStream;
  16
  17 static int
  18 not_here(s)
  19 char *s;
  20 {
  21     croak("%s not implemented on this architecture", s);
  22     return -1;
  23 }
  24
  25 static bool
  26 constant(name, pval)
  27 char *name;
  28 IV *pval;
  29 {
  30     switch (*name) {
  31     case '_':
  32         if (strEQ(name, "_IOFBF"))
  33 #ifdef _IOFBF
  34             { *pval = _IOFBF; return TRUE; }
  35 #else
  36             return FALSE;
  37 #endif
  38         if (strEQ(name, "_IOLBF"))
  39 #ifdef _IOLBF
  40             { *pval = _IOLBF; return TRUE; }
  41 #else
  42             return FALSE;
  43 #endif
  44         if (strEQ(name, "_IONBF"))
  45 #ifdef _IONBF
  46             { *pval = _IONBF; return TRUE; }
  47 #else
  48             return FALSE;
  49 #endif
  50         break;
  51     case 'S':
  52         if (strEQ(name, "SEEK_SET"))
  53 #ifdef SEEK_SET
  54             { *pval = SEEK_SET; return TRUE; }
  55 #else
  56             return FALSE;
  57 #endif
  58         if (strEQ(name, "SEEK_CUR"))
  59 #ifdef SEEK_CUR
  60             { *pval = SEEK_CUR; return TRUE; }
  61 #else
  62             return FALSE;
  63 #endif
  64         if (strEQ(name, "SEEK_END"))
  65 #ifdef SEEK_END
  66             { *pval = SEEK_END; return TRUE; }
  67 #else
  68             return FALSE;
  69 #endif
  70         break;
  71     }
  72
  73     return FALSE;
  74 }
  75
  76
  77 MODULE = IO     PACKAGE = IO::Seekable  PREFIX = f
  78
  79 SV *
  80 fgetpos(handle)
  81         InputStream     handle
  82     CODE:
  83         if (handle) {
  84             Fpos_t pos;
  85             PerlIO_getpos(handle, &pos);
  86             ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
  87         }
  88         else {
  89             ST(0) = &sv_undef;
  90             errno = EINVAL;
  91         }
  92
  93 SysRet
  94 fsetpos(handle, pos)
  95         InputStream     handle
  96         SV *            pos
  97     CODE:
  98         if (handle)
  99             RETVAL = PerlIO_setpos(handle, (Fpos_t*)SvPVX(pos));
 100         else {
 101             RETVAL = -1;
 102             errno = EINVAL;
 103         }
 104     OUTPUT:
 105         RETVAL
 106
 107 MODULE = IO     PACKAGE = IO::File      PREFIX = f
 108
 109 OutputStream
 110 new_tmpfile(packname = "IO::File")
 111     char *              packname
 112     CODE:
 113         RETVAL = PerlIO_tmpfile();
 114     OUTPUT:
 115         RETVAL
 116
 117 MODULE = IO     PACKAGE = IO::Handle    PREFIX = f
 118
 119 SV *
 120 constant(name)
 121         char *          name
 122     CODE:
 123         IV i;
 124         if (constant(name, &i))
 125             ST(0) = sv_2mortal(newSViv(i));
 126         else
 127             ST(0) = &sv_undef;
 128
 129 int
 130 ungetc(handle, c)
 131         InputStream     handle
 132         int             c
 133     CODE:
 134         if (handle)
 135             RETVAL = PerlIO_ungetc(handle, c);
 136         else {
 137             RETVAL = -1;
 138             errno = EINVAL;
 139         }
 140     OUTPUT:
 141         RETVAL
 142
 143 int
 144 ferror(handle)
 145         InputStream     handle
 146     CODE:
 147         if (handle)
 148             RETVAL = PerlIO_error(handle);
 149         else {
 150             RETVAL = -1;
 151             errno = EINVAL;
 152         }
 153     OUTPUT:
 154         RETVAL
 155
 156 SysRet
 157 fflush(handle)
 158         OutputStream    handle
 159     CODE:
 160         if (handle)
 161             RETVAL = PerlIO_flush(handle);
 162         else {
 163             RETVAL = -1;
 164             errno = EINVAL;
 165         }
 166     OUTPUT:
 167         RETVAL
 168
 169 void
 170 setbuf(handle, buf)
 171         OutputStream    handle
 172         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
 173     CODE:
 174         if (handle)
 175 #ifdef PERLIO_IS_STDIO
 176             setbuf(handle, buf);
 177 #else
 178             not_here("IO::Handle::setbuf");
 179 #endif
 180
 181 SysRet
 182 setvbuf(handle, buf, type, size)
 183         OutputStream    handle
 184         char *          buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
 185         int             type
 186         int             size
 187     CODE:
 188 #ifdef PERLIO_IS_STDIO
 189 #ifdef _IOFBF   /* Should be HAS_SETVBUF once Configure tests for that */
 190         if (handle)
 191             RETVAL = setvbuf(handle, buf, type, size);
 192         else {
 193             RETVAL = -1;
 194             errno = EINVAL;
 195         }
 196 #else
 197             RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
 198 #endif /* _IOFBF */
 199 #else
 200             not_here("IO::Handle::setvbuf");
 201 #endif
 202     OUTPUT:
 203         RETVAL
 204
 205