lang/fortran/lib/libI77/open.c

   1 #include "sys/types.h"
   2 #ifndef MSDOS
   3 #include "sys/stat.h"
   4 #endif
   5 #include "f2c.h"
   6 #include "fio.h"
   7 #include "string.h"
   8 #include "fcntl.h"
   9 #ifndef O_WRONLY
  10 #define O_RDONLY 0
  11 #define O_WRONLY 1
  12 #endif
  13
  14 extern char *malloc(), *mktemp();
  15 extern FILE *fdopen();
  16 extern integer f_clos();
  17 #ifdef NON_ANSI_RW_MODES
  18 char *r_mode[2] = {"r", "r"};
  19 char *w_mode[2] = {"w", "w"};
  20 #else
  21 char *r_mode[2] = {"rb", "r"};
  22 char *w_mode[2] = {"wb", "w"};
  23 #endif
  24
  25 integer f_open(a) olist *a;
  26 {       unit *b;
  27         int n;
  28         char buf[256];
  29         cllist x;
  30 #ifndef MSDOS
  31         struct stat stb;
  32 #endif
  33         if(a->ounit>=MXUNIT || a->ounit<0)
  34                 err(a->oerr,101,"open")
  35         curunit = b = &units[a->ounit];
  36         if(b->ufd) {
  37                 if(a->ofnm==0)
  38                 {
  39                 same:   if (a->oblnk)
  40                                 b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';
  41                         return(0);
  42                 }
  43 #ifdef MSDOS
  44                 if (b->ufnm
  45                  && strlen(b->ufnm) == a->ofnmlen
  46                  && !strncmp(b->ufnm, b->ufnm, (unsigned)a->ofnmlen))
  47                         goto same;
  48 #else
  49                 g_char(a->ofnm,a->ofnmlen,buf);
  50                 if (inode(buf,&n) == b->uinode && n == b->udev)
  51                         goto same;
  52 #endif
  53                 x.cunit=a->ounit;
  54                 x.csta=0;
  55                 x.cerr=a->oerr;
  56                 if((n=f_clos(&x))!=0) return(n);
  57                 }
  58         b->url=a->orl;
  59         b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
  60         if(a->ofm==0)
  61         {       if(b->url>0) b->ufmt=0;
  62                 else b->ufmt=1;
  63         }
  64         else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1;
  65         else b->ufmt=0;
  66 #ifdef url_Adjust
  67         if (b->url && !b->ufmt)
  68                 url_Adjust(b->url);
  69 #endif
  70         if (a->ofnm) {
  71                 g_char(a->ofnm,a->ofnmlen,buf);
  72                 if (!buf[0])
  73                         err(a->oerr,107,"open")
  74                 }
  75         else
  76                 sprintf(buf, "fort.%ld", a->ounit);
  77         b->uscrtch = 0;
  78         switch(a->osta ? *a->osta : 'u')
  79         {
  80         case 'o':
  81         case 'O':
  82 #ifdef MSDOS
  83                 if(access(buf,0))
  84 #else
  85                 if(stat(buf,&stb))
  86 #endif
  87                         err(a->oerr,errno,"open")
  88                 break;
  89          case 's':
  90          case 'S':
  91                 b->uscrtch=1;
  92                 (void) strcpy(buf,"tmp.FXXXXXX");
  93                 (void) mktemp(buf);
  94                 (void) close(creat(buf, 0666));
  95                 break;
  96         case 'n':
  97         case 'N':
  98 #ifdef MSDOS
  99                 if(!access(buf,0))
 100 #else
 101                 if(!stat(buf,&stb))
 102 #endif
 103                         err(a->oerr,128,"open")
 104                 /* no break */
 105         case 'r':       /* Fortran 90 replace option */
 106         case 'R':
 107                 (void) close(creat(buf, 0666));
 108                 break;
 109         }
 110
 111         b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1));
 112         if(b->ufnm==NULL) err(a->oerr,113,"no space");
 113         (void) strcpy(b->ufnm,buf);
 114         b->uend=0;
 115         b->uwrt = 0;
 116         if(isdev(buf))
 117         {       b->ufd = fopen(buf,r_mode[b->ufmt]);
 118                 if(b->ufd==NULL) err(a->oerr,errno,buf)
 119         }
 120         else {
 121                 if((b->ufd = fopen(buf, r_mode[b->ufmt])) == NULL) {
 122                         if ((n = open(buf,O_WRONLY)) >= 0) {
 123                                 b->uwrt = 2;
 124                                 }
 125                         else {
 126                                 n = creat(buf, 0666);
 127                                 b->uwrt = 1;
 128                                 }
 129                         if (n < 0
 130                         || (b->ufd = fdopen(n, w_mode[b->ufmt])) == NULL)
 131                                 err(a->oerr, errno, "open");
 132                         }
 133         }
 134         b->useek=canseek(b->ufd);
 135 #ifndef MSDOS
 136         if((b->uinode=inode(buf,&b->udev))==-1)
 137                 err(a->oerr,108,"open")
 138 #endif
 139         if(a->orl && b->useek) rewind(b->ufd);
 140         return(0);
 141 }
 142 fk_open(seq,fmt,n) ftnint n;
 143 {       char nbuf[10];
 144         olist a;
 145         (void) sprintf(nbuf,"fort.%ld",n);
 146         a.oerr=1;
 147         a.ounit=n;
 148         a.ofnm=nbuf;
 149         a.ofnmlen=strlen(nbuf);
 150         a.osta=NULL;
 151         a.oacc= seq==SEQ?"s":"d";
 152         a.ofm = fmt==FMT?"f":"u";
 153         a.orl = seq==DIR?1:0;
 154         a.oblnk=NULL;
 155         return(f_open(&a));
 156 }
 157 isdev(s) char *s;
 158 {
 159 #ifdef MSDOS
 160         int i, j;
 161
 162         i = open(s,O_RDONLY);
 163         if (i == -1)
 164                 return 0;
 165         j = isatty(i);
 166         close(i);
 167         return j;
 168 #else
 169         struct stat x;
 170
 171         if(stat(s, &x) == -1) return(0);
 172 #ifdef S_IFMT
 173         switch(x.st_mode&S_IFMT) {
 174                 case S_IFREG:
 175                 case S_IFDIR:
 176                         return(0);
 177                 }
 178 #else
 179 #ifdef S_ISREG
 180         /* POSIX version */
 181         if(S_ISREG(x.st_mode) || S_ISDIR(x.st_mode))
 182                 return(0);
 183         else
 184 #else
 185         Help! How does stat work on this system?
 186 #endif
 187 #endif
 188                 return(1);
 189 #endif
 190 }