Fixed panic when running against a tcl build with TCL_COMPILE_DEBUG. A SetFromAny proc should not invalidate an existing stringrep, which <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_SetCacheFromAny">SetCacheFromAny</a> was doing.
1 | /* |
2 | * The contents of this file are subject to the AOLserver Public License |
3 | * Version 1.1 (the "License"); you may not use this file except in |
4 | * compliance with the License. You may obtain a copy of the License at |
5 | * http://aolserver.lcs.mit.edu/. |
6 | * |
7 | * Software distributed under the License is distributed on an "AS IS" |
8 | * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See |
9 | * the License for the specific language governing rights and limitations |
10 | * under the License. |
11 | * |
12 | * The Original Code is ArsDigita code and related documentation |
13 | * distributed by ArsDigita. |
14 | * |
15 | * The Initial Developer of the Original Code is ArsDigita., |
16 | * Portions created by ArsDigita are Copyright (C) 1999 ArsDigita. |
17 | * All Rights Reserved. |
18 | * |
19 | * Alternatively, the contents of this file may be used under the terms |
20 | * of the GNU General Public License (the "GPL"), in which case the |
21 | * provisions of GPL are applicable instead of those above. If you wish |
22 | * to allow use of your version of this file only under the terms of the |
23 | * GPL and not to allow others to use your version of this file under the |
24 | * License, indicate your decision by deleting the provisions above and |
25 | * replace them with the notice and other provisions required by the GPL. |
26 | * If you do not delete the provisions above, a recipient may use your |
27 | * version of this file under either the License or the GPL. |
28 | */ |
29 | |
30 | /* |
31 | * tclcache.c -- |
32 | * |
33 | * Tcl API for cache.c. Based on work from the nscache module. |
34 | */ |
35 | |
36 | static const char *RCSID = "@(#) $Header: /cvsroot-fuse/aolserver/aolserver/nsd/tclcache.c,v 1.6 2014/07/08 02:07:38 dvrsn Exp $, compiled: " __DATE__ " " __TIME__; |
37 | |
38 | #include "nsd.h" |
39 | |
40 | /* |
41 | * The following structure maintains a Tcl cache including an underlying size-based |
42 | * Ns_Cache and options for a max time to live (default: infiniate) and timeout |
43 | * for threads waiting on other threads to update a value (default: 2 seconds). |
44 | */ |
45 | |
46 | typedef struct TclCache { |
47 | Ns_Cache *cache; |
48 | char *name; |
49 | int namelen; |
50 | Ns_Time atime; |
51 | Ns_Time wait; |
52 | Ns_Time ttl; |
53 | int expires; |
54 | } TclCache; |
55 | |
56 | /* |
57 | * The following structure defines a value stored in the cache which is string |
58 | * with optional expiration time. Values will store any string of bytes from |
59 | * the corresponding Tcl_Obj but no type information will be preserved. |
60 | */ |
61 | |
62 | typedef struct Val { |
63 | Ns_Time expires; |
64 | int length; |
65 | char string[1]; |
66 | } Val; |
67 | |
68 | static int <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_CreateCacheObjCmd">CreateCacheObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, |
69 | Tcl_Obj **objv); |
70 | static int <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_SetResult">SetResult</a>(Tcl_Interp *interp, Val *valPtr, char *varName); |
71 | static Val *<a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_NewVal">NewVal</a>(TclCache *cachePtr, Tcl_Obj *objPtr, Ns_Time *nowPtr); |
72 | static int <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_Expired">Expired</a>(TclCache *cachePtr, Val *valPtr, Ns_Time *nowPtr); |
73 | static int <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_SetCacheFromAny">SetCacheFromAny</a>(Tcl_Interp *interp, Tcl_Obj *objPtr); |
74 | static void <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_UpdateStringOfCache">UpdateStringOfCache</a>(Tcl_Obj *objPtr); |
75 | |
76 | /* |
77 | * The following structure defines a Tcl type for caches which maintains a pointer |
78 | * the the cooresponding TclCache structure. |
79 | */ |
80 | |
81 | static Tcl_ObjType cacheType = { |
82 | "ns:cache", |
83 | (Tcl_FreeInternalRepProc *) NULL, |
84 | (Tcl_DupInternalRepProc *) NULL, |
85 | <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_UpdateStringOfCache">UpdateStringOfCache</a>, |
86 | <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_SetCacheFromAny">SetCacheFromAny</a> |
87 | }; |
88 | |
89 | /* |
90 | * The following static variables are defined in this file. |
91 | */ |
92 | |
93 | static Tcl_HashTable caches; /* Table of all caches, process wide. */ |
94 | static Ns_Mutex lock; /* Lock around list table of caches. */ |
95 | |
96 | |
97 | /* |
98 | *---------------------------------------------------------------------- |
99 | * |
100 | * <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_NsTclInitCacheType">NsTclInitCacheType</a> -- |
101 | * |
102 | * Initialize the type for Tcl caches. |
103 | * |
104 | * Results: |
105 | * None. |
106 | * |
107 | * Side effects: |
108 | * None. |
109 | * |
110 | *---------------------------------------------------------------------- |
111 | */ |
112 | |
113 | void |
114 | <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_NsTclInitCacheType">NsTclInitCacheType</a>(void) |
115 | { |
116 | Ns_MutexSetName(&lock, "nstcl:caches"); |
117 | Tcl_InitHashTable(&caches, TCL_STRING_KEYS); |
118 | Tcl_RegisterObjType(&cacheType); |
119 | } |
120 | |
121 | |
122 | /* |
123 | *---------------------------------------------------------------------- |
124 | * |
125 | * <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_NsTclCacheObjCmd">NsTclCacheObjCmd</a> -- |
126 | * |
127 | * Handle the ns_cache command. See the documentation for details. |
128 | * Note that mixing the "eval" option with other options (e.g., |
129 | * "get", "set", "incr", etc.) doesn't make sense. In particular, |
130 | * there's no generally correct way to handle a "get" or "set" |
131 | * encountering an in-progress "eval", i.e., a NULL value. In these |
132 | * case the code below returns an immediate error. |
133 | * |
134 | * Results: |
135 | * Standard Tcl result. |
136 | * |
137 | * Side effects: |
138 | * May cause the current thread to wait for another thread to |
139 | * update a given entry with the eval option. |
140 | * |
141 | *---------------------------------------------------------------------- |
142 | */ |
143 | |
144 | int |
145 | <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_NsTclCacheObjCmd">NsTclCacheObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj **objv) |
146 | { |
147 | static CONST char *opts[] = { |
148 | "create", "names", "eval", "set", "get", "incr", |
149 | "append", "lappend", "flush", NULL |
150 | }; |
151 | enum { |
152 | CCreateIdx, CNamesIdx, CEvalIdx, CSetIdx, CGetIdx, CIncrIdx, |
153 | CAppendIdx, CLappendIdx, CFlushIdx |
154 | } opt; |
155 | TclCache *cachePtr; |
156 | Val *valPtr; |
157 | int i, cur, err, new, status; |
158 | char *key, *pattern, *var; |
159 | Ns_Entry *entry; |
160 | Ns_CacheSearch search; |
161 | Tcl_Obj *objPtr = NULL; |
162 | Ns_Time now, timeout; |
163 | |
164 | if (objc < 2) { |
165 | Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); |
166 | return TCL_ERROR; |
167 | } |
168 | if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0, |
169 | (int *) &opt) != TCL_OK) { |
170 | return TCL_ERROR; |
171 | } |
172 | |
173 | /* |
174 | * Handle create directly as all other commands require a valid |
175 | * cache argument. |
176 | */ |
177 | |
178 | if (opt == CCreateIdx) { |
179 | return <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_CreateCacheObjCmd">CreateCacheObjCmd</a>(arg, interp, objc, objv); |
180 | } |
181 | |
182 | if (objc < 3) { |
183 | Tcl_WrongNumArgs(interp, 2, objv, "cache ?args ...?"); |
184 | return TCL_ERROR; |
185 | } |
186 | if (Tcl_ConvertToType(interp, objv[2], &cacheType) != TCL_OK) { |
187 | return TCL_ERROR; |
188 | } |
189 | cachePtr = objv[2]->internalRep.otherValuePtr; |
190 | |
191 | Ns_GetTime(&now); |
192 | err = 0; |
193 | switch (opt) { |
194 | case CCreateIdx: |
195 | /* NB: Silence compiler warning. */ |
196 | break; |
197 | |
198 | case CNamesIdx: |
199 | /* |
200 | * Return keys for all cache entries, flushing any expired items first. |
201 | */ |
202 | |
203 | if (objc < 4) { |
204 | pattern = NULL; |
205 | } else { |
206 | pattern = Tcl_GetString(objv[3]); |
207 | } |
208 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheLock">Ns_CacheLock</a>(cachePtr->cache); |
209 | entry = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheFirstEntry">Ns_CacheFirstEntry</a>(cachePtr->cache, &search); |
210 | while (entry != NULL) { |
211 | key = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheKey">Ns_CacheKey</a>(entry); |
212 | valPtr = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheGetValue">Ns_CacheGetValue</a>(entry); |
213 | if (valPtr != NULL) { |
214 | if (<a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_Expired">Expired</a>(cachePtr, valPtr, &now)) { |
215 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheFlushEntry">Ns_CacheFlushEntry</a>(entry); |
216 | } else if (pattern == NULL || Tcl_StringMatch(key, pattern)) { |
217 | Tcl_AppendElement(interp, key); |
218 | } |
219 | } |
220 | entry = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheNextEntry">Ns_CacheNextEntry</a>(&search); |
221 | } |
222 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheUnlock">Ns_CacheUnlock</a>(cachePtr->cache); |
223 | break; |
224 | |
225 | case CFlushIdx: |
226 | /* |
227 | * Flush one or more entries from the cache. |
228 | */ |
229 | |
230 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheLock">Ns_CacheLock</a>(cachePtr->cache); |
231 | for (i = 3; i < objc; ++i) { |
232 | key = Tcl_GetString(objv[i]); |
233 | entry = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheFindEntry">Ns_CacheFindEntry</a>(cachePtr->cache, key); |
234 | if (entry != NULL && (valPtr = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheGetValue">Ns_CacheGetValue</a>(entry)) != NULL) { |
235 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheFlushEntry">Ns_CacheFlushEntry</a>(entry); |
236 | } |
237 | } |
238 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheUnlock">Ns_CacheUnlock</a>(cachePtr->cache); |
239 | break; |
240 | |
241 | case CGetIdx: |
242 | /* |
243 | * Get the current value if not expired and not currently being refreshed. |
244 | */ |
245 | |
246 | if (objc != 4 && objc != 5) { |
247 | Tcl_WrongNumArgs(interp, 3, objv, "key ?valueVar?"); |
248 | return TCL_ERROR; |
249 | } |
250 | valPtr = NULL; |
251 | key = Tcl_GetString(objv[3]); |
252 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheLock">Ns_CacheLock</a>(cachePtr->cache); |
253 | entry = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheFindEntry">Ns_CacheFindEntry</a>(cachePtr->cache, key); |
254 | if (entry != NULL |
255 | && (valPtr = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheGetValue">Ns_CacheGetValue</a>(entry)) != NULL |
256 | && <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_Expired">Expired</a>(cachePtr, valPtr, &now)) { |
257 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheFlushEntry">Ns_CacheFlushEntry</a>(entry); |
258 | valPtr = NULL; |
259 | } |
260 | if (valPtr != NULL) { |
261 | var = (objc < 5 ? NULL : Tcl_GetString(objv[4])); |
262 | err = <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_SetResult">SetResult</a>(interp, valPtr, var); |
263 | } |
264 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheUnlock">Ns_CacheUnlock</a>(cachePtr->cache); |
265 | if (err) { |
266 | return TCL_ERROR; |
267 | } else if (objc == 5) { |
268 | Tcl_SetBooleanObj(Tcl_GetObjResult(interp), valPtr ? 1 : 0); |
269 | } else if (valPtr == NULL) { |
270 | Tcl_AppendResult(interp, "no such entry: ", key, NULL); |
271 | return TCL_ERROR; |
272 | } |
273 | break; |
274 | |
275 | case CSetIdx: |
276 | /* |
277 | * Set a value, ignoring current state (if any) of the entry. |
278 | */ |
279 | |
280 | if (objc != 5) { |
281 | Tcl_WrongNumArgs(interp, 3, objv, "key value"); |
282 | return TCL_ERROR; |
283 | } |
284 | valPtr = <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_NewVal">NewVal</a>(cachePtr, objv[4], &now); |
285 | key = Tcl_GetString(objv[3]); |
286 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheLock">Ns_CacheLock</a>(cachePtr->cache); |
287 | entry = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheCreateEntry">Ns_CacheCreateEntry</a>(cachePtr->cache, key, &new); |
288 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheSetValueSz">Ns_CacheSetValueSz</a>(entry, valPtr, valPtr->length); |
289 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheUnlock">Ns_CacheUnlock</a>(cachePtr->cache); |
290 | Tcl_SetObjResult(interp, objv[4]); |
291 | break; |
292 | |
293 | case CIncrIdx: |
294 | /* |
295 | * Increment a value, assuming the previous value is a valid integer. |
296 | * No value or expired value is treated as starting at zero. |
297 | */ |
298 | |
299 | if (objc != 4 && objc != 5) { |
300 | Tcl_WrongNumArgs(interp, 3, objv, "key ?incr?"); |
301 | return TCL_ERROR; |
302 | } |
303 | if (objc < 5) { |
304 | i = 1; |
305 | } else if (Tcl_GetIntFromObj(interp, objv[4], &i) != TCL_OK) { |
306 | return TCL_ERROR; |
307 | } |
308 | err = 0; |
309 | key = Tcl_GetString(objv[3]); |
310 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheLock">Ns_CacheLock</a>(cachePtr->cache); |
311 | entry = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheCreateEntry">Ns_CacheCreateEntry</a>(cachePtr->cache, key, &new); |
312 | if (!new |
313 | && (valPtr = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheGetValue">Ns_CacheGetValue</a>(entry)) != NULL |
314 | && <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_Expired">Expired</a>(cachePtr, valPtr, &now)) { |
315 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheUnsetValue">Ns_CacheUnsetValue</a>(entry); |
316 | new = 1; |
317 | } |
318 | if (new) { |
319 | cur = 0; |
320 | } else if (valPtr == NULL) { |
321 | Tcl_AppendResult(interp, "entry busy: ", key, NULL); |
322 | err = 1; |
323 | } else if (Tcl_GetInt(interp, valPtr->string, &cur) != TCL_OK) { |
324 | err = 1; |
325 | } |
326 | if (!err) { |
327 | objPtr = Tcl_NewIntObj(cur + i); |
328 | valPtr = <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_NewVal">NewVal</a>(cachePtr, objPtr, &now); |
329 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheSetValueSz">Ns_CacheSetValueSz</a>(entry, valPtr, valPtr->length); |
330 | } |
331 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheUnlock">Ns_CacheUnlock</a>(cachePtr->cache); |
332 | if (err) { |
333 | return TCL_ERROR; |
334 | } |
335 | Tcl_SetObjResult(interp, objPtr); |
336 | break; |
337 | |
338 | case CAppendIdx: |
339 | case CLappendIdx: |
340 | /* |
341 | * Append or list append one or more elements to current value. |
342 | */ |
343 | |
344 | if (objc < 5) { |
345 | Tcl_WrongNumArgs(interp, 3, objv, "key str ?str ...?"); |
346 | return TCL_ERROR; |
347 | } |
348 | err = 0; |
349 | key = Tcl_GetString(objv[3]); |
350 | objPtr = Tcl_NewObj(); |
351 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheLock">Ns_CacheLock</a>(cachePtr->cache); |
352 | entry = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheCreateEntry">Ns_CacheCreateEntry</a>(cachePtr->cache, key, &new); |
353 | if (!new) { |
354 | valPtr = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheGetValue">Ns_CacheGetValue</a>(entry); |
355 | if (valPtr == NULL) { |
356 | Tcl_AppendResult(interp, "entry busy: ", key, NULL); |
357 | err = 1; |
358 | } else if (!<a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_Expired">Expired</a>(cachePtr, valPtr, &now)) { |
359 | Tcl_AppendToObj(objPtr, valPtr->string, valPtr->length); |
360 | } |
361 | } |
362 | for (i = 4; !err && i < objc; ++i) { |
363 | if (opt == CAppendIdx) { |
364 | Tcl_AppendObjToObj(objPtr, objv[i]); |
365 | } else if (Tcl_ListObjAppendElement(interp, objPtr, objv[i]) |
366 | != TCL_OK) { |
367 | err = 1; |
368 | } |
369 | } |
370 | if (!err) { |
371 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheUnsetValue">Ns_CacheUnsetValue</a>(entry); |
372 | valPtr = <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_NewVal">NewVal</a>(cachePtr, objPtr, &now); |
373 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheSetValueSz">Ns_CacheSetValueSz</a>(entry, valPtr, valPtr->length); |
374 | } |
375 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheUnlock">Ns_CacheUnlock</a>(cachePtr->cache); |
376 | if (err) { |
377 | return TCL_ERROR; |
378 | } |
379 | Tcl_SetObjResult(interp, objPtr); |
380 | break; |
381 | |
382 | case CEvalIdx: |
383 | /* |
384 | * Get a value from cache, setting or refreshing the value with |
385 | * given script when necessary. A NULL value is maintained in the |
386 | * cache during the update script to avoid multiple threads updating |
387 | * the same value at once. |
388 | */ |
389 | |
390 | if (objc != 5) { |
391 | Tcl_WrongNumArgs(interp, 3, objv, "key script"); |
392 | return TCL_ERROR; |
393 | } |
394 | status = TCL_OK; |
395 | key = Tcl_GetString(objv[3]); |
396 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheLock">Ns_CacheLock</a>(cachePtr->cache); |
397 | entry = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheCreateEntry">Ns_CacheCreateEntry</a>(cachePtr->cache, key, &new); |
398 | if (!new && (valPtr = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheGetValue">Ns_CacheGetValue</a>(entry)) == NULL) { |
399 | /* |
400 | * Wait for another thread to complete an update. |
401 | */ |
402 | |
403 | status = NS_OK; |
404 | timeout = now; |
405 | Ns_IncrTime(&timeout, cachePtr->wait.sec, cachePtr->wait.usec); |
406 | do { |
407 | status = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheTimedWait">Ns_CacheTimedWait</a>(cachePtr->cache, &timeout); |
408 | } while (status == NS_OK |
409 | && (entry = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheFindEntry">Ns_CacheFindEntry</a>(cachePtr->cache, key)) != NULL |
410 | && (valPtr = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheGetValue">Ns_CacheGetValue</a>(entry)) == NULL); |
411 | if (entry == NULL) { |
412 | Tcl_AppendResult(interp, "update failed: ", key, NULL); |
413 | err = 1; |
414 | } else if (valPtr == NULL) { |
415 | Tcl_AppendResult(interp, "timeout waiting for update: ", key, NULL); |
416 | err = 1; |
417 | } else { |
418 | Ns_GetTime(&now); |
419 | } |
420 | } |
421 | if (!err) { |
422 | if (!new && <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_Expired">Expired</a>(cachePtr, valPtr, &now)) { |
423 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheUnsetValue">Ns_CacheUnsetValue</a>(entry); |
424 | new = 1; |
425 | } |
426 | if (!new) { |
427 | /* |
428 | * Return current value. |
429 | */ |
430 | |
431 | valPtr = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheGetValue">Ns_CacheGetValue</a>(entry); |
432 | err = <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_SetResult">SetResult</a>(interp, valPtr, NULL); |
433 | } else { |
434 | /* |
435 | * Refresh the entry. |
436 | */ |
437 | |
438 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheUnlock">Ns_CacheUnlock</a>(cachePtr->cache); |
439 | status = Tcl_EvalObjEx(interp, objv[4], 0); |
440 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheLock">Ns_CacheLock</a>(cachePtr->cache); |
441 | entry = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheCreateEntry">Ns_CacheCreateEntry</a>(cachePtr->cache, key, &new); |
442 | |
443 | if (status == TCL_OK || status == TCL_RETURN) { |
444 | objPtr = Tcl_GetObjResult(interp); |
445 | valPtr = <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_NewVal">NewVal</a>(cachePtr, objPtr, &now); |
446 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheSetValueSz">Ns_CacheSetValueSz</a>(entry, valPtr, valPtr->length); |
447 | |
448 | if (status == TCL_RETURN) { |
449 | status = TCL_OK; |
450 | } |
451 | } else { |
452 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheFlushEntry">Ns_CacheFlushEntry</a>(entry); |
453 | } |
454 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheBroadcast">Ns_CacheBroadcast</a>(cachePtr->cache); |
455 | } |
456 | } |
457 | <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheUnlock">Ns_CacheUnlock</a>(cachePtr->cache); |
458 | if (err) { |
459 | return TCL_ERROR; |
460 | } |
461 | |
462 | return status; |
463 | break; |
464 | } |
465 | return TCL_OK; |
466 | } |
467 | |
468 | |
469 | /* |
470 | *---------------------------------------------------------------------- |
471 | * |
472 | * <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_CreateCacheObjCmd">CreateCacheObjCmd</a> -- |
473 | * |
474 | * Sub-command to create a new cache. |
475 | * |
476 | * Results: |
477 | * Standard Tcl result. |
478 | * |
479 | * Side effects: |
480 | * None. |
481 | * |
482 | *---------------------------------------------------------------------- |
483 | */ |
484 | |
485 | static int |
486 | <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_CreateCacheObjCmd">CreateCacheObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj **objv) |
487 | { |
488 | int i, new, size, expires; |
489 | Ns_Time ttl, wait; |
490 | Tcl_HashEntry *hPtr; |
491 | TclCache *cachePtr; |
492 | char *cache; |
493 | static CONST char *flags[] = { |
494 | "-timeout", "-size", "-thread", "-server", "-maxwait", NULL |
495 | }; |
496 | enum { |
497 | FTimeoutIdx, FSizeIdx, FThreadIdx, FServerIdx, FWaitIdx |
498 | } flag; |
499 | |
500 | if (objc < 3 || !(objc & 1)) { |
501 | Tcl_WrongNumArgs(interp, 2, objv, "?-flag val -flag val...?"); |
502 | return TCL_ERROR; |
503 | } |
504 | cache = Tcl_GetString(objv[2]); |
505 | wait.sec = 2; |
506 | ttl.sec = 60; |
507 | wait.usec = ttl.usec = 0; |
508 | expires = 0; |
509 | size = 1024 * 1000; |
510 | for (i = 3; i < objc; i += 2) { |
511 | if (Tcl_GetIndexFromObj(interp, objv[i], flags, "flag", 0, |
512 | (int *) &flag) != TCL_OK) { |
513 | return TCL_ERROR; |
514 | } |
515 | switch (flag) { |
516 | case FSizeIdx: |
517 | if (Tcl_GetIntFromObj(interp, objv[i+1], &size) != TCL_OK) { |
518 | return TCL_ERROR; |
519 | } |
520 | if (size < 0) { |
521 | Tcl_AppendResult(interp, "invalid size: ", |
522 | Tcl_GetString(objv[i+1]), NULL); |
523 | return TCL_ERROR; |
524 | } |
525 | break; |
526 | |
527 | case FTimeoutIdx: |
528 | if (<a href="/cvs/aolserver/aolserver/nsd/tclobj.c#A_Ns_TclGetTimeFromObj">Ns_TclGetTimeFromObj</a>(interp, objv[i+1], &ttl) != TCL_OK) { |
529 | return TCL_ERROR; |
530 | } |
531 | expires = 1; |
532 | break; |
533 | |
534 | case FWaitIdx: |
535 | if (<a href="/cvs/aolserver/aolserver/nsd/tclobj.c#A_Ns_TclGetTimeFromObj">Ns_TclGetTimeFromObj</a>(interp, objv[i+1], &wait) != TCL_OK) { |
536 | return TCL_ERROR; |
537 | } |
538 | break; |
539 | |
540 | case FThreadIdx: |
541 | case FServerIdx: |
542 | /* NB: Previous nscache options currently ignored. */ |
543 | break; |
544 | } |
545 | } |
546 | Ns_MutexLock(&lock); |
547 | hPtr = Tcl_CreateHashEntry(&caches, cache, &new); |
548 | if (new) { |
549 | cachePtr = ns_malloc(sizeof(TclCache)); |
550 | cachePtr->name = Tcl_GetHashKey(&caches, hPtr); |
551 | cachePtr->namelen = strlen(cachePtr->name); |
552 | cachePtr->ttl = ttl; |
553 | cachePtr->wait = wait; |
554 | cachePtr->expires = expires; |
555 | cachePtr->cache = <a href="/cvs/aolserver/aolserver/nsd/cache.c#A_Ns_CacheCreateSz">Ns_CacheCreateSz</a>(cache, TCL_STRING_KEYS, |
556 | (size_t) size, ns_free); |
557 | Tcl_SetHashValue(hPtr, cachePtr); |
558 | } |
559 | Ns_MutexUnlock(&lock); |
560 | if (!new) { |
561 | Tcl_AppendResult(interp, "cache already exists: ", cache, NULL); |
562 | return TCL_ERROR; |
563 | } |
564 | return TCL_OK; |
565 | } |
566 | |
567 | |
568 | /* |
569 | *---------------------------------------------------------------------- |
570 | * |
571 | * <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_Expired">Expired</a> -- |
572 | * |
573 | * Check if a given value has expired. |
574 | * |
575 | * Results: |
576 | * 0 if still valid, 1 if expired. |
577 | * |
578 | * Side effects: |
579 | * None. |
580 | * |
581 | *---------------------------------------------------------------------- |
582 | */ |
583 | |
584 | static int |
585 | <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_Expired">Expired</a>(TclCache *cachePtr, Val *valPtr, Ns_Time *nowPtr) |
586 | { |
587 | if (cachePtr->expires && Ns_DiffTime(&valPtr->expires, nowPtr, NULL) < 0) { |
588 | return 1; |
589 | } |
590 | return 0; |
591 | } |
592 | |
593 | |
594 | /* |
595 | *---------------------------------------------------------------------- |
596 | * |
597 | * <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_NewVal">NewVal</a> -- |
598 | * |
599 | * Allocate a new Val object from the given Tcl_Obj. |
600 | * |
601 | * Results: |
602 | * Pointer to new Val. |
603 | * |
604 | * Side effects: |
605 | * None. |
606 | * |
607 | *---------------------------------------------------------------------- |
608 | */ |
609 | |
610 | static Val * |
611 | <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_NewVal">NewVal</a>(TclCache *cachePtr, Tcl_Obj *objPtr, Ns_Time *nowPtr) |
612 | { |
613 | Val *valPtr; |
614 | char *str; |
615 | int len; |
616 | |
617 | str = Tcl_GetStringFromObj(objPtr, &len); |
618 | valPtr = ns_malloc(sizeof(Val) + len); |
619 | valPtr->length = len; |
620 | memcpy(valPtr->string, str, len); |
621 | valPtr->string[len] = '\0'; |
622 | if (cachePtr->expires) { |
623 | valPtr->expires = *nowPtr; |
624 | Ns_IncrTime(&valPtr->expires, cachePtr->ttl.sec, cachePtr->ttl.usec); |
625 | } |
626 | return valPtr; |
627 | } |
628 | |
629 | |
630 | /* |
631 | *---------------------------------------------------------------------- |
632 | * |
633 | * <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_SetResult">SetResult</a> -- |
634 | * |
635 | * Set a Val as the current Tcl result. |
636 | * |
637 | * Results: |
638 | * None. |
639 | * |
640 | * Side effects: |
641 | * None. |
642 | * |
643 | *---------------------------------------------------------------------- |
644 | */ |
645 | |
646 | static int |
647 | <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_SetResult">SetResult</a>(Tcl_Interp *interp, Val *valPtr, char *varName) |
648 | { |
649 | Tcl_Obj *objPtr; |
650 | int err = 0; |
651 | |
652 | objPtr = Tcl_NewStringObj(valPtr->string, valPtr->length); |
653 | Tcl_IncrRefCount(objPtr); |
654 | if (varName == NULL) { |
655 | Tcl_SetObjResult(interp, objPtr); |
656 | } else if (Tcl_SetVar2Ex(interp, varName, NULL, objPtr, TCL_LEAVE_ERR_MSG) == NULL) { |
657 | err = 1; |
658 | } |
659 | Tcl_DecrRefCount(objPtr); |
660 | return err; |
661 | } |
662 | |
663 | |
664 | /* |
665 | *---------------------------------------------------------------------- |
666 | * |
667 | * <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_UpdateStringOfCache">UpdateStringOfCache</a> -- |
668 | * |
669 | * Callback to set the string of a TclCache Tcl_Obj. |
670 | * |
671 | * Results: |
672 | * None. |
673 | * |
674 | * Side effects: |
675 | * Will update Tcl_Obj's bytes and length. |
676 | * |
677 | *---------------------------------------------------------------------- |
678 | */ |
679 | |
680 | static void |
681 | <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_UpdateStringOfCache">UpdateStringOfCache</a>(Tcl_Obj *objPtr) |
682 | { |
683 | TclCache *cachePtr = (TclCache *) objPtr->internalRep.otherValuePtr; |
684 | |
685 | objPtr->length = cachePtr->namelen; |
686 | objPtr->bytes = ckalloc(objPtr->length + 1); |
687 | strcpy(objPtr->bytes, cachePtr->name); |
688 | } |
689 | |
690 | |
691 | /* |
692 | *---------------------------------------------------------------------- |
693 | * |
694 | * <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_SetCacheFromAny">SetCacheFromAny</a> -- |
695 | * |
696 | * Set a Tcl_Obj internal rep to be a pointer to the TclCache |
697 | * looked up by string name. |
698 | * |
699 | * Results: |
700 | * TCL_OK if valid cache, TCL_ERROR otherwise. |
701 | * |
702 | * Side effects: |
703 | * Will leave an error message in given Tcl_Interp. |
704 | * |
705 | *---------------------------------------------------------------------- |
706 | */ |
707 | |
708 | static int |
709 | <a href="/cvs/aolserver/aolserver/nsd/tclcache.c#A_SetCacheFromAny">SetCacheFromAny</a>(Tcl_Interp *interp, Tcl_Obj *objPtr) |
710 | { |
711 | Tcl_ObjType *typePtr = objPtr->typePtr; |
712 | TclCache *cachePtr; |
713 | Tcl_HashEntry *hPtr; |
714 | char *cache; |
715 | |
716 | cache = Tcl_GetString(objPtr); |
717 | Ns_MutexLock(&lock); |
718 | hPtr = Tcl_FindHashEntry(&caches, cache); |
719 | if (hPtr != NULL) { |
720 | cachePtr = Tcl_GetHashValue(hPtr); |
721 | } |
722 | Ns_MutexUnlock(&lock); |
723 | if (hPtr == NULL) { |
724 | Tcl_AppendResult(interp, "no such cache: ", cache, NULL); |
725 | return TCL_ERROR; |
726 | } |
727 | if (typePtr != NULL && typePtr->freeIntRepProc != NULL) { |
728 | (*typePtr->freeIntRepProc)(objPtr); |
729 | } |
730 | objPtr->typePtr = &cacheType; |
731 | objPtr->internalRep.otherValuePtr = cachePtr; |
732 | return TCL_OK; |
733 | } |
Copyright © 2010 Geeknet, Inc. All rights reserved. Terms of Use