c c COOKIE.FOR c c Cookie file in FORTRAN for VAX/VMS 3.x c program COOKIE IMPLICIT INTEGER*4 (A-Z) c c Invocation: c COOKIE will print a random cookie c COOKIE -n will print n random cookies c COOKIE n will print cookie number n c COOKIE # will print the number of cookies c COOKIE -a filespec will add cookies to the file from filespec c (requires WRITE permission to file) c COOKIE -s keyword will search for and print all cookies c containing the desired keyword c ----------------------------------------------------------------------- c c Files: c COOKIE.IDX File containing the text of each cookie c indexed by cookie number. c COOKIE.TXT Text file containing cookies in readable c form (COOKIE input format). c A cookie is stored as a single record in the COOKIE.IDX file, but c may consist of multiple lines. Maximum character length is 1920 c chars (one screen). c A longword integer is used as the key to index each cookie. Record c number 0 contains the number of cookies so far. c c Cookie input format, for the uninitiated, is as follows: c A cookie consists of one or more lines of text. The second and c any subsequent lines must have a blank or tab in column 1; thus, c a new cookie begins whenever column 1 is not blank. c ----------------------------------------------------------------------- c 14-Feb-1984 Version 1.0 M.S. Shefler c CHARACTER cmdline*80 ! command invocation CHARACTER leadin*1,nextchar*1,sysmsg*80 INTEGER*2 msglen INTEGER*4 izz4(2) COMMON /COOKIE_N/ ncookie,izz c c Open file and get # cookies. c OPEN (UNIT=1,FILE='SYS$MANAGER:COOKIE.IDX',STATUS='OLD', 4 ACCESS='KEYED',READONLY, 4 FORM='FORMATTED') READ (1,6,KEY='0000',ERR=910,IOSTAT=status)cooknum,ncookie c CALL SYS$GETTIM(izz4) ! Get binary time izz = IOR(izz4(1),1) ! Make it odd and use only lower 32 bits c c Get command line. c cmdline = ' ' CALL LIB$GET_FOREIGN(cmdline) CALL STR$UPCASE(cmdline,cmdline) ! Convert whole thing to UC cmdlen = trulen(cmdline) c c Parse and act upon command line. c pos = find_nw(cmdline,1) IF (pos.EQ.0) THEN ! must 'create' a commandline cmdline = '-1' ! He wants one of them pos = 1 ENDIF leadin = cmdline(pos:pos) ! first char nextchar = cmdline(pos+1:pos+1) ! in case it's a '-' c c This is the basic decision matrix. c IF (leadin.EQ.'-') THEN ! dash it ! IF (nextchar.EQ.'A') THEN ! Add cookies call addcookie(cmdline(pos+2:)) ELSEIF (nextchar.EQ.'S') THEN ! Search on keyword call searchcookie(cmdline(pos+2:)) ELSEIF (isdigit(nextchar)) THEN ! Print desired cookie call prcookie(cmdline(pos:)) ELSE ! Bad option write(6,2)cmdline ENDIF ELSEIF (leadin.EQ.'#') THEN ! He wants number of cookies WRITE(6,1)ncookie ELSEIF (isdigit(leadin)) THEN ! Wants a certain number of them call prcookie(cmdline(pos:)) ELSE ! Undefined command write(6,2)cmdline ENDIF c CALL EXIT(1) c 900 WRITE (6,3) 910 CALL ERRSNS(status,rmssts,rmsstv,iunit,condval) WRITE(6,4) status,rmssts,rmsstv,condval CALL SYS$GETMSG(%val(condval),msglen,sysmsg,,) WRITE (6,5) sysmsg(1:msglen) CALL EXIT(0) c 1 FORMAT (' There are',i,' cookies in the file') 2 FORMAT (' Incomprehensible command line:',a,'. Try HELP COOKIE') 3 FORMAT (' Unable to open SYS$MANAGER:COOKIE.IDX') 4 FORMAT (' Unable to read Cookie file:',4z9) 5 FORMAT (' System says:',a) 6 FORMAT (i4.4,i8) END c c ************************************************************************ c SUBROUTINE addcookie(cmdline) IMPLICIT INTEGER*4 (a-z) c PARAMETER MAXSIZ = 1920 PARAMETER BLANK = ' ', TAB = ' ', NEWLINE = CHAR(10) c CHARACTER cmdline*(*) ! Remainder of command line CHARACTER cookie*(MAXSIZ) ! Holds the complete cookie CHARACTER oneline*132 ! Holds one line of current cookie LOGICAL anyyet ! True if not on first cookie CHARACTER sysmsg*80 INTEGER*2 msglen COMMON /COOKIE_N/ ncookie,izz c c Open the file that contains cookie text. c Close and reopen the cookie file in shared mode. c CLOSE (1) OPEN (UNIT=1,FILE='SYS$MANAGER:COOKIE.IDX',STATUS='OLD', 4 ACCESS='KEYED',SHARED,FORM='FORMATTED',ERR=930) c OPEN (UNIT=2,FILE=cmdline,STATUS='OLD',READONLY, 4 ACCESS='SEQUENTIAL',ERR=900) c c Setup. c anyyet = .FALSE. ! No cookies seen so far cookie = ' ' ! Blank out storage area cpos = 1 ! Current position in cookie n2 = 0 ! Line counter for cookie text file nadd = 0 ! Number of cookies added c c Read lines of text until end. Build cookie up a line at a time, in c the cookie storage area. Each line therein is separated by NEWLINE. c 200 READ (2,2,END=299,ERR=910) oneline n2 = n2 + 1 onelen = trulen(oneline) ! Get length this line IF (onelen.LE.0) GOTO 200 ! Skip blank or null lines c IF (oneline(1:1).NE.BLANK .AND. oneline(1:1).NE.TAB) THEN ! New cookie IF (anyyet) THEN ! Write last cookie ncookie = ncookie + 1 WRITE (1,1,ERR=920,IOSTAT=status) ncookie,cookie(:cpos-1) nadd = nadd + 1 ENDIF c cookie = oneline ! Set up for next cookie cpos = onelen + 1 cookie(cpos:cpos) = NEWLINE cpos = cpos + 1 anyyet = .TRUE. ELSE ! Add another line to this cookie IF (cpos.LE.1) THEN ! This cookie already too big WRITE (6,3) ELSE ! Check if this line fits IF (cpos+onelen+1.GE.MAXSIZ) THEN ! Too big ! WRITE (6,4) n2 cpos = 0 anyyet = .FALSE. ELSE ! Add it in cookie(cpos:) = oneline cpos = cpos + onelen cookie(cpos:cpos) = NEWLINE cpos = cpos + 1 ENDIF ENDIF ENDIF c GOTO 200 299 ncookie = ncookie + 1 ! Write the last cookie nadd = nadd + 1 WRITE (1,1,ERR=920,IOSTAT=status) ncookie,cookie(:cpos-1) c WRITE (6,5) nadd CLOSE (2) c c Update Record 0 : Number of cookies total. c 300 IF (nadd.GT.0) THEN READ (1,9,KEY='0000') junk,oldnum REWRITE (1,9) junk,ncookie ENDIF RETURN c 900 WRITE (6,6) cmdline RETURN c 910 WRITE (6,7) cmdline,n2 GOTO 300 c 920 CALL ERRSNS(status,rmssts,rmsstv,iunit,condval) WRITE (6,8) status,rmssts,rmsstv,condval CALL SYS$GETMSG(%val(condval),msglen,sysmsg,,) WRITE (6,10) sysmsg(1:msglen) GOTO 300 c 930 WRITE (6,11) CALL EXIT(1) c 1 FORMAT (i4.4,a) 2 FORMAT (a) 3 FORMAT (' Skipping for next cookie...') 4 FORMAT (' Cookie too big at line',i) 5 FORMAT (i,' Cookies added.') 6 FORMAT (' Can''t Open ',a) 7 FORMAT (' Read error on ',a,' line',i) 8 FORMAT (' Can''t update cookie file:',4z9) 9 FORMAT (i4.4,i8) 10 FORMAT (' System says:',a) 11 FORMAT (' Insufficient privilege to modify COOKIE file') END c c ************************************************************************ c SUBROUTINE prcookie(cmdline) IMPLICIT INTEGER*4 (a-z) c PARAMETER MAXSIZ = 1920 c CHARACTER cmdline*(*) ! Remainder of command line CHARACTER cookie*(MAXSIZ) ! Holds the complete cookie CHARACTER lookup*4,now*23,dayname*10 COMMON /COOKIE_N/ ncookie,izz c FNR(i) = IFIX(RAN(izz)*i)+1 ! Random integer 1-i c c Determine number to print from commandline. If preceded by '-', then c we want n of them, otherwise we want number n. c IF (cmdline(1:1).EQ.'-') THEN enum = find_sp(cmdline,1) READ (cmdline(2:enum-1),1,ERR=900) nreq DO 100 n = 1,nreq ntry = 0 cookie = ' ' 110 this = FNR(ncookie) WRITE (lookup,2) this READ (1,3,KEY=lookup,ERR=120,IOSTAT=status) junk,clen, 4 cookie(1:clen) IF (n.GT.1) CALL lwait ! Pause between cookies IF (nreq.eq.1) THEN ! Probably from LOGON proc CALL SYS$ASCTIM(,now,,) ! Get date & time CALL LIB$GET_SYMBOL('DAY_OF_WEEK',dayname) WRITE (6,4)dayname,now ! Display ENDIF CALL lprint(this,cookie) GOTO 100 c 120 ntry = ntry + 1 IF (ntry.LE.3) GOTO 110 100 ENDDO ELSE ! Read a specific cookie cookie = ' ' enum = find_sp(cmdline,1) READ (cmdline(1:enum-1),1,ERR=900) this WRITE (lookup,2) this READ (1,3,KEY=lookup,ERR=910,IOSTAT=status) junk,clen,cookie(1:clen) CALL lprint(this,cookie) ENDIF c RETURN c 900 WRITE (6,5) cmdline RETURN c 910 WRITE (6,6) this RETURN 1 FORMAT (i) 2 FORMAT (i4.4) 3 FORMAT (i4,q,a) 4 FORMAT (' Today is ',a,' ',a) 5 FORMAT (' Invalid cookie number:',a) 6 FORMAT (' No such cookie #',i) END c c ************************************************************************ c SUBROUTINE lprint(this,cookie) IMPLICIT INTEGER*4 (a-z) c PARAMETER NEWLINE = CHAR(10) c CHARACTER cookie*(*) CHARACTER oneline*132 c WRITE (6,3) this ! Print the number cpos = 1 DO WHILE (locate(cookie,cpos,NEWLINE).gt.0) eol = locate(cookie,cpos,NEWLINE) - 1 oneline = cookie(cpos:eol) cpos = eol + 2 onelen = trulen(oneline) write(6,4) oneline(:onelen) ENDDO oneline = cookie(cpos:) IF (trulen(oneline).GT.0) WRITE (6,4) oneline c RETURN c 3 FORMAT (' #',i5) 4 FORMAT (1x,a) END c c ************************************************************************ c SUBROUTINE searchcookie(cmdline) IMPLICIT INTEGER*4 (a-z) c PARAMETER MAXSIZ = 1920 c CHARACTER cmdline*(*) CHARACTER cookie*(MAXSIZ),upcookie*(MAXSIZ) c c Close and reopen the cookie file in readonly mode, sequential access. c CLOSE (1) OPEN (UNIT=1,FILE='SYS$MANAGER:COOKIE.IDX',STATUS='OLD', 4 READONLY,ACCESS='SEQUENTIAL') c c Read every darned cookie and see if it has the search string embedded. c CALL STR$UPCASE(cmdline,cmdline) cend = trulen(cmdline) ! Get length of string READ (1,1,END=900,ERR=910,IOSTAT=status)junk,ncookie ! Skip header c npr = 0 ! number found DO n = 1,ncookie READ (1,2,END=900,ERR=910,IOSTAT=status)junk,clen,cookie(1:clen) CALL STR$UPCASE(upcookie,cookie) IF (INDEX(upcookie(1:clen),cmdline(1:cend)).GT.0) THEN cookie(clen+1:) = ' ' IF (npr.GT.0) CALL lwait ! pause between cookies npr = npr + 1 CALL lprint(n,cookie) ENDIF ENDDO c RETURN c 900 STOP 1 910 STOP 2 1 FORMAT (i4,i8) 2 FORMAT (i4,q,a) END c c ************************************************************************ c SUBROUTINE lwait IMPLICIT INTEGER*4 (a-z) c WRITE (6,1) READ (5,2,END=900,ERR=900) c RETURN c 900 CALL EXIT c 1 FORMAT (' Press return for more...',$) 2 FORMAT (1x) END