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