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