use PerlIO_* calls to read/write if supplied a fh
[imager.git] / perlio.c
CommitLineData
52d990d6
TC
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
11static ssize_t
12perlio_reader(void *handle, void *buf, size_t count);
13static ssize_t
14perlio_writer(void *handle, const void *buf, size_t count);
15static off_t
16perlio_seeker(void *handle, off_t offset, int whence);
17static int
18perlio_closer(void *handle);
19static void
20perlio_destroy(void *handle);
21static const char *my_strerror(int err);
22
23typedef 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
36Create a new perl I/O object that reads/writes/seeks on a PerlIO
37handle.
38
39The close() handle flushes output but does not close the handle.
40
41=cut
42*/
43
44i_io_glue_t *
45im_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
59static ssize_t
60perlio_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
74static ssize_t
75perlio_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
90static off_t
91perlio_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
106static int
107perlio_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
119static void
120perlio_destroy(void *ctx) {
121 myfree(ctx);
122}
123
124static
125const 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