Line data    Source code

       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           2 :       ptname = fchtak(fname,*lgname);
      48           1 :       if (ptname == NULL)          goto out;
      49           1 :       pttext = getenv (ptname);
      50           1 :       free(ptname);
      51             : 
      52           1 : out:  *lgtext = fchput (pttext,ftext,*lgtext);
      53             :       return;
      54           1 : }
      55             : /*> END <----------------------------------------------------------*/