perlio.c

   1 /* perlio.c - Imager's interface to PerlIO
   2
   3  */
   4 #define IMAGER_NO_CONTEXT
   5 #include "imager.h"
   6 #include "EXTERN.h"
   7 #include "perl.h"
   8 #include "imperlio.h"
   9
  10
  11 static ssize_t
  12 perlio_reader(void *handle, void *buf, size_t count);
  13 static ssize_t
  14 perlio_writer(void *handle, const void *buf, size_t count);
  15 static off_t
  16 perlio_seeker(void *handle, off_t offset, int whence);
  17 static int
  18 perlio_closer(void *handle);
  19 static void
  20 perlio_destroy(void *handle);
  21 static const char *my_strerror(int err);
  22
  23 typedef struct {
  24   PerlIO *handle;
  25   pIMCTX;
  26 #ifdef USE_PERLIO
  27   tTHX my_perl;
  28 #endif
  29 } im_perlio;
  30
  31 #define dIMCTXperlio(state) dIMCTXctx(state->aIMCTX)
  32
  33 /*
  34 =item im_io_new_perlio(PerlIO *)
  35
  36 Create a new perl I/O object that reads/writes/seeks on a PerlIO
  37 handle.
  38
  39 The close() handle flushes output but does not close the handle.
  40
  41 =cut
  42 */
  43
  44 i_io_glue_t *
  45 im_io_new_perlio(pTHX_ PerlIO *handle) {
  46   im_perlio *state = mymalloc(sizeof(im_perlio));
  47   dIMCTX;
  48
  49   state->handle = handle;
  50 #ifdef USE_PERLIO
  51   state->aTHX = aTHX;
  52 #endif
  53   state->aIMCTX = aIMCTX;
  54
  55   return io_new_cb(state, perlio_reader, perlio_writer,
  56                    perlio_seeker, perlio_closer, perlio_destroy);
  57 }
  58
  59 static ssize_t
  60 perlio_reader(void *ctx, void *buf, size_t count) {
  61   im_perlio *state = ctx;
  62   dTHXa(state->my_perl);
  63   dIMCTXperlio(state);
  64
  65   ssize_t result = PerlIO_read(state->handle, buf, count);
  66   if (result == 0 && PerlIO_error(state->handle)) {
  67     im_push_errorf(aIMCTX, errno, "read() failure (%s)", my_strerror(errno));
  68     return -1;
  69   }
  70
  71   return result;
  72 }
  73
  74 static ssize_t
  75 perlio_writer(void *ctx, const void *buf, size_t count) {
  76   im_perlio *state = ctx;
  77   dTHXa(state->my_perl);
  78   dIMCTXperlio(state);
  79   ssize_t result;
  80
  81   result = PerlIO_write(state->handle, buf, count);
  82
  83   if (result == 0) {
  84     im_push_errorf(aIMCTX, errno, "write() failure (%s)", my_strerror(errno));
  85   }
  86
  87   return result;
  88 }
  89
  90 static off_t
  91 perlio_seeker(void *ctx, off_t offset, int whence) {
  92   im_perlio *state = ctx;
  93   dTHXa(state->my_perl);
  94   dIMCTXperlio(state);
  95
  96   if (whence != SEEK_CUR || offset != 0) {
  97     if (PerlIO_seek(state->handle, offset, whence) < 0) {
  98       im_push_errorf(aIMCTX, errno, "seek() failure (%s)", my_strerror(errno));
  99       return -1;
 100     }
 101   }
 102
 103   return PerlIO_tell(state->handle);
 104 }
 105
 106 static int
 107 perlio_closer(void *ctx) {
 108   im_perlio *state = ctx;
 109   dTHXa(state->my_perl);
 110   dIMCTXperlio(state);
 111
 112   if (PerlIO_flush(state->handle) < 0) {
 113     im_push_errorf(aIMCTX, errno, "flush() failure (%s)", my_strerror(errno));
 114     return -1;
 115   }
 116   return 0;
 117 }
 118
 119 static void
 120 perlio_destroy(void *ctx) {
 121   myfree(ctx);
 122 }
 123
 124 static
 125 const char *my_strerror(int err) {
 126   const char *result = strerror(err);
 127
 128   if (!result)
 129     result = "Unknown error";
 130
 131   return result;
 132 }
 133