Imager 1.000 release
[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);
84700c44
TC
21static const char *my_strerror(pTHX_ int err);
22
23#ifndef tTHX
24#define tTHX PerlInterpreter *
25#endif
52d990d6
TC
26
27typedef struct {
28 PerlIO *handle;
29 pIMCTX;
84700c44 30#ifdef MULTIPLICITY
52d990d6
TC
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
40Create a new perl I/O object that reads/writes/seeks on a PerlIO
41handle.
42
43The close() handle flushes output but does not close the handle.
44
45=cut
46*/
47
48i_io_glue_t *
49im_io_new_perlio(pTHX_ PerlIO *handle) {
50 im_perlio *state = mymalloc(sizeof(im_perlio));
51 dIMCTX;
52
53 state->handle = handle;
84700c44 54#ifdef MULTIPLICITY
52d990d6
TC
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
63static ssize_t
64perlio_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)) {
84700c44 71 im_push_errorf(aIMCTX, errno, "read() failure (%s)", my_strerror(aTHX_ errno));
52d990d6
TC
72 return -1;
73 }
74
75 return result;
76}
77
78static ssize_t
79perlio_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) {
84700c44 88 im_push_errorf(aIMCTX, errno, "write() failure (%s)", my_strerror(aTHX_ errno));
52d990d6
TC
89 }
90
91 return result;
92}
93
94static off_t
95perlio_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) {
84700c44 102 im_push_errorf(aIMCTX, errno, "seek() failure (%s)", my_strerror(aTHX_ errno));
52d990d6
TC
103 return -1;
104 }
105 }
106
107 return PerlIO_tell(state->handle);
108}
109
110static int
111perlio_closer(void *ctx) {
112 im_perlio *state = ctx;
113 dTHXa(state->my_perl);
114 dIMCTXperlio(state);
115
116 if (PerlIO_flush(state->handle) < 0) {
84700c44 117 im_push_errorf(aIMCTX, errno, "flush() failure (%s)", my_strerror(aTHX_ errno));
52d990d6
TC
118 return -1;
119 }
120 return 0;
121}
122
123static void
124perlio_destroy(void *ctx) {
125 myfree(ctx);
126}
127
128static
84700c44 129const char *my_strerror(pTHX_ int err) {
52d990d6
TC
130 const char *result = strerror(err);
131
132 if (!result)
133 result = "Unknown error";
134
135 return result;
136}
137