generic/interface/EnvVarProc.c

/*
 *  Ascend Environment Variable Imitation Tcl interface
 *  by Ben Allan
 *  Created: 6/3/97
 *  Version: $Revision: 1.7 $
 *  Version control file: $RCSfile: EnvVarProc.c,v $
 *  Date last modified: $Date: 2003/08/23 18:43:06 $
 *  Last modified by: $Author: ballan $
 *
 *  This file is part of the Ascend Language Interpreter.
 *
 *  Copyright (C) 1997 Benjamin Andrew Allan
 *
 *  The Ascend Language Interpreter is free software; you can redistribute
 *  it and/or modify it under the terms of the GNU General Public License as
 *  published by the Free Software Foundation; either version 2 of the
 *  License, or (at your option) any later version.
 *
 *  The Ascend Language Interpreter is distributed in 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
 *  General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with the program; if not, write to the Free Software Foundation,
 *  Inc., 675 Mass Ave, Cambridge, MA 02139 USA.  Check the file named
 *  COPYING.
 *
 *  This file exists because win32, among others, can't keep their
 *  POSIX compliance up. In particular, getting and setting
 *  environment vars is exceedingly unreliable.
 *  This file implements a general way to store and fetch multiple
 *  paths.
 *  It does not interact in any way the the Tcl global "env" array.
 */

#include "tcl.h"
#include "utilities/ascConfig.h"
#include "utilities/ascMalloc.h"
#include "utilities/ascEnvVar.h"
#include "interface/HelpProc.h"
#include "interface/EnvVarProc.h"

#ifndef lint
CONST char *EnvVarProcID = "$Id: EnvVarProc.c,v 1.7 2003/08/23 18:43:06 ballan Exp $";
#endif

STDHLF(Asc_EnvVarCmd,(Asc_EnvVarCmdHL1, Asc_EnvVarCmdHL2,
  Asc_EnvVarCmdHL3, Asc_EnvVarCmdHL4, Asc_EnvVarCmdHL5, Asc_EnvVarCmdHL6,
  Asc_EnvVarCmdHL7, Asc_EnvVarCmdHL8, Asc_EnvVarCmdHL9, Asc_EnvVarCmdHL10,
  HLFSTOP));

