1 /* -*- Mode: C; tab-width: 8; indent-tabs-mode: t; c-basic-offset: 8 -*- */
2 /*
3 * Authors: Piotr Klaban <makler@man.torun.pl>
4 *
5 * Copyright 2003,2004 Piotr Klaban
6 *
7 * This program is free software; you can redistribute it and/or modify
8 * it under the terms of the GNU General Public License as published by
9 * the Free Software Foundation; either version 2 of the License, or
10 * (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Street #330, Boston, MA 02111-1307, USA.
20 *
21 */
22
23 #define PERL_NO_GET_CONTEXT /* we want efficiency */
24
25 #include "gmime-stream-perlio.h"
26
27 // static PerlInterpreter *my_perl;
28
29 static void g_mime_stream_perlio_class_init (GMimeStreamPerlIOClass *klass);
30 static void g_mime_stream_perlio_init (GMimeStreamPerlIO *stream, GMimeStreamPerlIOClass *klass);
31 static void g_mime_stream_perlio_finalize (GObject *object);
32
33 static ssize_t stream_read (GMimeStream *stream, char *buf, size_t len);
34 static ssize_t stream_write (GMimeStream *stream, char *buf, size_t len);
35 static int stream_flush (GMimeStream *stream);
36 static int stream_close (GMimeStream *stream);
37 static gboolean stream_eos (GMimeStream *stream);
38 static int stream_reset (GMimeStream *stream);
39 static off_t stream_seek (GMimeStream *stream, off_t offset, GMimeSeekWhence whence);
40 static off_t stream_tell (GMimeStream *stream);
41 static ssize_t stream_length (GMimeStream *stream);
42 static GMimeStream *stream_substream (GMimeStream *stream, off_t start, off_t end);
43
44
45 static GMimeStreamClass *parent_class = NULL;
46
47
48 GType
g_mime_stream_perlio_get_type(void)49 g_mime_stream_perlio_get_type (void)
50 {
51 static GType type = 0;
52
53 if (!type) {
54 static const GTypeInfo info = {
55 sizeof (GMimeStreamPerlIOClass),
56 NULL, /* base_class_init */
57 NULL, /* base_class_finalize */
58 (GClassInitFunc) g_mime_stream_perlio_class_init,
59 NULL, /* class_finalize */
60 NULL, /* class_data */
61 sizeof (GMimeStreamPerlIO),
62 16, /* n_preallocs */
63 (GInstanceInitFunc) g_mime_stream_perlio_init,
64 };
65
66 type = g_type_register_static (GMIME_TYPE_STREAM, "GMimeStreamPerlIO", &info, 0);
67 }
68
69 return type;
70 }
71
72
73 static void
g_mime_stream_perlio_class_init(GMimeStreamPerlIOClass * klass)74 g_mime_stream_perlio_class_init (GMimeStreamPerlIOClass *klass)
75 {
76 GMimeStreamClass *stream_class = GMIME_STREAM_CLASS (klass);
77 GObjectClass *object_class = G_OBJECT_CLASS (klass);
78
79 parent_class = g_type_class_ref (GMIME_TYPE_STREAM);
80
81 object_class->finalize = g_mime_stream_perlio_finalize;
82
83 stream_class->read = stream_read;
84 stream_class->write = stream_write;
85 stream_class->flush = stream_flush;
86 stream_class->close = stream_close;
87 stream_class->eos = stream_eos;
88 stream_class->reset = stream_reset;
89 stream_class->seek = stream_seek;
90 stream_class->tell = stream_tell;
91 stream_class->length = stream_length;
92 stream_class->substream = stream_substream;
93 }
94
95 static void
g_mime_stream_perlio_init(GMimeStreamPerlIO * stream,GMimeStreamPerlIOClass * klass)96 g_mime_stream_perlio_init (GMimeStreamPerlIO *stream, GMimeStreamPerlIOClass *klass)
97 {
98 stream->owner = TRUE;
99 stream->fp = NULL;
100 }
101
102 static void
g_mime_stream_perlio_finalize(GObject * object)103 g_mime_stream_perlio_finalize (GObject *object)
104 {
105 GMimeStreamPerlIO *stream = (GMimeStreamPerlIO *) object;
106 dTHX;
107
108 if (stream->owner && stream->fp)
109 PerlIO_close (stream->fp);
110
111 G_OBJECT_CLASS (parent_class)->finalize (object);
112 }
113
114
115 static ssize_t
stream_read(GMimeStream * stream,char * buf,size_t len)116 stream_read (GMimeStream *stream, char *buf, size_t len)
117 {
118 GMimeStreamPerlIO *fstream = (GMimeStreamPerlIO *) stream;
119 ssize_t nread;
120 dTHX;
121
122 if (stream->bound_end != -1 && stream->position >= stream->bound_end)
123 return -1;
124
125 if (stream->bound_end != -1)
126 len = MIN (stream->bound_end - stream->position, len);
127
128 /* make sure we are at the right position */
129 PerlIO_seek (fstream->fp, stream->position, SEEK_SET);
130
131 nread = PerlIO_read (fstream->fp, buf, len);
132
133 if (nread > 0)
134 stream->position += nread;
135
136 return nread;
137 }
138
139 static ssize_t
stream_write(GMimeStream * stream,char * buf,size_t len)140 stream_write (GMimeStream *stream, char *buf, size_t len)
141 {
142 GMimeStreamPerlIO *fstream = (GMimeStreamPerlIO *) stream;
143 ssize_t nwritten;
144 dTHX;
145
146 if (stream->bound_end != -1 && stream->position >= stream->bound_end)
147 return -1;
148
149 if (stream->bound_end != -1)
150 len = MIN (stream->bound_end - stream->position, len);
151
152 /* make sure we are at the right position */
153 PerlIO_seek (fstream->fp, stream->position, SEEK_SET);
154
155 nwritten = PerlIO_write (fstream->fp, buf, len);
156
157 if (nwritten > 0)
158 stream->position += nwritten;
159
160 return nwritten;
161 }
162
163 static int
stream_flush(GMimeStream * stream)164 stream_flush (GMimeStream *stream)
165 {
166 GMimeStreamPerlIO *fstream = (GMimeStreamPerlIO *) stream;
167 dTHX;
168
169 g_return_val_if_fail (fstream->fp != NULL, -1);
170
171 return PerlIO_flush (fstream->fp);
172 }
173
174 static int
stream_close(GMimeStream * stream)175 stream_close (GMimeStream *stream)
176 {
177 GMimeStreamPerlIO *fstream = (GMimeStreamPerlIO *) stream;
178 int ret;
179 dTHX;
180
181 g_return_val_if_fail (fstream->fp != NULL, -1);
182
183 ret = PerlIO_close (fstream->fp);
184 if (ret != -1)
185 fstream->fp = NULL;
186
187 return ret;
188 }
189
190 static gboolean
stream_eos(GMimeStream * stream)191 stream_eos (GMimeStream *stream)
192 {
193 GMimeStreamPerlIO *fstream = (GMimeStreamPerlIO *) stream;
194 dTHX;
195
196 g_return_val_if_fail (fstream->fp != NULL, TRUE);
197
198 if (stream->bound_end == -1)
199 return PerlIO_eof (fstream->fp) ? TRUE : FALSE;
200 else
201 return stream->position >= stream->bound_end;
202 }
203
204 static int
stream_reset(GMimeStream * stream)205 stream_reset (GMimeStream *stream)
206 {
207 GMimeStreamPerlIO *fstream = (GMimeStreamPerlIO *) stream;
208 int ret;
209 dTHX;
210
211 g_return_val_if_fail (fstream->fp != NULL, -1);
212
213 if (stream->position == stream->bound_start)
214 return 0;
215
216 ret = PerlIO_seek (fstream->fp, stream->bound_start, SEEK_SET);
217 if (ret != -1)
218 stream->position = stream->bound_start;
219
220 return ret;
221 }
222
223 static off_t
stream_seek(GMimeStream * stream,off_t offset,GMimeSeekWhence whence)224 stream_seek (GMimeStream *stream, off_t offset, GMimeSeekWhence whence)
225 {
226 GMimeStreamPerlIO *fstream = (GMimeStreamPerlIO *) stream;
227 off_t real = stream->position;
228 int ret;
229 dTHX;
230
231 g_return_val_if_fail (fstream->fp != NULL, -1);
232
233 switch (whence) {
234 case GMIME_STREAM_SEEK_SET:
235 real = offset;
236 break;
237 case GMIME_STREAM_SEEK_CUR:
238 real = stream->position + offset;
239 break;
240 case GMIME_STREAM_SEEK_END:
241 if (stream->bound_end == -1) {
242 PerlIO_seek (fstream->fp, offset, SEEK_END);
243 real = PerlIO_tell (fstream->fp);
244 if (real != -1) {
245 if (real < stream->bound_start)
246 real = stream->bound_start;
247 stream->position = real;
248 }
249 return real;
250 }
251 real = stream->bound_end + offset;
252 break;
253 }
254
255 if (stream->bound_end != -1)
256 real = MIN (real, stream->bound_end);
257 real = MAX (real, stream->bound_start);
258
259 ret = PerlIO_seek (fstream->fp, real, SEEK_SET);
260 if (ret == -1)
261 return -1;
262
263 stream->position = real;
264
265 return real;
266 }
267
268 static off_t
stream_tell(GMimeStream * stream)269 stream_tell (GMimeStream *stream)
270 {
271 return stream->position;
272 }
273
274 static ssize_t
stream_length(GMimeStream * stream)275 stream_length (GMimeStream *stream)
276 {
277 GMimeStreamPerlIO *fstream = (GMimeStreamPerlIO *) stream;
278 off_t bound_end;
279 dTHX;
280
281 if (stream->bound_start != -1 && stream->bound_end != -1)
282 return stream->bound_end - stream->bound_start;
283
284 PerlIO_seek (fstream->fp, 0, SEEK_END);
285 bound_end = PerlIO_tell (fstream->fp);
286 PerlIO_seek (fstream->fp, stream->position, SEEK_SET);
287
288 if (bound_end < stream->bound_start)
289 return -1;
290
291 return bound_end - stream->bound_start;
292 }
293
294 static GMimeStream *
stream_substream(GMimeStream * stream,off_t start,off_t end)295 stream_substream (GMimeStream *stream, off_t start, off_t end)
296 {
297 GMimeStreamPerlIO *fstream;
298
299 fstream = g_object_new (GMIME_TYPE_STREAM_PERLIO, NULL, NULL);
300 fstream->owner = FALSE;
301 fstream->fp = GMIME_STREAM_PERLIO (stream)->fp;
302
303 g_mime_stream_construct (GMIME_STREAM (fstream), start, end);
304
305 return GMIME_STREAM (fstream);
306 }
307
308
309 /**
310 * g_mime_stream_perlio_new:
311 * @fp: PerlIO pointer
312 *
313 * Creates a new GMimeStreamPerlIO object around @fp.
314 *
315 * Returns a stream using @fp.
316 **/
317 GMimeStream *
g_mime_stream_perlio_new(PerlIO * fp)318 g_mime_stream_perlio_new (PerlIO *fp)
319 {
320 GMimeStreamPerlIO *fstream;
321 dTHX;
322
323 fstream = g_object_new (GMIME_TYPE_STREAM_PERLIO, NULL, NULL);
324 fstream->owner = TRUE;
325 fstream->fp = fp;
326
327 GMIME_STREAM (fstream)->bound_end = -1;
328
329 g_mime_stream_construct (GMIME_STREAM (fstream), PerlIO_tell (fp), -1);
330
331 return GMIME_STREAM (fstream);
332 }
333
334
335 /**
336 * g_mime_stream_perlio_new_with_bounds:
337 * @fp: PerlIO pointer
338 * @start: start boundary
339 * @end: end boundary
340 *
341 * Creates a new GMimeStreamPerlIO object around @fp with bounds @start
342 * and @end.
343 *
344 * Returns a stream using @fp with bounds @start and @end.
345 **/
346 GMimeStream *
g_mime_stream_perlio_new_with_bounds(PerlIO * fp,off_t start,off_t end)347 g_mime_stream_perlio_new_with_bounds (PerlIO *fp, off_t start, off_t end)
348 {
349 GMimeStreamPerlIO *fstream;
350
351 fstream = g_object_new (GMIME_TYPE_STREAM_PERLIO, NULL, NULL);
352 fstream->owner = TRUE;
353 fstream->fp = fp;
354
355 g_mime_stream_construct (GMIME_STREAM (fstream), start, end);
356
357 return GMIME_STREAM (fstream);
358 }
359
360
361 /**
362 * g_mime_stream_perlio_get_owner:
363 * @stream: PerlIO stream
364 *
365 * Gets whether or not @stream owns the backend PerlIO pointer.
366 *
367 * Returns %TRUE if @stream owns the backend PerlIO pointer or %FALSE
368 * otherwise.
369 **/
370 gboolean
g_mime_stream_perlio_get_owner(GMimeStreamPerlIO * stream)371 g_mime_stream_perlio_get_owner (GMimeStreamPerlIO *stream)
372 {
373 g_return_val_if_fail (GMIME_IS_STREAM_PERLIO (stream), FALSE);
374
375 return stream->owner;
376 }
377
378
379 /**
380 * g_mime_stream_perlio_set_owner:
381 * @stream: PerlIO stream
382 * @owner: owner
383 *
384 * Sets whether or not @stream owns the backend PerlIO pointer.
385 *
386 * Note: @owner should be %TRUE if the stream should fclose() the
387 * backend PerlIO pointer when destroyed or %FALSE otherwise.
388 **/
389 void
g_mime_stream_perlio_set_owner(GMimeStreamPerlIO * stream,gboolean owner)390 g_mime_stream_perlio_set_owner (GMimeStreamPerlIO *stream, gboolean owner)
391 {
392 g_return_if_fail (GMIME_IS_STREAM_PERLIO (stream));
393
394 stream->owner = owner;
395 }
396