MICROCERN/geteni.c

   1 /* $Id$ */
   2
   3 #include "kerngen/pilot.h"
   4 #include "kerngen/fortranc.h"
   5
   6 /*>    ROUTINE GETENI
   7   CERN PROGLIB# Z265    GETENI          .VERSION KERNFOR  4.31  911111
   8   ORIG. 22/02/91, JZ
   9   Fortran interface routine to getenv
  10
  11       CALL GETENVF (NAME, TEXT*)
  12
  13           NAME  the name of the environment variable,
  14           TEXT  returns its value
  15                 ISLATE(1) returns its length
  16 */
  17 #include <stdio.h>
  18 #include <stdlib.h>
  19 #include "kerngen/fortchar.h"
  20 #if defined(CERNLIB_QX_SC)
  21 void type_of_call geteni_(fname, ftext, lgtext, lgname)
  22 #endif
  23 #if defined(CERNLIB_QXNO_SC)
  24 void type_of_call geteni(fname, ftext, lgtext, lgname)
  25 #endif
  26 #if defined(CERNLIB_QXCAPT)
  27 #  ifdef CERNLIB_MSSTDCALL
  28     void type_of_call GETENI(fname, len_fname, ftext, len_ftext, lgtext, lgname)
  29      int len_fname, len_ftext;
  30 #  else
  31     void type_of_call GETENI(fname, ftext, lgtext, lgname)
  32 # endif
  33 #endif
  34 #if defined(CERNLIB_QMCRY)
  35       _fcd  fname,  ftext;
  36 #endif
  37 #if !defined(CERNLIB_QMCRY)
  38       char *fname, *ftext;
  39 #endif
  40       int  *lgtext, *lgname;
  41 {
  42       char *ptname, *fchtak(char*, int);
  43       char *pttext, *getenv();
  44       int  fchput(char*, char*, int);
  45
  46       pttext = NULL;
  47       ptname = fchtak(fname,*lgname);
  48       if (ptname == NULL)          goto out;
  49       pttext = getenv (ptname);
  50       free(ptname);
  51
  52 out:  *lgtext = fchput (pttext,ftext,*lgtext);
  53       return;
  54 }
  55 /*> END <----------------------------------------------------------*/