/[webpac]/openisis/0.9.9e/tcl/uticl.c
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /openisis/0.9.9e/tcl/uticl.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 604 - (show annotations)
Mon Dec 27 21:49:01 2004 UTC (18 years, 1 month ago) by dpavlin
File MIME type: text/plain
File size: 3998 byte(s)
import of new openisis release, 0.9.9e

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 }

  ViewVC Help
Powered by ViewVC 1.1.26