int Asc_EnvVarCmd(ClientData cdata, Tcl_Interp *interp,
                  int argc, CONST84 char *argv[])
{
  char **envargv;
  char *path;
  int envargc;
  int c;

  ASCUSE;
  if (argc <2) {
    Asc_HelpGetUsage(interp,argv[0]);
    return TCL_ERROR;
  }
  switch (argv[1][0]) {
  case 'a':
    /*
     *  append  varname pathelement
     */
    if (argc != 4) {
      Tcl_AppendResult(interp,"wrong number of args : ",
        argv[0]," append var pathelement",
        (char *)NULL);
      return TCL_ERROR;
    }
    if (Asc_AppendPath(QUIET(argv[2]),QUIET(argv[3]))!=0) {
      Tcl_AppendResult(interp,"error appending var ",argv[2]," with ",argv[4],
        (char *)NULL);
      return TCL_ERROR;
    }
    break;
  case 'e':
    /*  export  var
     */
    if (argc != 3) {
      Tcl_AppendResult(interp,"wrong number of args : ",
        argv[0]," export var",
        (char *)NULL);
      return TCL_ERROR;
    }
    path = Asc_GetEnv(QUIET(argv[2]));
    if (path !=NULL) {
      Tcl_SetVar2(interp,"env",argv[2],path,TCL_GLOBAL_ONLY);
      ascfree(path);
    } else {
      Tcl_AppendResult(interp,"export ascend environment var not found : ",
        argv[0],argv[1],argv[2],
        (char *)NULL);
      return TCL_ERROR;
    }
    break;
  case 'g':
    /*  get     var
     */
    if (argc != 3) {
      Tcl_AppendResult(interp,"wrong number of args : ",
        argv[0]," get var",
        (char *)NULL);
      return TCL_ERROR;
    }
    path = Asc_GetEnv(QUIET(argv[2]));
    if (path == NULL) {
      Tcl_AppendResult(interp,"ascend environment var not found : ",
        argv[0],argv[1],argv[2],
        (char *)NULL);
      return TCL_ERROR;
    }
    Tcl_AppendResult(interp,path, (char *)NULL);
    ascfree(path);
    break;
  case 'i':
/*  import  var
 */
    if (argc != 3) {
      Tcl_AppendResult(interp,"wrong number of args : ",
        argv[0]," import var",
        (char *)NULL);
      return TCL_ERROR;
    }
    if (Asc_ImportPathList(argv[2])!=0) {
      Tcl_AppendResult(interp,"C environment var not found : ",
        argv[0],argv[1],argv[2],
        (char *)NULL);
      return TCL_ERROR;
    }
    break;
  case 'l':
    /*  list    var
     */
    if (argc != 3) {
      Tcl_AppendResult(interp,"wrong number of args : ",
        argv[0]," list var",
        (char *)NULL);
      return TCL_ERROR;
    }
    envargv = Asc_GetPathList(QUIET(argv[2]),&envargc);
    if (envargv==NULL || envargc <1) {
      Tcl_AppendResult(interp,"ascend environment var not found : ",
        argv[0],argv[1],argv[2],
        (char *)NULL);
      return TCL_ERROR;
    }
    for (c = 0; c < envargc; c++) {
      Tcl_AppendElement(interp,envargv[c]);
    }
    ascfree(envargv);
    break;
  case 'n':
    /*  names   
     */
    if (argc != 2) {
      Tcl_AppendResult(interp,"wrong number of args : ",
        argv[0]," names",
        (char *)NULL);
      return TCL_ERROR;
    }
    envargv = Asc_EnvNames(&envargc);
    if (envargv==NULL || envargc <1) {
      Tcl_AppendElement(interp,"");
    } else {
      for (c = 0; c < envargc; c++) {
        Tcl_AppendElement(interp,envargv[c]);
      }
      ascfree(envargv);
    }
    break;
  case 'p':
    /*  put input_string
     */
    if (argc != 3) {
      Tcl_AppendResult(interp,"wrong number of args : ",
        argv[0]," put putenv_string",
        (char *)NULL);
      return TCL_ERROR;
    }
    if (Asc_PutEnv(QUIET(argv[2]))!=0) {
      Tcl_AppendResult(interp,"error in processing: ",
        argv[0],argv[1],argv[2],
        (char *)NULL);
      return TCL_ERROR;
    }
    break;
  case 's':
    /*  set var path 
     */
    if (argc != 4) {
      Tcl_AppendResult(interp,"wrong number of args : ",
        argv[0]," set var path",
        (char *)NULL);
      return TCL_ERROR;
    }
    if (Asc_SetPathList(argv[2],argv[3])!=0) {
      Tcl_AppendResult(interp,"error in processing: ",
        argv[0],argv[1],argv[2], argv[3],
        (char *)NULL);
      return TCL_ERROR;
    }
    break;
  default:
    Asc_HelpGetUsage(interp,argv[0]);
    return TCL_ERROR;
  }
  return TCL_OK;
}
1	aw0a	1	/*
2			* Ascend Environment Variable Imitation Tcl interface
3			* by Ben Allan
4			* Created: 6/3/97
5			* Version: $Revision: 1.7 $
6			* Version control file: $RCSfile: EnvVarProc.c,v $
7			* Date last modified: $Date: 2003/08/23 18:43:06 $
8			* Last modified by: $Author: ballan $
9			*
10			* This file is part of the Ascend Language Interpreter.
11			*
12			* Copyright (C) 1997 Benjamin Andrew Allan
13			*
14			* The Ascend Language Interpreter is free software; you can redistribute
15			* it and/or modify it under the terms of the GNU General Public License as
16			* published by the Free Software Foundation; either version 2 of the
17			* License, or (at your option) any later version.
18			*
19			* The Ascend Language Interpreter is distributed in hope that it will be
20			* useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
21			* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22			* General Public License for more details.
23			*
24			* You should have received a copy of the GNU General Public License
25			* along with the program; if not, write to the Free Software Foundation,
26			* Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
27			* COPYING.
28			*
29			* This file exists because win32, among others, can't keep their
30			* POSIX compliance up. In particular, getting and setting
31			* environment vars is exceedingly unreliable.
32			* This file implements a general way to store and fetch multiple
33			* paths.
34			* It does not interact in any way the the Tcl global "env" array.
35			*/
36
37			#include "tcl.h"
38			#include "utilities/ascConfig.h"
39			#include "utilities/ascMalloc.h"
40			#include "utilities/ascEnvVar.h"
41			#include "interface/HelpProc.h"
42			#include "interface/EnvVarProc.h"
43
44			#ifndef lint
45			CONST char *EnvVarProcID = "$Id: EnvVarProc.c,v 1.7 2003/08/23 18:43:06 ballan Exp $";
46			#endif
47
48			STDHLF(Asc_EnvVarCmd,(Asc_EnvVarCmdHL1, Asc_EnvVarCmdHL2,
49			Asc_EnvVarCmdHL3, Asc_EnvVarCmdHL4, Asc_EnvVarCmdHL5, Asc_EnvVarCmdHL6,
50			Asc_EnvVarCmdHL7, Asc_EnvVarCmdHL8, Asc_EnvVarCmdHL9, Asc_EnvVarCmdHL10,
51			HLFSTOP));
52
53			int Asc_EnvVarCmd(ClientData cdata, Tcl_Interp *interp,
54			int argc, CONST84 char *argv[])
55			{
56			char **envargv;
57			char *path;
58			int envargc;
59			int c;
60
61			ASCUSE;
62			if (argc <2) {
63			Asc_HelpGetUsage(interp,argv[0]);
64			return TCL_ERROR;
65			}
66			switch (argv[1][0]) {
67			case 'a':
68			/*
69			* append varname pathelement
70			*/
71			if (argc != 4) {
72			Tcl_AppendResult(interp,"wrong number of args : ",
73			argv[0]," append var pathelement",
74			(char *)NULL);
75			return TCL_ERROR;
76			}
77			if (Asc_AppendPath(QUIET(argv[2]),QUIET(argv[3]))!=0) {
78			Tcl_AppendResult(interp,"error appending var ",argv[2]," with ",argv[4],
79			(char *)NULL);
80			return TCL_ERROR;
81			}
82			break;
83			case 'e':
84			/* export var
85			*/
86			if (argc != 3) {
87			Tcl_AppendResult(interp,"wrong number of args : ",
88			argv[0]," export var",
89			(char *)NULL);
90			return TCL_ERROR;
91			}
92			path = Asc_GetEnv(QUIET(argv[2]));
93			if (path !=NULL) {
94			Tcl_SetVar2(interp,"env",argv[2],path,TCL_GLOBAL_ONLY);
95			ascfree(path);
96			} else {
97			Tcl_AppendResult(interp,"export ascend environment var not found : ",
98			argv[0],argv[1],argv[2],
99			(char *)NULL);
100			return TCL_ERROR;
101			}
102			break;
103			case 'g':
104			/* get var
105			*/
106			if (argc != 3) {
107			Tcl_AppendResult(interp,"wrong number of args : ",
108			argv[0]," get var",
109			(char *)NULL);
110			return TCL_ERROR;
111			}
112			path = Asc_GetEnv(QUIET(argv[2]));
113			if (path == NULL) {
114			Tcl_AppendResult(interp,"ascend environment var not found : ",
115			argv[0],argv[1],argv[2],
116			(char *)NULL);
117			return TCL_ERROR;
118			}
119			Tcl_AppendResult(interp,path, (char *)NULL);
120			ascfree(path);
121			break;
122			case 'i':
123			/* import var
124			*/
125			if (argc != 3) {
126			Tcl_AppendResult(interp,"wrong number of args : ",
127			argv[0]," import var",
128			(char *)NULL);
129			return TCL_ERROR;
130			}
131			if (Asc_ImportPathList(argv[2])!=0) {
132			Tcl_AppendResult(interp,"C environment var not found : ",
133			argv[0],argv[1],argv[2],
134			(char *)NULL);
135			return TCL_ERROR;
136			}
137			break;
138			case 'l':
139			/* list var
140			*/
141			if (argc != 3) {
142			Tcl_AppendResult(interp,"wrong number of args : ",
143			argv[0]," list var",
144			(char *)NULL);
145			return TCL_ERROR;
146			}
147			envargv = Asc_GetPathList(QUIET(argv[2]),&envargc);
148			if (envargv==NULL \|\| envargc <1) {
149			Tcl_AppendResult(interp,"ascend environment var not found : ",
150			argv[0],argv[1],argv[2],
151			(char *)NULL);
152			return TCL_ERROR;
153			}
154			for (c = 0; c < envargc; c++) {
155			Tcl_AppendElement(interp,envargv[c]);
156			}
157			ascfree(envargv);
158			break;
159			case 'n':
160			/* names
161			*/
162			if (argc != 2) {
163			Tcl_AppendResult(interp,"wrong number of args : ",
164			argv[0]," names",
165			(char *)NULL);
166			return TCL_ERROR;
167			}
168			envargv = Asc_EnvNames(&envargc);
169			if (envargv==NULL \|\| envargc <1) {
170			Tcl_AppendElement(interp,"");
171			} else {
172			for (c = 0; c < envargc; c++) {
173			Tcl_AppendElement(interp,envargv[c]);
174			}
175			ascfree(envargv);
176			}
177			break;
178			case 'p':
179			/* put input_string
180			*/
181			if (argc != 3) {
182			Tcl_AppendResult(interp,"wrong number of args : ",
183			argv[0]," put putenv_string",
184			(char *)NULL);
185			return TCL_ERROR;
186			}
187			if (Asc_PutEnv(QUIET(argv[2]))!=0) {
188			Tcl_AppendResult(interp,"error in processing: ",
189			argv[0],argv[1],argv[2],
190			(char *)NULL);
191			return TCL_ERROR;
192			}
193			break;
194			case 's':
195			/* set var path
196			*/
197			if (argc != 4) {
198			Tcl_AppendResult(interp,"wrong number of args : ",
199			argv[0]," set var path",
200			(char *)NULL);
201			return TCL_ERROR;
202			}
203			if (Asc_SetPathList(argv[2],argv[3])!=0) {
204			Tcl_AppendResult(interp,"error in processing: ",
205			argv[0],argv[1],argv[2], argv[3],
206			(char *)NULL);
207			return TCL_ERROR;
208			}
209			break;
210			default:
211			Asc_HelpGetUsage(interp,argv[0]);
212			return TCL_ERROR;
213			}
214			return TCL_OK;
215			}