libf2c/libF77/getenv_.c

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