kenw@noah.arc.CDN (Ken Wallewein) (08/23/87)
$ File_is="DUPS.BAS"
$ Check_Sum_is=537551969
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X1 ! grpDUP.BAS V1.0 - PIPE DUPS FINDER !
X ON ERROR GOTO 32000
X
X EXTERNAL LONG FUNCTION LIB$GET_FOREIGN
X EXTERNAL INTEGER CONSTANT SS$_NORMAL
X
X DIM P$(31)
X
X DECLARE INTEGER CONSTANT TRUE = -1
X DECLARE INTEGER CONSTANT FALSE = 0
X
X DECLARE INTEGER CONSTANT INP = 1
X DECLARE INTEGER CONSTANT OUT = 2
X DECLARE INTEGER CONSTANT ECH = 3
X
X COMMAND_BUFFER$ = SPACE$(80)
X
X OPEN "SYS$OUTPUT" FOR OUTPUT AS FILE #OUT, &
X RECORDSIZE 132
X OPEN "SYS$COMMAND" AS FILE #ECH
X
X10 STATUS% = LIB$GET_FOREIGN(COMMAND_BUFFER$,,COMMAND_LENGTH%)
X IF STATUS% <> SS$_NORMAL
X THEN
X PRINT #ECH, '%GET_COMMAND error'; STATUS%
X GOTO 32767
X END IF
X
X CMD_CNT% = 0%
X
X IF COMMAND_LENGTH% > 0%
X THEN
X
X COMMAND$ = LEFT$(COMMAND_BUFFER$,COMMAND_LENGTH%) + ' '
X
X OS% = 0%
X S% = INSTR(OS%+1%,COMMAND$,' ')
X
X WHILE S% > 0%
X CMD_CNT% = CMD_CNT%+1%
X P$(CMD_CNT%) = MID$(COMMAND$,OS%+1%,S%-OS%-1%)
X OS% = S%
X S% = INSTR(OS%+1%,COMMAND$,' ')
X NEXT
X
X END IF
X
X ! START AND END OF COMPARE
X START% = VAL(P$(1%))
X LENGTH% = VAL(P$(2%))
X IF LENGTH% = 0%
X THEN
X LENGTH% = 999%
X END IF
X
X SAVED_LINE$ = ""
X SAVED_SUBSTR$ = ""
X SAVED_LINE_WRITTEN% = FALSE
X
X LINLEN% = 0%
X MAXLEN% = 128%
X
X100 LINPUT LINE$
X SUBSTR$ = MID$(LINE$,START%,LENGTH%)
X IF SUBSTR$ = SAVED_SUBSTR$
X THEN
X IF NOT SAVED_LINE_WRITTEN%
X THEN
X PRINT #OUT
X PRINT #OUT, SAVED_LINE$; " ";
X LINLEN% = LEN(SAVED_LINE$)+3%
X SAVED_LINE_WRITTEN% = TRUE
X END IF
X IF LINLEN%+LEN(LINE$) > MAXLEN%
X THEN
X PRINT #OUT, "-"
X LINLEN%=0%
X END IF
X PRINT #OUT, LINE$; " ";
X LINLEN% = LINLEN%+LEN(LINE$)+3%
X ELSE
X SAVED_LINE$ = LINE$
X SAVED_SUBSTR$ = SUBSTR$
X SAVED_LINE_WRITTEN% = FALSE
X END IF
X
X GOTO 100
X
X
X32000 ! ERROR TRAPS
X
X IF ERR=11 ! NORMAL EOF?
X THEN
X IF ERL=100
X THEN
X PRINT #OUT
X RESUME 32767
X END IF
X END IF
X
X32100 ON ERROR GOTO 0 ! FATAL ERRORS
X
X32767 END
X
$ GoSub Convert_File
$ File_is="DUPS.COM"
$ Check_Sum_is=1531336782
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X! NODUPS.COM - REMOVES DUPLICATE RECORDS FROM TEXT FILES
X$ DEASS SYS$INPUT
X$ DEASS SYS$OUTPUT
X$ IF F$LOGICAL("PIPE_INPUT") .NES. "" THEN ASSIGN PIPE_INPUT SYS$INPUT
X$ IF F$LOGICAL("PIPE_OUTPUT") .NES. "" THEN ASSIGN PIPE_OUTPUT SYS$OUTPUT
X!
X$ OFFSET = P1
X$ LENGTH = P2
X$ IF LENGTH .EQ. 0 THEN LENGTH = 999 ! START AND END OF COMPARE
X!
X$ SAVED_SUBSTR = ""
X!
X$READ: READ/END=DONE SYS$INPUT LINE
X$ SUBSTR = F$EXTRACT(OFFSET,LENGTH,LINE)
X$ IF SUBSTR .EQS. SAVED_SUBSTR THEN GOTO READ
X$ SAVED_SUBSTR = SUBSTR
X$ WRITE SYS$OUTPUT LINE
X$ GOTO READ
X$DONE:
X
$ GoSub Convert_File
$ File_is="ECHO.COM"
$ Check_Sum_is=556757182
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$! echo.COM - echo arguments
X$!
X$ WRITE SYS$OUTPUT "p1:''p1, p2:''p2, p3:''p3, p4:''p4, p5:''p5, "
X$DONE:
$ GoSub Convert_File
$ File_is="EDIT.COM"
$ Check_Sum_is=1968973785
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$! edit.COM - edit line with f$edit()
X$! - arguments: p1: list of f$edit() operation eg: trim,compress
X$!
X$ DEASS SYS$INPUT
X$ DEASS SYS$OUTPUT
X$ IF F$LOGICAL("PIPE_INPUT") .NES. "" THEN ASSIGN PIPE_INPUT SYS$INPUT
X$ IF F$LOGICAL("PIPE_OUTPUT") .NES. "" THEN ASSIGN PIPE_OUTPUT SYS$OUTPUT
X$!
X$READ: READ/END=DONE SYS$INPUT LINE
X$ WRITE SYS$OUTPUT f$edit(LINE,p1)
X$ GOTO READ
X$DONE:
$ GoSub Convert_File
$ File_is="ELEMENT.COM"
$ Check_Sum_is=1802570204
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X! element.COM - pass selected element of line
X! - delimiter: any combination spaces/tabs
X$ DEASS SYS$INPUT
X$ DEASS SYS$OUTPUT
X$ IF F$LOGICAL("PIPE_INPUT") .NES. "" THEN ASSIGN PIPE_INPUT SYS$INPUT
X
X$ IF F$LOGICAL("PIPE_OUTPUT") .NES. "" THEN ASSIGN PIPE_OUTPUT SYS$OUTPUT
X$!
X$READ: READ/END=DONE SYS$INPUT LINE
X$ WRITE SYS$OUTPUT F$ELEMENT('P1," ",F$EDIT(LINE,"COMPRESS"))
X$ GOTO READ
X$DONE:
$ GoSub Convert_File
$ File_is="EXTRACT.COM"
$ Check_Sum_is=34762435
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X! EXTRACT.COM - pass selected element of line
X!
X$ DEASS SYS$INPUT
X$ DEASS SYS$OUTPUT
X$ IF F$LOGICAL("PIPE_INPUT") .NES. "" THEN ASSIGN PIPE_INPUT SYS$INPUT
X
X$ IF F$LOGICAL("PIPE_OUTPUT") .NES. "" THEN ASSIGN PIPE_OUTPUT SYS$OUTPUT
X$!
X$READ: READ/END=DONE SYS$INPUT LINE
X$ WRITE SYS$OUTPUT F$EXTRACT('P1,'P2,LINE)
X$ GOTO READ
X$DONE:
$ GoSub Convert_File
$ File_is="FORALL.COM"
$ Check_Sum_is=1546316471
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$ SAVE_VERIFY = F$VERIFY("''SAVE_VERIFY'")
X!
X! FORALL - For all items named in filespec P1 or in a file specified
X! in P1 by "@filename", do P2, P3...
X! - I.E. FORALL *.FOR FORTRAN,
X! or FORALL @FOR.LIS FORTRAN
X!
X$ ON ERROR THEN GOTO FINISH
X$ ON CONTROL_Y THEN GOTO FINISH
X$
X$ DEASS SYS$INPUT
X$ DEASS SYS$OUTPUT
X$ IF F$LOGICAL("PIPE_INPUT") .NES. "" THEN ASSIGN PIPE_INPUT SYS$INPUT
X$ IF F$LOGICAL("PIPE_OUTPUT") .NES. "" THEN ASSIGN PIPE_OUTPUT SYS$OUTPUT
X$
X$ DELETE = "!" ! NULL
X$ COUNT = 0 ! ZERO
X$ NOT_INT = 1 ! .TRUE.
X$
X$ CMD := 'P2 'P3 'P4 'P5 'P6 'P7 'P8 'P9
X$
X$ P = F$LOCATE("&ITEM",CMD)
X$ IF P .GE. F$LENGTH(CMD) THEN GOTO END_INT
X$ NOT_INT = 0 !.FALSE.
X$ CMD = F$EXTRACT(0,P,CMD)+"'"+F$EXTRACT(P+1,999,CMD)
X$END_INT:
X$
X$ IF "''F$EXTRACT(0,1,P1)'" .EQS. "@" THEN GOTO OLD
X$
X$!NEW:
X$ TMPFIL = "FORALL.TMP;" ! MAKE A FRESH LIST
X$ DIRECTORY/COL:1/NOHEADER/NOTRAILER/OUTPUT:'TMPFIL 'P1
X$ P1 = TMPFIL
X$ DELETE = "DELETE ''TMPFIL'"
X$ GOTO OPEN
X$
X$OLD:
X$ P1 = F$EXTRACT(1,99,P1) ! USE AN OLD LIST
X$ P1 = F$PARSE(P1,".LIS")
X$
X$OPEN:
X$ OPEN FILE 'P1
X$
X$LOOP:
X$ READ/END=FINISH FILE ITEM
X$ IF NOT_INT THEN P10 = ITEM
X$ WRITE SYS$OUTPUT "vvvvvvvvvvvvvvvvvvvvvvvvvvvv"
X$ WRITE SYS$OUTPUT "$ ''CMD' ''P10'"
X$ 'CMD 'P10
X$ COUNT = COUNT + 1
X$ GOTO LOOP
X$
X$FINISH:
X$ SET NOON
X$ CLOSE FILE
X$ DELETE
X$ WRITE SYS$OUTPUT "Finish (''COUNT' items)"
X$ !F$VERIFY(SAVE_VERIFY)
$ GoSub Convert_File
$ File_is="MULTI.COM"
$ Check_Sum_is=543124724
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X! MULTI - HANDLE MULTIPLE COMMANDS ON ONE LINE
X!
X$ SAVE_VERIFY = F$VERIFY("''SAVE_VERIFY'")
X$
X$ ON ERROR THEN GOTO FINISH
X$ ON CONTROL_Y THEN GOTO FINISH
X$
X$ CMD := 'P1 'P2 'P3 'P4 'P5 'P6 'P7 'P8 'P9
X$ i = 0
X$
X$LOOP:
X$ part = f$element(i,"\",cmd)
X$ IF part .eqs. "\" then goto finish
X$ 'PART
X$ i = i + 1
X$ GOTO LOOP
X$
X$FINISH:
X$ !F$VERIFY(SAVE_VERIFY)
$ GoSub Convert_File
$ File_is="NOCTRL.C"
$ Check_Sum_is=891367336
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X/*
Xnoctrl.c - removes control characters from files
X - useful for looking at ascii test in object files
X*/
X
X#define EOF -1
X
Xmain()
X{
X int byte,chrcnt;
X
X chrcnt = 0;
X
X while ( ( byte = getchar() ) != EOF )
X {
X if (byte > 31 & byte < 127)
X {
X putchar( byte );
X if (chrcnt++ > 76)
X {
X printf( "\n" );
X chrcnt = 0;
X }
X }
X }
X}
X
$ GoSub Convert_File
$ File_is="NODUPS.COM"
$ Check_Sum_is=1531336782
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X! NODUPS.COM - REMOVES DUPLICATE RECORDS FROM TEXT FILES
X$ DEASS SYS$INPUT
X$ DEASS SYS$OUTPUT
X$ IF F$LOGICAL("PIPE_INPUT") .NES. "" THEN ASSIGN PIPE_INPUT SYS$INPUT
X$ IF F$LOGICAL("PIPE_OUTPUT") .NES. "" THEN ASSIGN PIPE_OUTPUT SYS$OUTPUT
X!
X$ OFFSET = P1
X$ LENGTH = P2
X$ IF LENGTH .EQ. 0 THEN LENGTH = 999 ! START AND END OF COMPARE
X!
X$ SAVED_SUBSTR = ""
X!
X$READ: READ/END=DONE SYS$INPUT LINE
X$ SUBSTR = F$EXTRACT(OFFSET,LENGTH,LINE)
X$ IF SUBSTR .EQS. SAVED_SUBSTR THEN GOTO READ
X$ SAVED_SUBSTR = SUBSTR
X$ WRITE SYS$OUTPUT LINE
X$ GOTO READ
X$DONE:
X
$ GoSub Convert_File
$ File_is="PIPE.COM"
$ Check_Sum_is=1848912641
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$ SAVE_VERIFY=F$VERIFY("''SAVE_VERIFY'") ! SET FLAG IF VERIFY SET
X!
X! PIPE.COM v2.0 - DATA PIPE SIMULATOR
X!
X! usage:
X! PIPE [<infile] [command [args...]] [>outfile] [|...]
X! e.g. PIPE D1 [*...] | SORT | DUPS >DUPLICATES.DIR
X! Note reserved symbol &LINE - allow commands like:
X! PIPE D1 | WRITE TT: &LINE | ... (sort of a "T")
X!
X$!
X$!
X$! setup definitions:
X$! symbol PIPE for command execution
X$! logical PIPE for package location (default: PIPE.COM location)
X$!
X$! there are 3 major sections:
X$! initialization - define local symbols
X$! parsing - take a command from SYS$INPUT, parse it
X$! execution - process the command
X$!
X$! bugs: work file deletion is not handled as well as it might. It is
X$! assumed that all pipe.tmp files in sys$scratch are owned by
X$! this process.
X$!
X$!
X$!Initialization
X$!==============
X$
X$ ON ERROR THEN GOTO FINISH
X$ !ON CONTROL_Y THEN GOTO FINISH
X$!
X$ TMPFILE = "SYS$SCRATCH:PIPE.TMP;
X$!
X$!
X$! FILTER symbol definitions for PIPE.COM
X$! note: this isn't the best way, but it's the fastest without global symbols
X$
X$ alldups := @pipe:alldups
X$ COU*NT := @pipe:COUNT
X$ DI*RECT := DIRECTORY/COLUMNS:1/NOHEADER/NOTRAILER
X$ DUP*S := $pipe:DUPS
X$ edit := @pipe:edit
X$ elem*ent := @pipe:element
X$ extr*act := @pipe:extract
X$ grep := SEARCH SYS$INPUT
X$ GRPDUP := $pipe:GRPDUP
X$ JUS*TIF := @pipe:JUSTIF
X$ ls := 'D1
X$ mo*re := type/page sys$input
X$ NOCT*RL := $PIPE:NOCTRL
X$ NODUP*S := @pipe:NODUPS
X$ skip := @pipe:skip
X$ tee := @pipe:tee
X$ total := @pipe:total
X$ WI*DE := $pipe:WIDE
X$ XARG*S := @pipe:FORALL @SYS$INPUT
X$!
X$!
X$!
X$!Command Parsing
X$!===============
X$!
X$ C = 1 !command number
X$ I = 0 !parameter number
X$ P = "" !current parameter
X$ CMD'C = "" !comand storage pseudo-array
X$ INPT'C = "" !input device storage pseudo-array
X$ OUPT'C = "" !output devide storage pseudo-array
X$ PIPEFILE = TMPFILE
X$
X$!parser states
X$ NEUTRAL = 3
X$ STATE = NEUTRAL
X$
X$DECODE:
X$ IF P .NES. "" THEN GOTO PARSE
X$
X$ I = I+1
X$ IF I .GT. 8 THEN GOTO DONE_DECODE
X$ P = P'I
X$ IF P .EQS. "" THEN GOTO DONE_DECODE
X$
X$ IF STATE .NE. NEUTRAL THEN GOTO PARSE
X$
X$ FC = F$EXTRACT( 0,1,P ) !get first character
X$ STATE = F$LOCATE( FC,"|<>" ) !get it's type (p<>"" here)
X$
X$ IF STATE .NE. NEUTRAL THEN -
X P = F$EXTRACT( 1,999,P ) !strip the prefix
X$
X$PARSE:
X$ GOTO TYPE_'STATE
X$
X$!
X$TYPE_0:
X$ !pipe
X$! IF CMD'C .EQS. "" THEN GOTO ERR_NO_CMD
X$ IF OUPT'C .EQS. "" THEN OUPT'C = PIPEFILE !allow ">" to override "|"
X$ OUPT = OUPT'C
X$ C = C + 1
X$ INPT'C = PIPEFILE
X$ OUPT'C = ""
X$ CMD'C = ""
X$ STATE = NEUTRAL !pass any argument back to neutral parser
X$ PIPEFILE = TMPFILE
X$ GOTO DECODE
X$
X$TYPE_1:
X$ !input redirection
X$ IF P .EQS. "" THEN GOTO DECODE
X$! IF INPT'C .NES. "" THEN GOTO ERR_RED_CONF
X$ INPT'C = P
X$ GOTO CLEAR_STATE
X$
X$TYPE_2:
X$ !output redirection
X$ IF P .EQS. "" THEN GOTO DECODE
X$! IF OUPT'C .NES. "" THEN GOTO ERR_RED_CONF
X$ OUPT'C = P
X$ PIPEFILE = "NL:"
X$ GOTO CLEAR_STATE
X$
X$TYPE_3:
X$ !command
X$ CMD'C = CMD'C + " " + P
X$
X$CLEAR_STATE:
X$ P = ""
X$ STATE = NEUTRAL !input state is satisfied
X$ GOTO DECODE
X$!
X$!
X$DONE_DECODE:
X$! IF CMD .EQS. "" THEN GOTO ERR_NO_CMD
X$ CMD'C = CMD'C + " " + P
X$!
X$!
X$!
X$!Execute the Command Line
X$!========================
X$!
X$ CMAX = C ! INIT FOR LOOP
X$ C = 1
X$ LINE = ""
X$
X$ DEASSIGN SYS$INPUT ! PREPARE FOR PIPE I/O
X$ DEASSIGN SYS$OUTPUT
X$
X$EXECUTE:
X$ IF C .GT. CMAX THEN GOTO FINISH ! DONE?
X$
X$ INPT = INPT'C ! GET COMMAND PARAMETERS
X$ OUPT = OUPT'C
X$ CMD = CMD'C
X$
X$ IF "''INPT'" .EQS. "" THEN $GOTO 1 ! PREPARE INPUT CHANNEL
X$ OPEN PIPE_INPUT 'INPT !'F$PARSE(INPT,".LIS")
X$ ASSIGN PIPE_INPUT SYS$INPUT
X$1:
X$ IF "''OUPT'" .EQS. "" THEN $GOTO 2 ! PREPARE OUTPUT CHANNEL
X$ OPEN/WRITE PIPE_OUTPUT 'OUPT !'F$PARSE(OUPT,".LIS")
X$ ASSIGN PIPE_OUTPUT SYS$OUTPUT
X$2:
X$!
X$!note the use of "&LINE" symbol - if this is in the command, assume that
X$!it should be executed multiple times (until there is no more data in the
X$!pipe)
X$!
X$ IF F$LOCATE("&LINE",CMD) .LT. F$LENGTH(CMD) THEN GOTO 2_2
X$! ! FORCE-FEED THE COMMAND?
X$2_1:
X$ 'CMD ! DO THE COMMAND
X$2_2:
X$ IF "''INPT'" .EQS. "" THEN $GOTO 2_5 ! FORCE LOOP UNTIL EOF
X$ READ/END=2_5 SYS$INPUT LINE
X$ GOTO 2_1
X$2_5:
X$ IF "''INPT'" .EQS. "" THEN $GOTO 3 ! CLEANUP FOR INPUT CHANNEL
X$ DEASSIGN SYS$INPUT
X$ CLOSE PIPE_INPUT
X$3:
X$ IF "''OUPT'" .EQS. "" THEN $GOTO 4 ! CLEANUP FOR OUTPUT CHANNEL
X$ DEASSIGN SYS$OUTPUT
X$ CLOSE PIPE_OUTPUT
X$4:
X$ C = C + 1 ! GO DO NEXT COMAND
X$ GOTO EXECUTE
X$!
X$!
X$ERR_NO_CMD:
X$ WRITE SYS$ERROR "%PIPE-E-NOCMD, command needed at P''I: ",P'I
X$ GOTO FINISH
X$
X$ERR_RED_CONF:
X$ WRITE SYS$ERROR "%PIPE-E-REDCONF, redirection conflict at P''I: ",P'I
X$ GOTO FINISH
X$
X$
X$FINISH:
X$ IF F$LOGICAL("PIPE_INPUT") .NES. "" THEN CLOSE PIPE_INPUT
X$ IF F$LOGICAL("PIPE_OUTPUT") .NES. "" THEN CLOSE PIPE_OUTPUT
X$
X$ IF F$SEARCH(TMPFILE) .NES. "" THEN DELETE 'TMPFILE'*
X$ !'F$VERIFY("''SAVE_VERIFY'") ! SET FLAG IF VERIFY SET
$ GoSub Convert_File