[36719] trunk/base/src/pextlib1.0

[afb at macports.org]

Revision: 36719
          http://trac.macosforge.org/projects/macports/changeset/36719
Author:   afb at macports.org
Date:     2008-05-13 04:04:28 -0700 (Tue, 13 May 2008)

Log Message:
-----------
add unsetenv command, for working around bugs in Leopard tcl

Modified Paths:
--------------
    trunk/base/src/pextlib1.0/Pextlib.c

Added Paths:
-----------
    trunk/base/src/pextlib1.0/tests/unsetenv.tcl

Modified: trunk/base/src/pextlib1.0/Pextlib.c
===================================================================
--- trunk/base/src/pextlib1.0/Pextlib.c	2008-05-13 10:51:06 UTC (rev 36718)
+++ trunk/base/src/pextlib1.0/Pextlib.c	2008-05-13 11:04:28 UTC (rev 36719)
@@ -1118,6 +1118,52 @@
     return TCL_OK;
 }
 
+/**
+ * deletes environment variable
+ *
+ * Syntax is:
+ * unsetenv name (* for all)
+ */
+int UnsetEnvCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+    char *name;
+    char **envp;
+    char *equals;
+    size_t len;
+    
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "name");
+        return TCL_ERROR;
+    }
+
+    name = Tcl_GetString(objv[1]);
+    if (strchr(name, '=') != NULL) {
+        Tcl_SetResult(interp, "only the name should be given", TCL_STATIC);
+        return TCL_ERROR;
+    }
+
+    if (strcmp(name, "*") == 0) {
+        /* unset all current environment variables */
+        for (envp = environ; *envp != NULL; envp++) {
+            equals = strchr(*envp, '=');
+            if (equals != NULL) {
+                len = equals - *envp;
+                name = malloc(len+1);
+                if (name != NULL) {
+                    memcpy(name, *envp, len);
+                    name[len] = '\0';
+                    (void) unsetenv(name);
+                    free(name);
+                }
+            }
+        }
+    } else {
+        (void) unsetenv(name);
+    }
+
+    return TCL_OK;
+}
+
 int Pextlib_Init(Tcl_Interp *interp)
 {
 	if (Tcl_InitStubs(interp, "8.3", 0) == NULL)
@@ -1149,6 +1195,7 @@
 	Tcl_CreateObjCommand(interp, "pipe", PipeCmd, NULL, NULL);
 	Tcl_CreateObjCommand(interp, "curl", CurlCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "symlink", CreateSymlinkCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "unsetenv", UnsetEnvCmd, NULL, NULL);
 	
 	Tcl_CreateObjCommand(interp, "readline", ReadlineCmd, NULL, NULL);
 	Tcl_CreateObjCommand(interp, "rl_history", RLHistoryCmd, NULL, NULL);

Added: trunk/base/src/pextlib1.0/tests/unsetenv.tcl
===================================================================
--- trunk/base/src/pextlib1.0/tests/unsetenv.tcl	                        (rev 0)
+++ trunk/base/src/pextlib1.0/tests/unsetenv.tcl	2008-05-13 11:04:28 UTC (rev 36719)
@@ -0,0 +1,17 @@
+# Test file for Pextlib's unsetenv.
+# tclsh <Pextlib name>
+
+proc main {pextlibname} {
+    load $pextlibname
+    
+    global env
+    puts [array get env]
+    
+    array unset env *
+    puts [array get env]
+    
+    unsetenv *
+    puts [array get env]
+}
+
+main $argv

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.macosforge.org/pipermail/macports-changes/attachments/20080513/54ef1cda/attachment.html