1 #include "f2c.h"
2 #undef abs
3 #ifdef KR_headers
4 extern char *F77_aloc(), *getenv();
5 #else
6 #include <stdlib.h>
7 #include <string.h>
8 #ifdef __cplusplus
9 extern "C" {
10 #endif
11 extern char *F77_aloc(ftnlen, const char*);
12 #endif
13
14 /*
15 * getenv - f77 subroutine to return environment variables
16 *
17 * called by:
18 * call getenv (ENV_NAME, char_var)
19 * where:
20 * ENV_NAME is the name of an environment variable
21 * char_var is a character variable which will receive
22 * the current value of ENV_NAME, or all blanks
23 * if ENV_NAME is not defined
24 */
25
26 #ifdef KR_headers
27 VOID
getenv_(fname,value,flen,vlen)28 getenv_(fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen;
29 #else
30 void
31 getenv_(char *fname, char *value, ftnlen flen, ftnlen vlen)
32 #endif
33 {
34 char buf[256], *ep, *fp;
35 integer i;
36
37 if (flen <= 0)
38 goto add_blanks;
39 for(i = 0; i < sizeof(buf); i++) {
40 if (i == flen || (buf[i] = fname[i]) == ' ') {
41 buf[i] = 0;
42 ep = getenv(buf);
43 goto have_ep;
44 }
45 }
46 while(i < flen && fname[i] != ' ')
47 i++;
48 strncpy(fp = F77_aloc(i+1, "getenv_"), fname, (int)i);
49 fp[i] = 0;
50 ep = getenv(fp);
51 free(fp);
52 have_ep:
53 if (ep)
54 while(*ep && vlen-- > 0)
55 *value++ = *ep++;
56 add_blanks:
57 while(vlen-- > 0)
58 *value++ = ' ';
59 }
60 #ifdef __cplusplus
61 }
62 #endif
63