0.9.9e/tcl/uticl.c

/*
        The Malete project - the Z39.2/Z39.50 database framework of OpenIsis.
        Version 0.9.x (patchlevel see file Version)
        Copyright (C) 2001-2004 by Erik Grziwotz, erik@openisis.org

        This library is free software; you can redistribute it and/or
        modify it under the terms of the GNU Lesser General Public
        License as published by the Free Software Foundation; either
        version 2.1 of the License, or (at your option) any later version.

        This library is distributed in the hope that it will be useful,
        but WITHOUT ANY WARRANTY; without even the implied warranty of
        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
        See the GNU Lesser General Public License for more details.

        You should have received a copy of the GNU Lesser General Public
        License along with this library; if not, write to the Free Software
        Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

        see README for more information
EOH */

/*
        $Id: uticl.c,v 1.1 2004/09/28 17:17:12 kripke Exp $
        malete utilities for Tcl
*/

#include <tcl.h>
/* #include <tclInt.h> tclByteArrayType */
extern Tcl_ObjType tclByteArrayType;
extern Tcl_ObjType tclStringType;

/*
work around the broken ByteArray type

UpdateStringOfByteArray:
        byte arrays are turned into strings by treating every byte as Latin-1 char
        and properly UTF-8ing these (so string length gives proper byte array length)
        This is identical to encoding convertfrom iso8859-1
        Such strings when written to a iso8859-1 channel will restore the bytes.

Tcl_GetByteArrayFromObj:
        strings are turned into byte arrays by benignly UTF-8 decoding to real
        unicode chars and strip the high bytes
        Latin-1 bytes not accidentally forming valid UTF-8 sequences
        will map to themselves, other will get lost.
        This is similar to encoding convertto iso8859-1
        Only strings properly UTF-8-encoding iso8859-1 chars will survive,
        such as those read from an iso8859-1 channel.

byte arrays are used (Tcl_GetByteArrayFromObj) by:
        binary scan i(and format when formatting a,b and h !) (tclBinary.c)
        encoding convertfrom (tclCmdAH.c)
        string compare, if both are already byte arrays (tclCmdMZ.c, tclExecute.c)
        string index, length, range on a byte array
        output (Tcl_WriteObj in tclIO.c) for binary (NULL) encoding
        (identity encoding does untranslated strings)

byte arrays are produced (Tcl_New/SetByteArrayObj/Length) by:
        binary format (and scan for some)
        encoding convertto
        string index, range on a byte array
*/

/*
        bytearray
*/
static int cmdBA (
        ClientData ignore, Tcl_Interp *ip, int objc, Tcl_Obj* const objv[]
) {
        static const char *cmds[] = {
                "is", /* is a bytearray */
                "length", /* real length w/o conversion */
                "tostring", /* make a string using just this bytes */
                "fromstring", /* make a bytearray using just this bytes */
                0
        };
        enum {
                CMD_IS,
                CMD_LEN,
                CMD_TOS,
                CMD_FRS
        };
        char *bytes;
        int cmd, isba, len;
        Tcl_Obj *obj, *ret;

        (void)ignore;
        if ( 3 != objc ) {
                Tcl_AppendResult(ip, "usage: ", Tcl_GetString(objv[0]),
                        " is|length|tostring|fromstring val", 0);
                return TCL_ERROR;
        }
        if ( TCL_OK !=
                Tcl_GetIndexFromObj(ip, objv[1], cmds, "bytearray command", 0, &cmd)
        )
                return TCL_ERROR;
        obj = objv[2];
        isba = &tclByteArrayType == obj->typePtr;
        ret = Tcl_GetObjResult(ip);
        switch (cmd) {
        case CMD_IS:
                Tcl_SetIntObj(ret, isba);
                break;
        case CMD_TOS:
                if ( &tclStringType == obj->typePtr ) {
                        Tcl_SetObjResult(ip, obj);
                        break;
                }
        case CMD_LEN:
                bytes = isba
                        ? (char*)Tcl_GetByteArrayFromObj(obj, &len) /* len = o->used */
                        : Tcl_GetStringFromObj(obj, &len);
                if ( CMD_LEN == cmd )
                        Tcl_SetIntObj(ret, len);
                else
                        Tcl_SetStringObj(ret, bytes, len);
                break;
        case CMD_FRS:
                if (isba)
                        Tcl_SetObjResult(ip, obj);
                else {
                        bytes = Tcl_GetStringFromObj(obj, &len);
                        Tcl_SetByteArrayObj(ret, (unsigned char*)bytes, len);
                }
                break;
        }
        return TCL_OK;
}       /* cmdBA */


