tldm-universe/Ardent/UV/APP.PROGS/CONVERT.PROC

$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
******************************************************************************
*
*	Convert Procs From Microdata Format to Uni*Verse
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenence log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description........................................
*	10/14/98 23801 SAP Change copyrights. 
*	06/04/96 18438 JC  Convert to NT
*	07/02/93 11629 KAM No longer hang when line is numeric or null
*   05/13/91 8345  DTM changed print to tprint
*	05/09/91 8331  DTM Fixed Enter.box.b to handle F.4
*   2/26/91  7673  DTM Added paramter to ENTER.BOX.B for case checking
*   1/13/91  7673  DTM Final changes for FCS
*	12/17/90 7673  DTM Added motif menuing, initial programming
*
*******************************************************************************
*	This subroutine will accept as an argument the value of the operation
* 	to perform.  It can perform the following functions on spooler jobs:
******************************************************************************
id = "%W%"
******************************************************************************
*	Various other variables
******************************************************************************
******************************************************************************
GOSUB init.files			;* Initialize /usr/spool/uv/sp.config
CALL *DRAW.SCRN.B(UVREADMSG(073720,""),1)
cmd=TRIM(@sentence)
word=FIELD(cmd,SPACE,1)
IF word="RUN" OR word="RAID" THEN
	cmd=FIELD(cmd,SPACE,2,99)
	word=FIELD(cmd,SPACE,1)
	IF word="APP.PROGS" OR word="BP" THEN cmd=FIELD(cmd,SPACE,2,99)
END
cmd=FIELD(cmd,SPACE,2,999)

IF cmd=NULL THEN
	scratch=UVREADMSG(073723,"")
	TPRINT @(4,3):scratch<1>:
	TPRINT @(4,4):NULL:
	TPRINT @(4,5):scratch<2>:
	TPRINT @(4,6):scratch<3>:
	TPRINT @(4,7):scratch<4>:
	TPRINT @(4,8):NULL:
	TPRINT @(4,9):scratch<5>:
	TPRINT @(4,10):scratch<6>:
	TPRINT @(4,11):scratch<7>:
	CALL *HELP.PRINT.B(UVREADMSG(073728,""),2)
loop.here:
	CALL *ENTER.BOX.B(13,4,24,UVREADMSG(073727,""),cmd,1)
	IF cmd="*" THEN GOTO loop.here
	IF cmd=NULL OR cmd=-1 THEN STOP
	flag=0
	CALL *HELP.PRINT.B(NULL,3)
	CALL *HELP.PRINT.B(UVREADMSG(073724,""),2)
	CALL *YES.NO.BOX.B(11,UVREADMSG(073725,""),flag)
	IF flag=1 THEN 
		CHAIN "PHANTOM RUN APP.PROGS CONVERT.PROC ":cmd
	END
END
IF cmd="*" THEN EXECUTE "SELECTFL" ELSE SELECT cmd TO 0
paths=NULL
LOOP
	READNEXT file ELSE exit
	READ item FROM f.voc,file THEN
		name="DICT ":file
		path=item<3>
		GOSUB convert
		IF item<5> # NULL THEN
			name="PDICT "file
			path=item<5>
			GOSUB convert
		END
		IF UPCASE(item<4>[1,1])="M" THEN
			top=item<2>
			OPENPATH top TO f.file THEN
				SSELECT f.file TO 1
				LOOP
					READNEXT sid FROM 1 ELSE EXIT
					name="DATA ":file:",":sid
					path=top:"/":sid
					GOSUB convert
				REPEAT
			END ELSE
				CALL *HELP.PRINT.B(UVREADMSG(073726,""),2)
			END
		END ELSE
			name="DATA ":file
			path=item<2>
			GOSUB convert
		END
	END
REPEAT
STOP

* Convert '\' to '/' in case of NT pathnames

convert '\' to '/' in path

convert:
	IF path="." OR path=NULL OR INDEX(path,"/",1) THEN RETURN
	LOCATE path IN paths SETTING loc THEN RETURN ELSE paths<loc>=path
	OPENPATH path THEN
		CALL *HELP.PRINT.B(UVREADMSG(073721,name),2)
		SELECT TO 2
		LOOP
			READNEXT id FROM 2 ELSE EXIT
			change = 0
			READU proc FROM id ELSE proc=NULL
			IF UPCASE(proc[1,2])="PQ" THEN
				cnt=DCOUNT(proc,@am)
				FOR i=2 TO cnt
					line=proc<i>
					len=LEN(line)
					j=1
					LOOP
						c=line[j,1]
					WHILE (j<=len) AND (c=SPACE OR c=char(9) OR NUM(c)) DO
						j += 1
					REPEAT
					BEGIN CASE
						CASE UPCASE(line[j,1]) = "X"
							line[j,i]="Q"
							proc<i>=line
							change=1
						CASE UPCASE(line[j,2]) = "IF"
							op = 0
							j += 2
							c=UPCASE(line[j,1])
							IF UPCASE(line[j,1]) = "N" THEN 
								j+=1 
								c=UPCASE(line[j,1])
							END
							IF c # SPACE AND c # char(9) THEN GOTO ill
							LOOP WHILE c=SPACE OR c=char(9) DO
								j += 1
								c=UPCASE(line[j,1])
							REPEAT
							IF c="#" THEN
								j += 1
								c=UPCASE(line[j,1])
								LOOP WHILE c=SPACE OR c=char(9) DO
									j += 1
									c=UPCASE(line[j,1])
								REPEAT
							END
							IF c="A"!c="E"!c="S"!c="!"!c="%"!c="&"!c="#"!c="@"
							THEN
								LOOP WHILE c#NULL AND c#SPACE AND c#char(9) DO
									j += 1
									c=line[j,1]
								REPEAT
							END
							ELSE 
								GOTO ill
							END
							LOOP WHILE c=SPACE OR c=char(9) DO
								j += 1
								c=line[j,1]
							REPEAT
							IF op=0 & (c="="!c="<"!c=">"!c="["!c="]"!c="#") 
							THEN
								j+=1 
								c=line[j,1]
								LOOP WHILE c=SPACE OR c=char(9) DO
									j+=1
									c=line[j,1]
								REPEAT
								LOOP 
								WHILE c#NULL AND c#SPACE AND c#char(9) DO
									k=c
									j += 1
									c=line[j,1]
									IF k='"'!k="'"!k="\"!k="(" THEN
										IF k="(" THEN k=")"
										j += 1
										c=line[j,1]
										LOOP WHILE c#NULL AND c#k DO
											j += 1
											c=line[j,1]
										REPEAT
									END
								REPEAT
							END
							LOOP WHILE c=SPACE!c=char(9) DO
								j += 1
								c=line[j,1]
							REPEAT
							IF UPCASE(c) = "X" THEN
								line[j,1]="Q"
								proc<i>=line
								change=1
							END
ill:

					END CASE
				NEXT i
				IF change THEN WRITE proc ON id ELSE release id
			END
		REPEAT
	END ELSE 
		CALL *HELP.PRINT.B(UVREADMSG(073722,path),2)
	END
	RETURN

init.files:
	OPEN "","VOC" TO f.voc ELSE
		CALL *HELP.PRINT.B(UVREADMSG(073005,"VOC"),2)
		SLEEP 1
		STOP @(-1)
	END
	RETURN

END