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