libf2c/libI77/open.c

   1 #ifndef NON_UNIX_STDIO
   2 #include <sys/types.h>
   3 #include <sys/stat.h>
   4 #endif
   5 #include "f2c.h"
   6 #include "fio.h"
   7 #include <string.h>
   8 #include "rawio.h"
   9
  10 #ifdef KR_headers
  11 extern char *malloc(), *mktemp();
  12 extern integer f_clos();
  13 #else
  14 #undef abs
  15 #undef min
  16 #undef max
  17 #include <stdlib.h>
  18 extern int f__canseek(FILE*);
  19 extern integer f_clos(cllist*);
  20 #endif
  21
  22 #ifdef NON_ANSI_RW_MODES
  23 char *f__r_mode[2] = {"r", "r"};
  24 char *f__w_mode[4] = {"w", "w", "r+w", "r+w"};
  25 #else
  26 char *f__r_mode[2] = {"rb", "r"};
  27 char *f__w_mode[4] = {"wb", "w", "r+b", "r+"};
  28 #endif
  29
  30 #ifdef KR_headers
  31 f__isdev(s) char *s;
  32 #else
  33 f__isdev(char *s)
  34 #endif
  35 {
  36 #ifdef NON_UNIX_STDIO
  37         int i, j;
  38
  39         i = open(s,O_RDONLY);
  40         if (i == -1)
  41                 return 0;
  42         j = isatty(i);
  43         close(i);
  44         return j;
  45 #else
  46         struct stat x;
  47
  48         if(stat(s, &x) == -1) return(0);
  49 #ifdef S_IFMT
  50         switch(x.st_mode&S_IFMT) {
  51                 case S_IFREG:
  52                 case S_IFDIR:
  53                         return(0);
  54                 }
  55 #else
  56 #ifdef S_ISREG
  57         /* POSIX version */
  58         if(S_ISREG(x.st_mode) || S_ISDIR(x.st_mode))
  59                 return(0);
  60         else
  61 #else
  62         Help! How does stat work on this system?
  63 #endif
  64 #endif
  65                 return(1);
  66 #endif
  67 }
  68 #ifdef KR_headers
  69 integer f_open(a) olist *a;
  70 #else
  71 integer f_open(olist *a)
  72 #endif
  73 {       unit *b;
  74         integer rv;
  75         char buf[256], *s;
  76         cllist x;
  77         int ufmt;
  78 #ifdef NON_UNIX_STDIO
  79         FILE *tf;
  80 #else
  81         int n;
  82         struct stat stb;
  83 #endif
  84         if(f__init != 1) f_init();
  85         if(a->ounit>=MXUNIT || a->ounit<0)
  86                 err(a->oerr,101,"open");
  87         f__curunit = b = &f__units[a->ounit];
  88         if(b->ufd) {
  89                 if(a->ofnm==0)
  90                 {
  91                 same:   if (a->oblnk)
  92                                 b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';
  93                         return(0);
  94                 }
  95 #ifdef NON_UNIX_STDIO
  96                 if (b->ufnm
  97                  && strlen(b->ufnm) == a->ofnmlen
  98                  && !strncmp(b->ufnm, b->ufnm, (unsigned)a->ofnmlen))
  99                         goto same;
 100 #else
 101                 g_char(a->ofnm,a->ofnmlen,buf);
 102                 if (f__inode(buf,&n) == b->uinode && n == b->udev)
 103                         goto same;
 104 #endif
 105                 x.cunit=a->ounit;
 106                 x.csta=0;
 107                 x.cerr=a->oerr;
 108                 if ((rv = f_clos(&x)) != 0)
 109                         return rv;
 110                 }
 111         b->url = (int)a->orl;
 112         b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
 113         if(a->ofm==0)
 114         {       if(b->url>0) b->ufmt=0;
 115                 else b->ufmt=1;
 116         }
 117         else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1;
 118         else b->ufmt=0;
 119         ufmt = b->ufmt;
 120 #ifdef url_Adjust
 121         if (b->url && !ufmt)
 122                 url_Adjust(b->url);
 123 #endif
 124         if (a->ofnm) {
 125                 g_char(a->ofnm,a->ofnmlen,buf);
 126                 if (!buf[0])
 127                         err(a->oerr,107,"open");
 128                 }
 129         else
 130                 sprintf(buf, "fort.%ld", a->ounit);
 131         b->uscrtch = 0;
 132         switch(a->osta ? *a->osta : 'u')
 133         {
 134         case 'o':
 135         case 'O':
 136 #ifdef NON_UNIX_STDIO
 137                 if(access(buf,0))
 138 #else
 139                 if(stat(buf,&stb))
 140 #endif
 141                         err(a->oerr,errno,"open");
 142                 break;
 143          case 's':
 144          case 'S':
 145                 b->uscrtch=1;
 146 #ifdef HAVE_TEMPNAM             /* Allow use of TMPDIR preferentially. */
 147                 s = tempnam (0, buf);
 148                 if (strlen (s) >= sizeof (buf))
 149                   err (a->oerr, 132, "open");
 150                 (void) strcpy (buf, s);
 151                 free (s);
 152 #else /* ! defined (HAVE_TEMPNAM) */
 153 #ifdef _POSIX_SOURCE
 154                 tmpnam(buf);
 155 #else
 156                 (void) strcpy(buf,"tmp.FXXXXXX");
 157                 (void) mktemp(buf);
 158 #endif
 159 #endif /* ! defined (HAVE_TEMPNAM) */
 160                 goto replace;
 161         case 'n':
 162         case 'N':
 163 #ifdef NON_UNIX_STDIO
 164                 if(!access(buf,0))
 165 #else
 166                 if(!stat(buf,&stb))
 167 #endif
 168                         err(a->oerr,128,"open");
 169                 /* no break */
 170         case 'r':       /* Fortran 90 replace option */
 171         case 'R':
 172  replace:
 173 #ifdef NON_UNIX_STDIO
 174                 if (tf = fopen(buf,f__w_mode[0]))
 175                         fclose(tf);
 176 #else
 177                 (void) close(creat(buf, 0666));
 178 #endif
 179         }
 180
 181         b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1));
 182         if(b->ufnm==NULL) err(a->oerr,113,"no space");
 183         (void) strcpy(b->ufnm,buf);
 184         b->uend=0;
 185         b->uwrt = 0;
 186 #ifdef NON_UNIX_STDIO
 187         if ((s = a->oacc) && (*s == 'd' || *s == 'D'))
 188                 ufmt = 0;
 189 #endif
 190         if(f__isdev(buf))
 191         {       b->ufd = fopen(buf,f__r_mode[ufmt]);
 192                 if(b->ufd==NULL) err(a->oerr,errno,buf);
 193         }
 194         else {
 195                 if(!(b->ufd = fopen(buf, f__r_mode[ufmt]))) {
 196 #ifdef NON_UNIX_STDIO
 197                         if (b->ufd = fopen(buf, f__w_mode[ufmt|2]))
 198                                 b->uwrt = 2;
 199                         else if (b->ufd = fopen(buf, f__w_mode[ufmt]))
 200                                 b->uwrt = 1;
 201                         else
 202 #else
 203                         if ((n = open(buf,O_WRONLY)) >= 0)
 204                                 b->uwrt = 2;
 205                         else {
 206                                 n = creat(buf, 0666);
 207                                 b->uwrt = 1;
 208                                 }
 209                         if (n < 0
 210                         || (b->ufd = fdopen(n, f__w_mode[ufmt])) == NULL)
 211 #endif
 212                                 err(a->oerr, errno, "open");
 213                         }
 214         }
 215         b->useek=f__canseek(b->ufd);
 216 #ifndef NON_UNIX_STDIO
 217         if((b->uinode=f__inode(buf,&b->udev))==-1)
 218                 err(a->oerr,108,"open");
 219 #endif
 220         if(b->useek)
 221                 if (a->orl)
 222                         rewind(b->ufd);
 223                 else if ((s = a->oacc) && (*s == 'a' || *s == 'A')
 224                         && fseek(b->ufd, 0L, SEEK_END))
 225                                 err(a->oerr,129,"open");
 226         return(0);
 227 }
 228 #ifdef KR_headers
 229 fk_open(seq,fmt,n) ftnint n;
 230 #else
 231 fk_open(int seq, int fmt, ftnint n)
 232 #endif
 233 {       char nbuf[10];
 234         olist a;
 235         int rtn;
 236         int save_init;
 237
 238         (void) sprintf(nbuf,"fort.%ld",n);
 239         a.oerr=1;
 240         a.ounit=n;
 241         a.ofnm=nbuf;
 242         a.ofnmlen=strlen(nbuf);
 243         a.osta=NULL;
 244         a.oacc= seq==SEQ?"s":"d";
 245         a.ofm = fmt==FMT?"f":"u";
 246         a.orl = seq==DIR?1:0;
 247         a.oblnk=NULL;
 248         save_init = f__init;
 249         f__init &= ~2;
 250         rtn = f_open(&a);
 251         f__init = save_init | 1;
 252         return rtn;
 253 }