dd3e5dddda4f0caa6ef1fc8b15f7033af2612467
[imager.git] / 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