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
18 #include "tkimg.h"
19
20 MODULE_SCOPE const TkimgStubs tkimgStubs;
21
22 /*
23 * Declarations for externally visible functions.
24 */
25
26 #ifdef ALLOW_B64
27 static int tob64(void *clientData, Tcl_Interp *interp,
28 int argc, Tcl_Obj *const objv[]);
29 static int fromb64(void *clientData, Tcl_Interp *interp,
30 int argc, Tcl_Obj *const objv[]);
31 #endif
32
33 /*
34 *----------------------------------------------------------------------------
35 *
36 * Tkimg_Init --
37 *
38 * Initialisation routine for loadable module
39 *
40 * Results:
41 * None.
42 *
43 * Side effects:
44 * Creates commands in the interpreter,
45 * loads xml package.
46 *
47 *----------------------------------------------------------------------------
48 */
49
Tkimg_Init(Tcl_Interp * interp)50 int Tkimg_Init(
51 Tcl_Interp *interp /* Interpreter to initialise. */
52 ) {
53
54 if (!Tcl_InitStubs(interp, "8.3", 0)) {
55 return TCL_ERROR;
56 }
57 if (!Tk_InitStubs(interp, "8.3", 0)) {
58 return TCL_ERROR;
59 }
60 TkimgInitUtilities(interp);
61 #ifdef ALLOW_B64 /* Undocumented feature */
62 Tcl_CreateObjCommand(interp, "img_to_base64", tob64, NULL, NULL);
63 Tcl_CreateObjCommand(interp, "img_from_base64", fromb64, NULL, NULL);
64 #endif
65
66 if (Tcl_PkgProvideEx(interp, PACKAGE_TCLNAME, PACKAGE_VERSION,
67 (void *)&tkimgStubs) != TCL_OK
68 ) {
69 return TCL_ERROR;
70 }
71
72 return TCL_OK;
73 }
74
75 /*
76 *----------------------------------------------------------------------------
77 *
78 * Tkimg_SafeInit --
79 *
80 * Initialisation routine for loadable module in a safe interpreter.
81 *
82 * Results:
83 * None.
84 *
85 * Side effects:
86 * Creates commands in the interpreter,
87 * loads xml package.
88 *
89 *----------------------------------------------------------------------------
90 */
91
Tkimg_SafeInit(Tcl_Interp * interp)92 int Tkimg_SafeInit(
93 Tcl_Interp *interp /* Interpreter to initialise. */
94 ) {
95 return Tkimg_Init(interp);
96 }
97
98 /*
99 *-------------------------------------------------------------------------
100 * tob64 --
101 * This function converts the contents of a file into a base-64
102 * encoded string.
103 *
104 * Results:
105 * none
106 *
107 * Side effects:
108 * none
109 *
110 *-------------------------------------------------------------------------
111 */
112
113 #ifdef ALLOW_B64
tob64(void * clientData,Tcl_Interp * interp,int argc,Tcl_Obj * const objv[])114 int tob64(
115 void *clientData,
116 Tcl_Interp *interp,
117 int argc,
118 Tcl_Obj *const objv[]
119 ) {
120 Tcl_DString dstring;
121 tkimg_MFile handle;
122 Tcl_Channel chan;
123 char buffer[1024];
124 size_t len;
125
126 if (argc != 2) {
127 Tcl_WrongNumArgs(interp, 1, objv, "filename");
128 return TCL_ERROR;
129 }
130
131 chan = tkimg_OpenFileChannel(interp, Tcl_GetStringFromObj(objv[1], &len), 0);
132 if (!chan) {
133 return TCL_ERROR;
134 }
135
136 Tcl_DStringInit(&dstring);
137 tkimg_WriteInit(&dstring, &handle);
138
139 while ((len = Tcl_Read(chan, buffer, 1024)) == 1024) {
140 tkimg_Write(&handle, buffer, 1024);
141 }
142 if (len + 1 > 1) {
143 tkimg_Write(&handle, buffer, len);
144 }
145 if ((Tcl_Close(interp, chan) == TCL_ERROR) || (len < 0)) {
146 Tcl_DStringFree(&dstring);
147 Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], &len),
148 ": ", Tcl_PosixError(interp), NULL);
149 return TCL_ERROR;
150 }
151 tkimg_Putc(IMG_DONE, &handle);
152
153 Tcl_DStringResult(interp, &dstring);
154 return TCL_OK;
155 }
156
157 /*
158 *-------------------------------------------------------------------------
159 * fromb64 --
160 * This function converts a base-64 encoded string into binary form,
161 * which is written to a file.
162 *
163 * Results:
164 * none
165 *
166 * Side effects:
167 * none
168 *
169 *-------------------------------------------------------------------------
170 */
171
fromb64(void * clientData,Tcl_Interp * interp,int argc,Tcl_Obj * const objv[])172 int fromb64(
173 void *clientData,
174 Tcl_Interp *interp,
175 int argc,
176 Tcl_Obj *const objv[]
177 ) {
178 tkimg_MFile handle;
179 Tcl_Channel chan;
180 char buffer[1024];
181 size_t len;
182
183 if (argc != 3) {
184 Tcl_WrongNumArgs(interp, 1, objv, "filename data");
185 return TCL_ERROR;
186 }
187
188 chan = tkimg_OpenFileChannel(interp, Tcl_GetStringFromObj(objv[1], &len), 0644);
189 if (!chan) {
190 return TCL_ERROR;
191 }
192
193 handle.data = Tcl_GetStringFromObj(objv[2], &handle.length);
194 handle.state = 0;
195
196 while ((len = tkimg_Read(&handle, buffer, 1024)) == 1024) {
197 if (Tcl_Write(chan, buffer, 1024) != 1024) {
198 goto writeerror;
199 }
200 }
201 if (len + 1 > 1) {
202 if ((size_t)Tcl_Write(chan, buffer, len) != len) {
203 goto writeerror;
204 }
205 }
206 if (Tcl_Close(interp, chan) == TCL_ERROR) {
207 return TCL_ERROR;
208 }
209 return TCL_OK;
210
211 writeerror:
212 Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], &len), ": ",
213 Tcl_PosixError(interp), NULL);
214 return TCL_ERROR;
215 }
216 #endif
217