/[dtapublic]/projs/dtats/tags/0000.00/shared_source/c_tclxtens_7_5/crchashextns.c
ViewVC logotype

Contents of /projs/dtats/tags/0000.00/shared_source/c_tclxtens_7_5/crchashextns.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 68 - (show annotations) (download)
Mon Oct 31 16:18:20 2016 UTC (8 years, 1 month ago) by dashley
Original Path: projs/trunk/shared_source/c_tclxtens_7_5/crchashextns.c
File MIME type: text/plain
File size: 13718 byte(s)
Licensing change.  Header and footer cleanup.  Addition of keyword expansion.
1 //$Header$
2 //-------------------------------------------------------------------------------------------------
3 //This file is part of "David T. Ashley's Shared Source Code", a set of shared components
4 //integrated into many of David T. Ashley's projects.
5 //-------------------------------------------------------------------------------------------------
6 //This source code and any program in which it is compiled/used is provided under the MIT License,
7 //reproduced below.
8 //-------------------------------------------------------------------------------------------------
9 //Permission is hereby granted, free of charge, to any person obtaining a copy of
10 //this software and associated documentation files(the "Software"), to deal in the
11 //Software without restriction, including without limitation the rights to use,
12 //copy, modify, merge, publish, distribute, sublicense, and / or sell copies of the
13 //Software, and to permit persons to whom the Software is furnished to do so,
14 //subject to the following conditions :
15 //
16 //The above copyright notice and this permission notice shall be included in all
17 //copies or substantial portions of the Software.
18 //
19 //THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
20 //IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
21 //FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.IN NO EVENT SHALL THE
22 //AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
23 //LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
24 //OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
25 //SOFTWARE.
26 //-------------------------------------------------------------------------------------------------
27 #define MODULE_CRCHASHEXTNS
28
29 #include <string.h>
30
31 #include "tcl.h"
32 #include "tcldecls.h"
33
34 #include "crchashextns.h"
35 #include "crchashfuncs.h"
36
37 #include "strfuncs.h"
38 #include "tclalloc.h"
39
40
41 //Procedure called when the "crc32" command is encountered in a Tcl script.
42 //
43 int CRCHASHEXTNS_Crc32extnCommand(ClientData dummy,
44 Tcl_Interp *interp,
45 int objc,
46 Tcl_Obj *objv[])
47 {
48 Tcl_Obj *rv;
49 //Value that will be returned.
50 Tcl_Obj *block_obj;
51 //Used for file reads.
52 char buffer[11];
53 //Space for "0x" followed by 8 hex chars and terminator.
54 struct CRCHASHFUNCS_Crc32StateStruct crc_state;
55 //CRC state structure, internals nominally known and accessible to another
56 //another software module.
57 unsigned long crc;
58 //Calculated CRC.
59 unsigned long bytearraysize;
60 //Size of block allocated or portion used.
61 char *bytearrayptr;
62 //Pointer to array of bytes.
63 char *fname;
64 //File name specified.
65 char *blockbuf;
66 //Pointer to array of bytes.
67 Tcl_Channel chan;
68 //Channel opened using the Tcl libraries.
69 int return_code, return_code_b;
70 //Return codes from Tcl library functions.
71 int loop_exit_flag;
72 //Looping exit flag.
73 int chars_read;
74 //Number of characters read (i.e. for short read).
75 int block_obj_n;
76
77
78 if (objc < 2 || objc > 3)
79 {
80 Tcl_WrongNumArgs(interp,
81 1,
82 objv,
83 "?-string? filename_or_string_value");
84
85 return TCL_ERROR;
86 }
87 else if (objc == 2)
88 {
89 //Be sure that the internal crc table has been built. This function
90 //also returns a table correctness code. Error out severely if the
91 //CRC module believes its internal data has been corrupted.
92 if (!CRCHASHFUNCS_Crc32TableCheck())
93 {
94 //Serious internal error. Error out.
95
96 //Create the return object.
97 rv = Tcl_NewStringObj("CRCHASHEXTNS.C: Serious internal error: CRC-32 lookup table corrupted.", -1);
98
99 //Set the return value to be the error message.
100 Tcl_SetObjResult(interp, rv);
101
102 //Error return.
103 return TCL_ERROR;
104 }
105
106 //We need to open a channel, run it through the CRC algorithm, and
107 //return results.
108
109 //Get the string representation of the object.
110 fname = Tcl_GetString(objv[1]);
111
112 //Attempt to open a file channel. The error information, if any,
113 //will be placed in the interpreter's state.
114 chan = Tcl_OpenFileChannel(interp, fname, "r", 0);
115
116 //There is the possibility that the channel could not be opened
117 //successfully. If there was an error, error out.
118 if (!chan)
119 {
120 //Create the return object.
121 rv = Tcl_NewStringObj("crc32: Tcl_OpenFileChannel() failure on file name: ", -1);
122
123 //Tack on the offensive argument.
124 Tcl_AppendToObj(rv, fname, -1);
125
126 //Set the return value to be the error message.
127 Tcl_SetObjResult(interp, rv);
128
129 //Error return.
130 return TCL_ERROR;
131 }
132
133 //Try to set the channel encoding to binary and record the return code.
134 return_code = Tcl_SetChannelOption(interp, chan, "-encoding", "binary");
135
136 //Try to set the channel translation mode to binary and record the return
137 //code.
138 if (return_code == TCL_OK)
139 return_code_b = Tcl_SetChannelOption(interp, chan, "-translation", "binary");
140
141 //If the attempt to set the channel encoding or translation
142 //didn't go well, error out. Must also try to chose the channel because
143 //it was successfully opened.
144 if ((return_code != TCL_OK) || (return_code_b != TCL_OK))
145 {
146 //Try to close the channel. "interp" not supplied so as not
147 //to overwrite error info.
148 Tcl_Close(NULL, chan);
149
150 //Create the return object.
151 rv = Tcl_NewStringObj("crc32: Tcl_SetChannelOption() failure.", -1);
152
153 //Set the return value to be the error message.
154 Tcl_SetObjResult(interp, rv);
155
156 //Error return.
157 return TCL_ERROR;
158 }
159
160 //Allocate the object to hold the block buffer. I've examined the
161 //function, and cannot do it with with a NULL pointer. Must instead
162 //allocate SOMETHING, although it will be destroyed immediately on
163 //the first read. This will have reference count zero.
164 block_obj = Tcl_NewByteArrayObj("Trash", 5);
165
166 //Calculate the CRC. The essential process is to keep reading
167 //and adding to the CRC until end of file.
168 //Open and initialize the necessary structure.
169 CRCHASHFUNCS_Crc32StateStructOpen(&crc_state);
170
171 loop_exit_flag = 0;
172
173 do
174 {
175 //Grab as many chars as possible, up to 65536 of them.
176 //65536 was chosen because this is large enough for great
177 //performance, but small enough that it won't make a significant
178 //virtual memory impact.
179 chars_read = Tcl_ReadChars(chan, block_obj, 65536, 0);
180
181 //If the characters read shows as <0, this is an error
182 //condition. Trap.
183 if (chars_read < 0)
184 {
185 //Try to close the channel. "interp" not supplied so as not
186 //to overwrite error info.
187 Tcl_Close(NULL, chan);
188
189 //Deallocate the buffer used to accept block file reads. Because the
190 //creation process set the reference count to zero, a single
191 //decrement will destroy the object.
192 Tcl_DecrRefCount(block_obj);
193
194 //Create the return object.
195 rv = Tcl_NewStringObj("crc32: Tcl_ReadChars() failure.", -1);
196
197 //Set the return value to be the error message.
198 Tcl_SetObjResult(interp, rv);
199
200 //Error return.
201 return TCL_ERROR;
202 }
203
204 //Obtain a pointer to the binary block that was read.
205 blockbuf = Tcl_GetByteArrayFromObj(block_obj, &block_obj_n);
206
207 //Add to the CRC for those chars read. Skip the zero case.
208 if (block_obj_n > 0)
209 {
210 CRCHASHFUNCS_Crc32StateStructAddData(&crc_state,
211 blockbuf,
212 block_obj_n);
213 }
214
215 //We want to exit if EOF is true. A short read would
216 //also be an indication, but short read should imply
217 //EOF, so should not test both.
218 return_code = Tcl_Eof(chan);
219 loop_exit_flag = (return_code != 0);
220 } while(!loop_exit_flag);
221
222 //Extract the CRC.
223 crc = CRCHASHFUNCS_Crc32Extract(&crc_state);
224
225 //Postprocess the structure.
226 CRCHASHFUNCS_Crc32StateStructClose(&crc_state);
227
228 //Close the channel.
229 return_code = Tcl_Close(interp, chan);
230
231 //If there was an error closing the channel, error out.
232 if (return_code != TCL_OK)
233 {
234 //Create the return object.
235 rv = Tcl_NewStringObj("crc32: Tcl_Close() failure.", -1);
236
237 //Set the return value to be the error message.
238 Tcl_SetObjResult(interp, rv);
239
240 //Error return.
241 return TCL_ERROR;
242 }
243
244 //Deallocate the buffer used to accept block file reads. Because the
245 //creation process set the reference count to zero, a single
246 //decrement will destroy the object.
247 Tcl_DecrRefCount(block_obj);
248
249 //Return the CRC to the caller. No detectable errors
250 //are possible at this point.
251
252 //Convert the long integer to a hexadecimal representation.
253 Strfuncs_UlToHexString(crc, buffer+2, 1);
254
255 //Stuff the leading characters of the hexadecimal representation.
256 buffer[0] = '0';
257 buffer[1] = 'x';
258
259 //Stuff the string terminator.
260 buffer[10] = 0;
261
262 //Create the return object.
263 rv = Tcl_NewStringObj(buffer, -1);
264
265 //Set the return value to be the hexadecimal representation of the
266 //CRC.
267 Tcl_SetObjResult(interp, rv);
268
269 //Everything went well, return the OK code.
270 return TCL_OK;
271 }
272 else /* if (objc == 3) */
273 {
274 //The second parameter positively must be "-string" or a substring
275 //of that. At present, there are no competing option flags, so
276 //a simple substring lookup will handle it.
277 //Yank the string pointer.
278 bytearrayptr = Tcl_GetString(objv[1]);
279
280 //If not a substring, error out.
281 if ((strlen(bytearrayptr)<2) || !Strfuncs_IsSubstring(bytearrayptr, "-string"))
282 {
283 //Create the return object.
284 rv = Tcl_NewStringObj("crc32: Unrecognized switch: ", -1);
285
286 //Tack on the offensive argument.
287 Tcl_AppendToObj(rv, bytearrayptr, -1);
288
289 //Set the return value to be the error message.
290 Tcl_SetObjResult(interp, rv);
291
292 //Error return.
293 return TCL_ERROR;
294 }
295
296 //Convert the last parameter to its byte representation and get a
297 //pointer to this representation and the length. This was the
298 //library call that Ajuba recommended.
299 bytearrayptr = Tcl_GetByteArrayFromObj(objv[2], &bytearraysize);
300
301 //Be sure that the internal crc table has been built. This function
302 //also returns a table correctness code. Error out severely if the
303 //CRC module believes its internal data has been corrupted.
304 if (!CRCHASHFUNCS_Crc32TableCheck())
305 {
306 //Serious internal error. Error out.
307
308 //Create the return object.
309 rv = Tcl_NewStringObj("CRCHASHEXTNS.C: Serious internal error: CRC-32 lookup table corrupted.", -1);
310
311 //Set the return value to be the error message.
312 Tcl_SetObjResult(interp, rv);
313
314 //Error return.
315 return TCL_ERROR;
316 }
317
318 //Open and initialize the necessary structure.
319 CRCHASHFUNCS_Crc32StateStructOpen(&crc_state);
320
321 //Process the string.
322 CRCHASHFUNCS_Crc32StateStructAddData(&crc_state,
323 bytearrayptr,
324 bytearraysize);
325 //Extract the CRC.
326 crc = CRCHASHFUNCS_Crc32Extract(&crc_state);
327
328 //Postprocess the structure.
329 CRCHASHFUNCS_Crc32StateStructClose(&crc_state);
330
331 //Convert the long integer to a hexadecimal representation.
332 Strfuncs_UlToHexString(crc, buffer+2, 1);
333
334 //Stuff the leading characters of the hexadecimal representation.
335 buffer[0] = '0';
336 buffer[1] = 'x';
337
338 //Stuff the string terminator.
339 buffer[10] = 0;
340
341 //Create the return object.
342 rv = Tcl_NewStringObj(buffer, -1);
343
344 //Set the return value to be the hexadecimal representation of the
345 //CRC.
346 Tcl_SetObjResult(interp, rv);
347
348 //Everything went well, return the OK code.
349 return TCL_OK;
350 }
351 }
352
353
354 //Performs initial registration to the hash table.
355 //
356 void CRCHASHEXTNS_Crc32extnInit(Tcl_Interp *interp)
357 {
358 //Register a command named "crc32".
359 Tcl_CreateObjCommand(interp,
360 "crc32",
361 (Tcl_ObjCmdProc *)CRCHASHEXTNS_Crc32extnCommand,
362 NULL,
363 NULL);
364 }
365
366
367 //Returns version control string for file.
368 //
369 const char *CRCHASHEXTNS_cvcinfo(void)
370 {
371 return ("$Header$");
372 }
373
374
375 //Returns version control string for associated .H file.
376 //
377 const char *CRCHASHEXTNS_hvcinfo(void)
378 {
379 return (CRCHASHEXTNS_H_VERSION);
380 }
381
382 //End of crchashextns.c.

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25