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	/*
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	}