# # # # LIST File Listing Utility # ========================= # # Author: William P. Wood, Jr. # # Address: Computer Center # Institute For Cancer Research # 7701 Burholme Ave. # Philadelphia, Pa. 19111 # (215) 728 2760 # # Version: 3.0 # # Date: March 26, 1982 # # # # ******************************************************* # * * # * THIS SOFTWARE WAS DEVELOPED WITH SUPPORT * # * FROM THE NATIONAL INSTITUTES OF HEALTH: * # * NIH CA06927 * # * NIH CA22780 * # * * # * DIRECT INQUIRIES TO: * # * COMPUTER CENTER * # * THE INSTITUTE FOR CANCER RESEARCH * # * 7701 BURHOLME AVENUE * # * PHILADELPHIA, PENNSYLVANIA 19111 * # * * # * NO WARRANTY OR REPRESENTATION, EXPRESS OR * # * IMPLIED, IS MADE WITH RESPECT TO THE * # * CORRECTNESS, COMPLETENESS, OR USEFULNESS * # * OF THIS SOFTWARE, NOR THAT USE OF THIS * # * SOFTWARE MIGHT NOT INFRINGE PRIVATELY * # * OWNED RIGHTS. * # * * # * NO LIABILITY IS ASSUMED WITH RESPECT TO * # * THE USE OF, OR FOR DAMAGES RESULTING FROM * # * THE USE OF THIS SOFTWARE * # * * # ******************************************************* # # include "symbols.rat" define(open_read, { RECORDIO open(unit=$1, name=$2, type='old', shared, err=$3, RECORDIO _ifdef(VAX) RECORDIO blocksize=5120, useropen=gpopen, RECORDIO _elsedef RECORDIO blocksize=2048, RECORDIO _enddef RECORDIO carriagecontrol='list' _ RECORDIO _ifelse($4,,,`, $4`)) BLOCKIO call bopen($1, $2, 'R', ier) BLOCKIO if (ier != 0) BLOCKIO goto $3 }) # opndef - find and open file for reading using defaults in file name logical function opndef(lun, file, prompt, nselec) implicit integer (a - z) byte file(1), file1(MAXLINE) logical getfil include "clist.cmn" include "files.cmn" _ifdef(VAX) logical fndkey, isrnd include "gpkey.cmn" external gpopen _enddef while (getfil(file, nselec, prompt)) { # try opening file with defaults applied call scopy (file, 1, file1, 1) call defnam (file, node, dev, uic, name, ext, .false.) if (flags(DELETE)) open_read(lun, file, 10) else open_read(lun, file, 10, readonly) goto 30 # now try file name as is, with DEFAULT$DISK and . as # default device and extension 10 continue call defnam(file1, EOS, DEFAULT$DISK, EOS, EOS, '.', .false.) if (flags(DELETE)) open_read(lun, file1, 20) else open_read(lun, file1, 20, readonly) node(1) = EOS; dev(1) = EOS; uic(1) = EOS; name(1) = EOS; ext(1) = EOS call defnam(file1, node, dev, uic, name, ext, .true.) # reset defaults call scopy (file1, 1, file, 1) # return full file name 30 continue # got one! _ifdef(VAX) if (keymat != KEY$NOMATCH) # first key match? if (! fndkey(lun)) { call scopy('LIST -- Error matching key value ', 1, gpbuf, 1) if (keytyp == KEY$NUMERIC) { encode(21, (i20,a1), intbuf) keyint, EOS call ttput(gpbuf, concat(gpbuf, intbuf(scan(intbuf, ' ', 1)), BUFSIZ)) } else call ttput(gpbuf, concat(gpbuf, keybuf, BUFSIZ)) RECORDIO close(unit = lun) BLOCKIO call bclose(lun, 'S', ier) xstat = EXIT_ERROR next } randac = isrnd(lun) _elsedef randac = .true. _enddef call gcctyp(lun, cc) cnode(1) = EOS; cdev(1) = EOS; cuic(1) = EOS; cname(1) = EOS cext(1) = EOS; cver(1) = EOS # set current input file spec fields call fparse(file, cnode, cdev, cuic, cname, cext, cver, .true., .false.) return(.true.) # here if unable to open a file 20 continue call scopy('LIST -- Error opening ', 1, file1, 1) call ttput(file1, concat(file1, file, MAXLINE)) xstat = EXIT_ERROR } # go try next file return (.false.) end # getfil - return selected file names one at a time from a list of file specs # separated by commas. # File specs may be a simple file name, or they may reference # an indirect file if @ is specified, or # file names may be selected by wild cards and/or switches. define(SIMPLENAME,0) define(WILDNAME,1) define(INDIRECTNAME,2) define(OTHERNAME,3) logical function getfil(file, nselec, prompt) implicit integer (a - z) byte file(1), ans(3), termc, filist(MAXLINE) logical islist, inbrak, nxtfil byte cupper include "files.cmn" if (nselec == 0) { ip = 0 call scopy(file, 1, filist, 1) nfile = 0 islist = .false. } repeat { if (nfile == 0) { inbrak = .false. for (j = nuqcp(filist, ip+1); filist(j) != EOS & (inbrak | filist(j) != ','); j = nuqcp(filist, j+1)) if (filist(j) == '[') inbrak = .true. else if (filist(j) == ']') inbrak = .false. if (filist(j) == ',') islist = .true. # this is a list of file names do i = ip+1, j file(i-ip) = filist(i) file(j-ip) = EOS ip = j if (file(1) == '@') # Indirect file name? namtyp = INDIRECTNAME else namtyp = OTHERNAME } nc = 0 while (nxtfil(file, nfile, namtyp)) { if (prompt == DEFAULT_PROMPT & (namtyp != SIMPLENAME | islist)) prompt = DO_PROMPT if (prompt == DO_PROMPT) { repeat { call readpr(TT$IN, file, ans, nc, 3, termc) } until (nc == EOF | nc >= 0) ans(1) = cupper(ans(1)) if (nc > 0 & ans(1) == 'G') prompt = NO_PROMPT } else if (prompt == NO_PROMPT) call ttput(file, 0) if (nc == EOF | prompt != DO_PROMPT | (nc > 0 & ans(1) == 'Y')) break } } until (nfile > 0 | filist(ip) == EOS | nc == EOF) getfil = nfile > 0 & nc != EOF if (getfil) nselec = nselec + 1 if (nc == EOF) close(unit = FINDFILE) return end # nxtfil - apply defaults, return wild, indirect, or simple file logical function nxtfil(file, nfile, namtyp) implicit integer (a - z) byte file(MAXLINE), tfile(MAXLINE), t2file(MAXLINE), swtchs(MAXLINE) logical fwild, wild include "files.cmn" include "clist.cmn" if (namtyp == INDIRECTNAME) { call readf(FINDFILE, file, tfile, nfile) if (nfile > 0) { call scopy(tfile, 1, file, 1) call defnam(file, node, device, uic, name, ext, .true.) #reset defaults } } else if (nfile == 0) { namtyp = WILDNAME fwild = wild(file) i = bkscnq(file, '/', 1) call scopy(file, i, swtchs, 1) # save switches file(i) = EOS call scopy(file, 1, t2file, 1) # save initial file spec call defnam(file, node, dev, uic, name, ext, .true.) call concat(file, swtchs, MAXLINE) if (! wild(file)) { call scopy(t2file, 1, tfile, 1) nfile = 1 namtyp = SIMPLENAME } else { WLD call findfl(FINDFILE, file, tfile, nfile) if (nfile == 0) { # try again with no defaults if (! fwild) { call scopy(t2file, 1, tfile, 1) nfile = 1 namtyp = SIMPLENAME } else { call defnam(t2file, EOS, DEFAULT$DISK, EOS, EOS, '.', .false.) call concat(t2file, swtchs, MAXLINE) WLD call findfl(FINDFILE, t2file, tfile, nfile) if (nfile != 0) { # reset defaults node(1) = EOS; dev(1) = EOS; uic(1) = EOS name(1) = EOS; ext(1) = EOS call defnam(t2file, node, dev, uic, name, ext, .true.) } } } } if (nfile == 0) { call scopy('LIST -- Error opening ', 1, tfile, 1) call ttput(tfile, concat(tfile, file, MAXLINE)) xstat = EXIT_ERROR } } else if (namtyp == SIMPLENAME) nfile = 0 else { WLD call findfl(FINDFILE, file, tfile, nfile) } if (nfile > 0) { call scopy(tfile, 1, file, 1) return (.true.) } return (.false.) end # wild - return true if file name contains wild card characters or switches logical function wild(file) byte file(1) integer bkscnq _ifdef(VAX) if (file(bkscnq(file, '/*%', 1)) != EOS) return(.true.) else { # look for ... ndots = 0 for (i = 1; file(i) != EOS & ndots < 3; i = i+1) if (file(i) == '.') ndots = ndots+1 else ndots = 0 if (ndots == 3) return(.true.) } _elsedef if (file(bkscnq(file, '/*?', 1)) != EOS) return(.true.) _enddef return(.false.) end # readf - read in file names from indirect file subroutine readf(f, file, outfil, nselec) integer f, nselec, nc byte file(1), outfil(1) _ifdef(VAX) external gpopen _enddef if (nselec == 0) { call defnam(file(2), EOS, DEFAULT$DISK, EOS, EOS, DEFAULT$COMMAND, .false.) close(unit=f) open(unit=f, name=file(2), type='old', readonly, shared, err=10 _ _ifdef(VAX) , useropen=gpopen _ _enddef ) } repeat call get(f, outfil, MAXLINE-1, nc) until (nc != 0) if (nc < 0) { nselec = 0 close(unit=f) } else { nselec = nselec+1 outfil(nc+1) = EOS } return 10 continue call err(file, 2, "Can't open file.") return end WLD _ifdef(VAX) WLD WLD _undef(character) WLD WLD # findfl - return matching file names one-by-one WLD subroutine findfl(dummy, file, outfil, n) WLD byte file(FILENAMESIZE), outfil(FILENAMESIZE) WLD integer dummy, n, i WLD character*_arith(FILENAMESIZE,-,1) c_file WLD WLD if (n == 0) { WLD c_file = ' ' WLD for (i = 1; file(i) != EOS; i = i+1) WLD c_file(i:i) = char(file(i)) WLD } WLD call icr_find_file(c_file, " ", n, c_file) WLD if (n > 0) { WLD for (i = 1; c_file(i:i) != ' '; i = i+1) WLD outfil(i) = ichar(c_file(i:i)) WLD outfil(i) = EOS WLD } WLD return WLD end WLD WLD _elsedef WLD WLD # findfl - return matching file names one-by-one WLD subroutine findfl(lun, file, outfil, n) WLD byte file(FILENAMESIZE), outfil(FILENAMESIZE) WLD integer lun, n, WLD saven, ierr WLD include "qiofn.cmn" WLD WLD saven = n WLD if (saven == 0) WLD call qiofn(TT$OUT, IODET, 0, 0, ierr) WLD call fndfil(lun, file, outfil, n) WLD if (saven == 0) WLD call qiofn(TT$OUT, IOATT, 0, 0, ierr) WLD return WLD end WLD WLD _enddef