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