getenv_.c 1.2 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162
  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. * getenv - f77 subroutine to return environment variables
  15. *
  16. * called by:
  17. * call getenv (ENV_NAME, char_var)
  18. * where:
  19. * ENV_NAME is the name of an environment variable
  20. * char_var is a character variable which will receive
  21. * the current value of ENV_NAME, or all blanks
  22. * if ENV_NAME is not defined
  23. */
  24. #ifdef KR_headers
  25. VOID
  26. getenv_(fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen;
  27. #else
  28. void
  29. getenv_(char *fname, char *value, ftnlen flen, ftnlen vlen)
  30. #endif
  31. {
  32. char buf[256], *ep, *fp;
  33. integer i;
  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. }
  57. #ifdef __cplusplus
  58. }
  59. #endif