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