|
|
1.1 root 1: /*
2: * Copyright (c) 1980 Regents of the University of California.
3: * All rights reserved. The Berkeley software License Agreement
4: * specifies the terms and conditions for redistribution.
5: *
6: * @(#)open.c 5.3 10/24/88
7: */
8:
9: /*
10: * open.c - f77 file open and I/O library initialization routines
11: */
12:
13: #include <sys/types.h>
14: #include <sys/stat.h>
15: #include <errno.h>
16: #include "fio.h"
17:
18: #define SCRATCH (st=='s')
19: #define NEW (st=='n')
20: #define OLD (st=='o')
21: #define OPEN (b->ufd)
22: #define FROM_OPEN "\2" /* for use in f_clos() */
23: #define BUF_LEN 256
24:
25: LOCAL char *tmplate = "tmp.FXXXXXX"; /* scratch file template */
26: LOCAL char *fortfile = "fort.%d"; /* default file template */
27:
28: char *getenv();
29:
30: f_open(a) olist *a;
31: { unit *b;
32: struct stat sbuf;
33: int n,exists;
34: char buf[BUF_LEN], env_name[BUF_LEN];
35: char *env_val, *p1, *p2, ch, st;
36: cllist x;
37:
38: lfname = NULL;
39: elist = NO;
40: external = YES; /* for err */
41: errflag = a->oerr;
42: lunit = a->ounit;
43: if(not_legal(lunit)) err(errflag,F_ERUNIT,"open")
44: b= &units[lunit];
45: if(a->osta) st = lcase(*a->osta);
46: else st = 'u';
47: if(SCRATCH)
48: { strcpy(buf,tmplate);
49: /* make a new temp file name, err if mktemp fails */
50: if( strcmp( mktemp(buf), "/" ) == 0 )
51: err(errflag, F_ERSYS, "open")
52: }
53: else
54: {
55: if(a->ofnm) g_char(a->ofnm,a->ofnmlen,buf);
56: else sprintf(buf,fortfile,lunit);
57: /* check if overriding file name via environment variable
58: * first copy tail of name - delete periods as Bourne Shell
59: * croaks if any periods in name
60: */
61: p1 = buf;
62: p2 = env_name;
63: while ((ch = *p1++) != '\0') {
64: if(ch == '/') p2 = env_name;
65: else if(ch != '.') *p2++ = ch;
66: }
67: if(p2 != env_name) {
68: *p2 = '\0';
69: if( (env_val = getenv( env_name )) != NULL ) {
70: if(strlen(env_val) >= BUF_LEN-1 )
71: err(errflag,F_ERSTAT,"open: file name too long");
72: strcpy(buf, env_val);
73: }
74: }
75: }
76: lfname = &buf[0];
77: if(OPEN)
78: {
79: if(!a->ofnm || inode(buf)==b->uinode)
80: {
81: if(a->oblnk) b->ublnk= (lcase(*a->oblnk)== 'z');
82: #ifndef KOSHER
83: if(a->ofm && b->ufmt) b->uprnt = (lcase(*a->ofm)== 'p');
84: #endif
85: return(OK);
86: }
87: x.cunit=lunit;
88: x.csta=FROM_OPEN;
89: x.cerr=errflag;
90: if(n=f_clos(&x)) return(n);
91: }
92: exists = (stat(buf,&sbuf)==NULL);
93: if(!exists && OLD) err(errflag,F_EROLDF,"open");
94: if( exists && NEW) err(errflag,F_ERNEWF,"open");
95: errno = F_ERSYS;
96: if(isdev(buf))
97: { if((b->ufd = fopen(buf,"r")) != NULL) b->uwrt = NO;
98: else err(errflag,errno,buf)
99: }
100: else
101: {
102: errno = F_ERSYS;
103: if((b->ufd = fopen(buf, "a")) != NULL)
104: { if(!opneof)
105: { if(freopen(buf, "r", b->ufd) != NULL)
106: b->uwrt = NO;
107: else
108: err(errflag, errno, buf)
109: }
110: else
111: b->uwrt = YES;
112: }
113: else if((b->ufd = fopen(buf, "r")) != NULL)
114: { if (opneof)
115: fseek(b->ufd, 0L, 2);
116: b->uwrt = NO;
117: }
118: else err(errflag, errno, buf)
119: }
120: if((b->uinode=finode(b->ufd))==-1) err(errflag,F_ERSTAT,"open")
121: b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char));
122: if(b->ufnm==NULL) err(errflag,F_ERSPACE,"open")
123: strcpy(b->ufnm,buf);
124: b->uscrtch = SCRATCH;
125: b->uend = NO;
126: b->useek = canseek(b->ufd);
127: if (a->oacc == NULL)
128: a->oacc = "seq";
129: if (lcase(*a->oacc)=='s' && a->orl > 0)
130: {
131: fputs("Warning: open: record length ignored on sequential access\n", units[0].ufd);
132: b->url = 0;
133: }
134: else if (a->orl < 0 || (lcase(*a->oacc)=='d' && a->orl == 0))
135: err(errflag,F_ERARG,"recl on open")
136: else
137: b->url = a->orl;
138: if (a->oblnk)
139: b->ublnk = (lcase(*a->oblnk)=='z');
140: else if (lunit == STDERR)
141: b->ublnk = NO;
142: else
143: b->ublnk = blzero;
144: if (a->ofm)
145: {
146: switch(lcase(*a->ofm))
147: {
148: case 'f':
149: b->ufmt = YES;
150: b->uprnt = NO;
151: break;
152: #ifndef KOSHER
153: case 'p': /* print file *** NOT STANDARD FORTRAN ***/
154: b->ufmt = YES;
155: b->uprnt = YES;
156: break;
157: #endif
158: case 'u':
159: b->ufmt = NO;
160: b->uprnt = NO;
161: break;
162: default:
163: err(errflag,F_ERARG,"open form=")
164: }
165: }
166: else /* not specified */
167: { b->ufmt = (b->url==0);
168: if (lunit == STDERR)
169: b->uprnt = NO;
170: else
171: b->uprnt = ccntrl;
172: }
173: if(b->url && b->useek) rewind(b->ufd);
174: return(OK);
175: }
176:
177: fk_open(rd,seq,fmt,n) ftnint n;
178: { char nbuf[10];
179: olist a;
180: sprintf(nbuf, fortfile, (int)n);
181: a.oerr=errflag;
182: a.ounit=n;
183: a.ofnm=nbuf;
184: a.ofnmlen=strlen(nbuf);
185: a.osta=NULL;
186: a.oacc= seq==SEQ?"s":"d";
187: a.ofm = fmt==FMT?"f":"u";
188: a.orl = seq==DIR?1:0;
189: a.oblnk=NULL;
190: return(f_open(&a));
191: }
192:
193: LOCAL
194: isdev(s) char *s;
195: { struct stat x;
196: int j;
197: if(stat(s, &x) == -1) return(NO);
198: if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO);
199: else return(YES);
200: }
201:
202: /*initialization routine*/
203: f_init()
204: {
205: ini_std(STDERR, stderr, WRITE);
206: ini_std(STDIN, stdin, READ);
207: ini_std(STDOUT, stdout, WRITE);
208: setlinebuf(stderr);
209: }
210:
211: LOCAL
212: ini_std(u,F,w) FILE *F;
213: { unit *p;
214: p = &units[u];
215: p->ufd = F;
216: p->ufnm = NULL;
217: p->useek = canseek(F);
218: p->ufmt = YES;
219: p->uwrt = (w==WRITE)? YES : NO;
220: p->uscrtch = p->uend = NO;
221: p->ublnk = blzero;
222: p->uprnt = ccntrl;
223: p->url = 0;
224: p->uinode = finode(F);
225: }
226:
227: LOCAL
228: canseek(f) FILE *f; /*SYSDEP*/
229: { struct stat x;
230: return( (fstat(fileno(f),&x)==0) &&
231: (x.st_nlink > 0 /*!pipe*/) && !isatty(fileno(f)) );
232: }
233:
234: LOCAL
235: finode(f) FILE *f;
236: { struct stat x;
237: if(fstat(fileno(f),&x)==0) return(x.st_ino);
238: else return(-1);
239: }
240:
241: inode(a) char *a;
242: { struct stat x;
243: if(stat(a,&x)==0) return(x.st_ino);
244: else return(-1);
245: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.