1/*
2 * tkimg.c --
3 *
4 *  Generic interface to XML parsers.
5 *
6 * Copyright (c) 2002 Andreas Kupries <andreas_kupries@users.sourceforge.net>
7 *
8 * Zveno Pty Ltd makes this software and associated documentation
9 * available free of charge for any purpose.  You may make copies
10 * of the software but you must include all of this notice on any copy.
11 *
12 * Zveno Pty Ltd does not warrant that this software is error free
13 * or fit for any purpose.  Zveno Pty Ltd disclaims any liability for
14 * all claims, expenses, losses, damages and costs any user may incur
15 * as a result of using, copying or modifying the software.
16 *
17 * $Id: tkimg.c 274 2010-06-28 13:23:34Z nijtmans $
18 *
19 */
20
21#include "tkimg.h"
22
23MODULE_SCOPE const TkimgStubs tkimgStubs;
24
25/*
26 * Declarations for externally visible functions.
27 */
28
29#ifdef ALLOW_B64
30static int tob64(void *clientData, Tcl_Interp *interp,
31	int argc, Tcl_Obj *const objv[]);
32static int fromb64(void *clientData, Tcl_Interp *interp,
33	int argc, Tcl_Obj *const objv[]);
34#endif
35
36/*
37 *----------------------------------------------------------------------------
38 *
39 * Tkimg_Init --
40 *
41 *  Initialisation routine for loadable module
42 *
43 * Results:
44 *  None.
45 *
46 * Side effects:
47 *  Creates commands in the interpreter,
48 *  loads xml package.
49 *
50 *----------------------------------------------------------------------------
51 */
52
53int Tkimg_Init(
54	Tcl_Interp *interp /* Interpreter to initialise. */
55) {
56
57	if (!Tcl_InitStubs(interp, "8.3", 0)) {
58		return TCL_ERROR;
59	}
60	if (!Tk_InitStubs(interp, "8.3", 0)) {
61		return TCL_ERROR;
62	}
63	TkimgInitUtilities(interp);
64#ifdef ALLOW_B64 /* Undocumented feature */
65	Tcl_CreateObjCommand(interp, "img_to_base64", tob64, NULL, NULL);
66	Tcl_CreateObjCommand(interp, "img_from_base64", fromb64, NULL, NULL);
67#endif
68
69	if (Tcl_PkgProvideEx(interp, PACKAGE_TCLNAME, PACKAGE_VERSION,
70			(void *)&tkimgStubs) != TCL_OK
71	) {
72		return TCL_ERROR;
73	}
74
75	return TCL_OK;
76}
77
78/*
79 *----------------------------------------------------------------------------
80 *
81 * Tkimg_SafeInit --
82 *
83 *  Initialisation routine for loadable module in a safe interpreter.
84 *
85 * Results:
86 *  None.
87 *
88 * Side effects:
89 *  Creates commands in the interpreter,
90 *  loads xml package.
91 *
92 *----------------------------------------------------------------------------
93 */
94
95int Tkimg_SafeInit(
96	Tcl_Interp *interp /* Interpreter to initialise. */
97) {
98	return Tkimg_Init(interp);
99}
100
101/*
102 *-------------------------------------------------------------------------
103 * tob64 --
104 *  This function converts the contents of a file into a base-64
105 *  encoded string.
106 *
107 * Results:
108 *  none
109 *
110 * Side effects:
111 *  none
112 *
113 *-------------------------------------------------------------------------
114 */
115
116#ifdef ALLOW_B64
117int tob64(
118	void *clientData,
119	Tcl_Interp *interp,
120	int argc,
121	Tcl_Obj *const objv[]
122) {
123	Tcl_DString dstring;
124	tkimg_MFile handle;
125	Tcl_Channel chan;
126	char buffer[1024];
127	int len;
128
129	if (argc != 2) {
130		Tcl_WrongNumArgs(interp, 1, objv, "filename");
131		return TCL_ERROR;
132	}
133
134	chan = tkimg_OpenFileChannel(interp, Tcl_GetStringFromObj(objv[1], &len), 0);
135	if (!chan) {
136		return TCL_ERROR;
137	}
138
139	Tcl_DStringInit(&dstring);
140	tkimg_WriteInit(&dstring, &handle);
141
142	while ((len = Tcl_Read(chan, buffer, 1024)) == 1024) {
143		tkimg_Write(&handle, buffer, 1024);
144	}
145	if (len > 0) {
146		tkimg_Write(&handle, buffer, len);
147	}
148	if ((Tcl_Close(interp, chan) == TCL_ERROR) || (len < 0)) {
149		Tcl_DStringFree(&dstring);
150		Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], &len),
151			": ", Tcl_PosixError(interp), NULL);
152		return TCL_ERROR;
153	}
154	tkimg_Putc(IMG_DONE, &handle);
155
156	Tcl_DStringResult(interp, &dstring);
157	return TCL_OK;
158}
159
160/*
161 *-------------------------------------------------------------------------
162 * fromb64 --
163 *  This function converts a base-64 encoded string into binary form,
164 *  which is written to a file.
165 *
166 * Results:
167 *  none
168 *
169 * Side effects:
170 *  none
171 *
172 *-------------------------------------------------------------------------
173 */
174
175int fromb64(
176	void *clientData,
177	Tcl_Interp *interp,
178	int argc,
179	Tcl_Obj *const objv[]
180) {
181	tkimg_MFile handle;
182	Tcl_Channel chan;
183	char buffer[1024];
184	int len;
185
186	if (argc != 3) {
187		Tcl_WrongNumArgs(interp, 1, objv, "filename data");
188		return TCL_ERROR;
189	}
190
191	chan = tkimg_OpenFileChannel(interp, Tcl_GetStringFromObj(objv[1], &len), 0644);
192	if (!chan) {
193		return TCL_ERROR;
194	}
195
196	handle.data = Tcl_GetStringFromObj(objv[2], &handle.length);
197	handle.state = 0;
198
199	while ((len = tkimg_Read(&handle, buffer, 1024)) == 1024) {
200		if (Tcl_Write(chan, buffer, 1024) != 1024) {
201			goto writeerror;
202		}
203	}
204	if (len > 0) {
205		if (Tcl_Write(chan, buffer, len) != len) {
206			goto writeerror;
207		}
208	}
209	if (Tcl_Close(interp, chan) == TCL_ERROR) {
210		return TCL_ERROR;
211	}
212	return TCL_OK;
213
214writeerror:
215	Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], &len), ": ",
216		Tcl_PosixError(interp), NULL);
217	return TCL_ERROR;
218}
219#endif
220