int utiInit (Tcl_Interp *ip)
{
        Tcl_CreateObjCommand (ip, "::malete::bytearray", cmdBA, 0, 0);
        return TCL_OK;
}
1	dpavlin	604	/*
2			The Malete project - the Z39.2/Z39.50 database framework of OpenIsis.
3			Version 0.9.x (patchlevel see file Version)
4			Copyright (C) 2001-2004 by Erik Grziwotz, erik@openisis.org
5
6			This library is free software; you can redistribute it and/or
7			modify it under the terms of the GNU Lesser General Public
8			License as published by the Free Software Foundation; either
9			version 2.1 of the License, or (at your option) any later version.
10
11			This library is distributed in the hope that it will be useful,
12			but WITHOUT ANY WARRANTY; without even the implied warranty of
13			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14			See the GNU Lesser General Public License for more details.
15
16			You should have received a copy of the GNU Lesser General Public
17			License along with this library; if not, write to the Free Software
18			Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19
20			see README for more information
21			EOH */
22
23			/*
24			$Id: uticl.c,v 1.1 2004/09/28 17:17:12 kripke Exp $
25			malete utilities for Tcl
26			*/
27
28			#include <tcl.h>
29			/* #include <tclInt.h> tclByteArrayType */
30			extern Tcl_ObjType tclByteArrayType;
31			extern Tcl_ObjType tclStringType;
32
33			/*
34			work around the broken ByteArray type
35
36			UpdateStringOfByteArray:
37			byte arrays are turned into strings by treating every byte as Latin-1 char
38			and properly UTF-8ing these (so string length gives proper byte array length)
39			This is identical to encoding convertfrom iso8859-1
40			Such strings when written to a iso8859-1 channel will restore the bytes.
41
42			Tcl_GetByteArrayFromObj:
43			strings are turned into byte arrays by benignly UTF-8 decoding to real
44			unicode chars and strip the high bytes
45			Latin-1 bytes not accidentally forming valid UTF-8 sequences
46			will map to themselves, other will get lost.
47			This is similar to encoding convertto iso8859-1
48			Only strings properly UTF-8-encoding iso8859-1 chars will survive,
49			such as those read from an iso8859-1 channel.
50
51			byte arrays are used (Tcl_GetByteArrayFromObj) by:
52			binary scan i(and format when formatting a,b and h !) (tclBinary.c)
53			encoding convertfrom (tclCmdAH.c)
54			string compare, if both are already byte arrays (tclCmdMZ.c, tclExecute.c)
55			string index, length, range on a byte array
56			output (Tcl_WriteObj in tclIO.c) for binary (NULL) encoding
57			(identity encoding does untranslated strings)
58
59			byte arrays are produced (Tcl_New/SetByteArrayObj/Length) by:
60			binary format (and scan for some)
61			encoding convertto
62			string index, range on a byte array
63			*/
64
65			/*
66			bytearray
67			*/
68			static int cmdBA (
69			ClientData ignore, Tcl_Interp ip, int objc, Tcl_Obj const objv[]
70			) {
71			static const char *cmds[] = {
72			"is", /* is a bytearray */
73			"length", /* real length w/o conversion */
74			"tostring", /* make a string using just this bytes */
75			"fromstring", /* make a bytearray using just this bytes */
76			0
77			};
78			enum {
79			CMD_IS,
80			CMD_LEN,
81			CMD_TOS,
82			CMD_FRS
83			};
84			char *bytes;
85			int cmd, isba, len;
86			Tcl_Obj obj, ret;
87
88			(void)ignore;
89			if ( 3 != objc ) {
90			Tcl_AppendResult(ip, "usage: ", Tcl_GetString(objv[0]),
91			" is\|length\|tostring\|fromstring val", 0);
92			return TCL_ERROR;
93			}
94			if ( TCL_OK !=
95			Tcl_GetIndexFromObj(ip, objv[1], cmds, "bytearray command", 0, &cmd)
96			)
97			return TCL_ERROR;
98			obj = objv[2];
99			isba = &tclByteArrayType == obj->typePtr;
100			ret = Tcl_GetObjResult(ip);
101			switch (cmd) {
102			case CMD_IS:
103			Tcl_SetIntObj(ret, isba);
104			break;
105			case CMD_TOS:
106			if ( &tclStringType == obj->typePtr ) {
107			Tcl_SetObjResult(ip, obj);
108			break;
109			}
110			case CMD_LEN:
111			bytes = isba
112			? (char)Tcl_GetByteArrayFromObj(obj, &len) / len = o->used */
113			: Tcl_GetStringFromObj(obj, &len);
114			if ( CMD_LEN == cmd )
115			Tcl_SetIntObj(ret, len);
116			else
117			Tcl_SetStringObj(ret, bytes, len);
118			break;
119			case CMD_FRS:
120			if (isba)
121			Tcl_SetObjResult(ip, obj);
122			else {
123			bytes = Tcl_GetStringFromObj(obj, &len);
124			Tcl_SetByteArrayObj(ret, (unsigned char*)bytes, len);
125			}
126			break;
127			}
128			return TCL_OK;
129			} /* cmdBA */
130
131
132			int utiInit (Tcl_Interp *ip)
133			{
134			Tcl_CreateObjCommand (ip, "::malete::bytearray", cmdBA, 0, 0);
135			return TCL_OK;
136			}