***************************************************************************** * * Routine to convert a uniVerse file into an SQL table * * 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. * ******************************************************************************* * * Maintenance log - insert most recent change descriptions at top * * Date.... GTAR# WHO Description........................................ * 10/14/98 23801 SAP Change copyrights. * 09/09/98 23597 TFH Avoid endless loop expanding @/@KEY/@SELECT phrases * 03/31/98 21228 TFH Justific'n = L/T/U/none and no SQLTYPE ==> VARCHAR * 07/03/97 21036 TFH If phantom, don't set "page-wait" flag * 06/03/97 20695 TFH Add "change datatype" editing feature * 05/23/97 20695 TFH Many release 9.4 changes to CONVERT.SQL (see spec) * 10/15/96 17743 TFH Convert more than 99 fields to columns (see MAXC) * 07/02/96 18760 EAP For RESTORE close files before renaming them * 03/13/96 17797 AGM Replace 'SH -c' with OS.EXEC * 01/31/95 17671 LAG Windows NT port * 12/28/95 17827 TFH Additional changes for MVASSOC option (GTAR 17669) * 12/11/95 17669 TFH Add MVASSOC option, which makes every non-associated * multi-valued field into an association * 12/08/95 17744 TFH Support GEN.SAVE option * 12/06/95 17692 TFH Identifiers starting with lowercase letter are legal * 11/14/95 17641 TFH If RESTORE, do DROP TABLE...CASCADE * 10/03/95 17438 TFH Handle format such as 12QR3E1 * 10/02/95 15808 TFH Handle format of 0L * 09/26/95 17405 TFH Handle conversion of form MD0x where x is non-digit * 06/27/95 16608 TFH Don't use @SCHEMA to find out if we're in a schema; * use proper CREATE.FILE syntax if pick-type flavor * 11/02/94 15251 TFH Remove ability to enter new filename when exiting * 10/25/94 15199 TFH Fix problem with Pick association (C;n;n;n) * 10/21/94 15164 TFH Preserve "Key" indication if an ASSOC is defined * in more than one synonym of the same field * 10/14/94 15118 TFH If LPTR, send *all* CREATE TABLE messgs to printer * 10/07/94 15090 TFH Discard dict fields with Pick correlatives; change * "SHOW" to "INFO", "P" to "S"; add SQLDEF time stamp * 09/30/94 15018 TFH Use sdml's return code to see if table was created * 09/29/94 15028 TFH Disallow the conversion of type 25 files to tables * 09/19/94 14958 TFH If SQLTYPE (in dict) contains garbage, ignore it. * 09/18/94 14942 TFH Force association columns to be multivalued, * handle single-quotes correctly in COL.HDG etc, * fix bug in check for duplicating dictionary entry * 09/08/94 14870 TFH Handle LOC = '00' or '', other minor cleanup * 09/01/94 14569 TFH Handle PICK flavor better * 08/30/94 14569 TFH Handle overlapping associations * 08/28/94 14569 TFH Make sure column and table names are unique * 08/25/94 14569 TFH Initial version * ******************************************************************************* * June 1997 * CONVERT.SQL (SQL-ization utility) * $OPTIONS DEFAULT $INCLUDE UNIVERSE.INCLUDE MACHINE.NAME * Set printer page-handling mode to pause after printing a page full of lines * (this feature is normally off in Pick-flavor accounts). **** DO THIS ONLY IF NOT RUNNING AS A PHANTOM ******************************* SYS1005 = system(1005) if not(system(25)) then assign 1 to system(1005) ****************** ** Windows NT port ** DEFFUN IS.FULLPATH(FILESPEC) CALLING "*IS.FULLPATH" DEFFUN IS.EQPATHS(FILESPEC.A, FILESPEC.B) CALLING "*IS.EQPATHS" DEFFUN GET.DIRNAME(FILESPEC) CALLING "*GET.DIRNAME" DEFFUN GET.BASENAME(FILESPEC) CALLING "*GET.BASENAME" ** ****************** prompt '' CMDNAME = "CONVERT.SQL" ; * Name of this command CURREVCODE = "REV#1" ; * Current Rev number of file format of SQLDEF file MAXSLEEP = 5 ; * Number of 2-second intervals to sleep awaiting freeing of lock MAXLINES = 1000 ; * Max number of lines in CREATE EXISTING TABLE statement TOPMAX = 500 ; * Max field number that can be converted to a column MAXC = 49 ; * Array size for storing information about every field (this is * adjusted upward if stored fields with AMC > 49 are found) MAXNEW = 49 ; *Max number of newly created dictionary column-name entries (this * is adjusted upward if stored fields with AMC > 49 are found) MAXWARN = 100 ; * Max number of warnings to be displayed when analyzing dict. WARNX = 1 ; * Next available position in the WARNINGS array FILENM = "" ARGA = "" DISP = 1 SHOW = 0 DEBUG = 0 DEBUGFIRST = 0 LPTR = 0 SAVE = 0 NEWDEF = 0 CRTAB = 0 TEST = 0 TESTEDIT = 0 CRXDONE = 0 BERX = 0 ****************** ** Windows NT port ** UV.ROOT = SYSTEM(32) ** ****************** * Determine what CREATE.FILE syntax to use FLAVOR = system(1001) if FLAVOR = 2 or FLAVOR = 8 or FLAVOR = 16 then CREATE.SYNTAX = "PICK" end else CREATE.SYNTAX = "" end * Process command line arguments get(arg.) FILENM else goto VERUSER gosub NEXTARG begin case case ARGL = "" goto VERUSER case ARGL = "TESTEDIT" ; * With this option, which is for internal testing * only, interactive editing commands can be * submitted as DATA statements in the test * paragraph; the final DATA statement should * contain the "Q" command (or "X" or "X.SAVEDATA"). * Up to 25 commands can be processed with this * mechanism. TEST = 1 BADOPT = 0 TESTEDIT = 1 dim INPUTS(26) mat INPUTS = "" INCOUNT = 1 loop LPEND = len(@DATA.PENDING) while LPEND <> 0 do input NXX while NXX # "Q" and INCOUNT <= 25 do if NXX[1,1] = "*" then continue INPUTS(INCOUNT) = NXX INCOUNT += 1 repeat INPUTS(INCOUNT) = "Q" INCOUNT = 1 case ARGL = "TEST" TEST = 1 BADOPT = 0 case ARGL = "CREATE" CRTAB = 1 BADOPT = 0 case ARGL = "INFO" or ARGL = "RESTORE" or ARGL = "RESTOREDATA" ARGA = ARGL BADOPT = 0 case LPTR = 1 BADOPT = 6 case DEBUG = 1 DEBUGFIRST = 1 end case loop until BADOPT gosub NEXTARG until ARGL = "" or BADOPT repeat if BADOPT = 1 then stop "Illegal command line argument: ":ARGL if BADOPT = 2 then stop ARGL:" option is only legal with TEST or CREATE" if BADOPT = 3 then stop "Duplicated command line argument: ":ARGL if BADOPT = 4 then stop ARGL:" option is only legal with CREATE" if BADOPT = 5 then stop "If DEBUG is first argument after filename it must be the last" end if BADOPT = 6 then stop "LPTR option is not legal as first argument after filename" end goto VERUSER * This subroutine gets the next command line argument * Output: ARGL is set to empty if there are no more command line arguments * or: ARGL contains the next command line argument if there is one * BADOPT = 0 if ARGL is a valid option; in this case, the proper * flag is set: NEWDEF, DISP, SHOW, SAVE, LPTR, or DEBUG * BADOPT = 1 if the argument (ARGL) is not a valid option keyword * BADOPT = 2 if this option (GEN, SHOW, BRIEF) is illegal w this action * BADOPT = 3 if the argument (ARGL) is a duplicated option * BADOPT = 4 if this option SAVEDATA is illegal with this action * BADOPT = 5 if DEBUG is the first argument and another arg is found NEXTARG: BADOPT = 0 ARGL = "" get(arg.) ARGL else return if DEBUGFIRST then BADOPT = 5 ; return ARGL = upcase(ARGL) begin case case ARGL = "GEN" if not(CRTAB or TEST) then BADOPT = 2 if NEWDEF then BADOPT = 3 else NEWDEF = 1 case ARGL = "BRIEF" if not(CRTAB or TEST) then BADOPT = 2 if DISP = 0 then BADOPT = 3 else DISP = 0 case ARGL = "SHOW" if not(CRTAB or TEST) then BADOPT = 2 if SHOW then BADOPT = 3 else SHOW = 1 case ARGL = "SAVEDATA" if not(CRTAB) then BADOPT = 4 if SAVE then BADOPT = 3 else SAVE = 1 case ARGL = "LPTR" if LPTR then BADOPT = 3 else LPTR = 1 case ARGL = "DEBUG" if DEBUG then BADOPT = 3 else DEBUG = 1 case 1 BADOPT = 1 end case return ; *from NEXTARG * Verify that user is a registered SQL user VERUSER: if LPTR then printer on AUTH = @AUTHORIZATION open "UV_USERS" to FVAR else stop "Can't open UV_USERS" read TVAR from FVAR,AUTH then close FVAR end else close FVAR stop "Can't run ":CMDNAME:": '":AUTH:"' is not an SQL User" end * Verify that this account is an SQL schema VERACCT: PATH = @PATH PATH = trim(PATH) IF OS.TYPE = "UNIX" THEN if PATH[1] = "/" then PATH = PATH[1,len(PATH)-1] END ELSE if PATH[1] = "/" OR PATH[1] = "\" then PATH = PATH[1,len(PATH)-1] END * Find out if this account is a schema; put its name (or empty) in SCH gosub Getschinfo if len(SCH) <= 0 then stop "Can't run ":CMDNAME:": '":PATH:"' is not an SQL Schema" end * Verify that user has write permission to this account's directory VERDIR: TCH = OS.EXEC: ' "': TOUCH.CMD : ' dUmMy.newSQL"' RMV = OS.EXEC: ' "' : RM.CMD : ' dUmMy.newSQL"' TVAR = "" execute TCH capturing TVAR if len(TVAR) > 1 then stop "Can't run ":CMDNAME:": No UNIX write permission on '":PATH:"'" end execute RMV capturing TVAR * Verify that user has write permission to the VOC VERVOC: VPATH = PATH:"/VOC" openpath VPATH to VOCVAR else stop "Can't run ":CMDNAME:": Can't open '":VPATH:"'" end LSLEEP = MAXSLEEP VERVOC1: if LSLEEP <= 0 then close VOCVAR stop "Can't run ":CMDNAME:": '":VPATH:"' is locked" end readu TVAR from VOCVAR,"VOC" locked LSLEEP -= 1 sleep 2 goto VERVOC1 end else close VOCVAR stop "Can't run ":CMDNAME:": Can't read from '":VPATH:"'" end write TVAR to VOCVAR,"VOC" else close VOCVAR stop "Can't run ":CMDNAME:": Can't write to '":VPATH:"'" end if ARGA = "INFO" then close VOCVAR ; goto DOINFO * Prompt for filename if no command line arguments if FILENM = "" then print "Enter Filename to be converted (or to Quit)? ": input FILENM if FILENM = "" then goto GOODBYE end * Get FILENM's VOC pointer, if possible, to support Q-pointer error message readl RVAR from VOCVAR,FILENM locked RVAR = "" end else RVAR = "" end VOCCODE = upcase(RVAR<1>[1,1]) if ARGA[1,7] # "RESTORE" then close VOCVAR ; *leave VOC open if RESTORE * Open the file, get its STATUS hush on ; *Suppress ugly message if can't open due to (eg) no SQL permission open FILENM to FVAR then hush off status FSTAT from FVAR else close FVAR stop "Can't get STATUS of file '":FILENM:"'" end end else OPSTAT = status() hush off print "Can't open file '":FILENM:"'. ": if OPSTAT = -1 and VOCCODE = "Q" then OPSTAT = -987 gosub POPERR goto GOODBYE end * Verify that the data file is on the local system FPATH = FSTAT<27,1,1> IF OS.TYPE = "UNIX" THEN if FPATH[1] = "/" then FPATH = FPATH[1,len(FPATH)-1] END ELSE if FPATH[1] = "/" OR FPATH[1] = "\" then FPATH = FPATH[1,len(FPATH)-1] END if fileinfo(FVAR,0) then if fileinfo(FVAR,12) # "" then close FVAR stop "File '":FPATH:"' is not on local system" end end else stop "File '":FPATH:"' is no longer open" end * Close the data file close FVAR * Open the dictionary, get its STATUS open "DICT",FILENM to DVAR else OPSTAT = status() print "Can't open DICT '":FILENM:"'. ": gosub POPERR goto GOODBYE end status DSTAT from DVAR else close DVAR stop "Can't get STATUS of DICT '":FILENM:"'" end * Verify that dictionary is on local system DPATH = DSTAT<27,1,1> IF OS.TYPE = "UNIX" THEN if DPATH[1] = "/" then DPATH = DPATH[1,len(DPATH)-1] END ELSE if DPATH[1] = "/" OR DPATH[1] = "\" then DPATH = DPATH[1,len(DPATH)-1] END if fileinfo(DVAR,0) then if fileinfo(DVAR,12) # "" then close DVAR stop "Dictionary '":DPATH:"' is not on local system" end end else stop "Dictionary '":DPATH:"' is no longer open" end if DEBUG then print "PATH is ":PATH print "FPATH is ":FPATH print "DPATH is ":DPATH end * At this point, the dictionary file is open (to DVAR) if ARGA[1,7] # "RESTORE" then goto ANALYZE * RESTORE and RESTOREDATA options * At this point, the VOC file is open (to VOCVAR) * Close the file's dictionary close DVAR * Check to verify that the file is an SQL table if FSTAT<29,1,1> = 0 then close VOCVAR stop "Can't do RESTORE option because '":FILENM:"' is not a table" end * Check that _SQLDEF exists DEFNM = change(FILENM," ","_"):"_SQLDEF" readl SVAR from VOCVAR,DEFNM else close VOCVAR stop "Can't do RESTORE option because '":DEFNM:"' doesn't exist" end release VOCVAR,DEFNM * See if _SQLSAVE exists (keep info in ZVAR) SAVNM = change(FILENM," ","_"):"_SQLSAVE" readl ZVAR from VOCVAR,SAVNM then release VOCVAR,SAVNM end else ZVAR = "" * Close the VOC file close VOCVAR if ARGA[8,4] = "DATA" then * Check that _SQLSAVE exists if ZVAR = "" then stop "Can't do RESTOREDATA option because '":SAVNM:"' doesn't exist" end * Open the SQLSAVE file to VVAR and its dict to DVVAR (locking both) gosub OPENSAVE if OPENERR then stop ; * no message needed, OPENSAVE already produced one end * Open the SQLDEF file to NVAR and its dict to DNVAR (locking both) gosub OPENDEF if OPENERR then if ARGA[8,4] = "DATA" then fileunlock VVAR ; close VVAR fileunlock DVVAR ; close DVVAR end stop ; * no message needed, OPENDEF already produced one end * Issue the CREATE EXISTING TABLE...RESTORE command CRXDEF = 'CREATE EXISTING TABLE "':change(FILENM,'"','""'):'" RESTORE;' if LPTR then execute CRXDEF capturing CRTABOUT setting TVAR POUT = change(CRTABOUT,char(254),char(10),0,1) if POUT[1] = char(10) then POUT = POUT[1,len(POUT)-1] print POUT end else execute CRXDEF setting TVAR end * Check to see if CREATE EXISTING TABLE...RESTORE failed if TVAR <> 0 then fileunlock NVAR ; close NVAR fileunlock DNVAR ; close DNVAR if ARGA[8,4] = "DATA" then fileunlock VVAR ; close VVAR fileunlock DVVAR ; close DVVAR end if TVAR <> -1 then goto NORETURN stop "Table could not be restored to a file." end * Restore the dictionary from the SQLDEF file print " Restoring DICT '":FILENM:"' (using ":DEFNM:")" open "DICT",FILENM to DVAR else OPSTAT = status() fileunlock NVAR ; close NVAR fileunlock DNVAR ; close DNVAR if ARGA[8,4] = "DATA" then fileunlock VVAR ; close VVAR fileunlock DVVAR ; close DVVAR end print "Can't open DICT '":FILENM:"'. ": gosub POPERR stop end * Copy the saved dictionary records from SQLDEF to DICT FILENM clearfile DVAR SELNX = 'SELECT ':DEFNM:' WITH NOT (@ID LIKE "SQL_..." AND F1 LIKE "X...")' execute SELNX capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) NOMORE = 0 loop until NOMORE readnext ATID then read DICTREC from NVAR,ATID else goto RDERR write DICTREC to DVAR,ATID else goto WRERR end else NOMORE = 1 repeat fileunlock NVAR ; close NVAR fileunlock DNVAR ; close DNVAR close DVAR * If RESTOREDATA option, restore the file's data from the SQLSAVE file if ARGA[8,4] = "DATA" then print " Restoring DATA '":FILENM:"' (using ":SAVNM:")" open FILENM to FVAR else OPSTAT = status() print "Can't open file '":FILENM:"'. ": gosub POPERR stop end * Copy the saved data records from SQLSAVE to FILENM clearfile FVAR select VVAR NOMORE = 0 loop until NOMORE readnext ATID then read DATAREC from VVAR,ATID else goto RDERR write DATAREC to FVAR,ATID else goto WRERR end else NOMORE = 1 repeat fileunlock VVAR ; close VVAR fileunlock DVVAR ; close DVVAR close FVAR end * Delete the SQLSAVE file if it exists if ZVAR # "" then print " Deleting file '":SAVNM:"'" DELSAVE = "DELETE.FILE ":SAVNM execute DELSAVE capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) end print "File restored" goto GOODBYE * INFO option DOINFO: gosub SETUPINFO CNTASD = CNTD:FILENM:CNTDD2 gosub GETCNT if CNTCNT = "" then goto GOODBYE if CNTCNT = 0 then goto DOCNTAS SUMDDD = SUMDD:FILENM:SUMDD2 execute SUMDDD capturing TVAR gosub PRINTOUT DOCNTAS: CNTASD = CNTD:FILENM:CNTAS2 gosub GETCNT if CNTCNT = "" or CNTCNT = 0 then goto GOODBYE SUMAAS = SUMAS:FILENM:SUMAS2 execute SUMAAS capturing TVAR gosub PRINTOUT goto GOODBYE ANALYZE: gosub GETDAT ; * get printable date/time in DATETIME print "Analyzing '":FILENM:"' for conversion to SQL ": if len(FILENM) < 18 then print space(18 - len(FILENM)): print DATETIME * Determine if filename is legal as a table name on this O/S IDENT = FILENM ; IDTYPE = "TABLE" ; gosub CKLEGAL if ILLEGAL then close DVAR print "File name '":FILENM:"' is not a legal table name: ":ILLEGAL stop "Create VOC entry using a legal name and then rerun ":CMDNAME end * Lock the dictionary (it will remain locked for awhile) LSLEEP = MAXSLEEP ANAL1: if LSLEEP <= 0 then close DVAR stop "Can't lock dictionary: ":DPATH end filelock DVAR locked LSLEEP -= 1 sleep 2 goto ANAL1 end * Verify that the file is not already an SQL table, and that its file Type * is valid for being an SQL table VERFVALID: if FSTAT<29,1,1> <> 0 then fileunlock DVAR close DVAR stop "File '":FPATH:"' is already an SQL table" end FTYPE = FSTAT<21,1,1> FMODSEP = "" PMODSEP = "1,2" begin case case (FTYPE >= 2 and FTYPE <= 18) FMODSEP = FSTAT<22,1,1>:" " FMODSEP := FSTAT<23,1,1> PMODSEP = FSTAT<22,1,1>:"," PMODSEP := FSTAT<23,1,1> * case FTYPE = 25 ; * In rel 8.3.1 we don't support type 25 tables case FTYPE = 30 case 1 fileunlock DVAR close DVAR stop "File '":FPATH:"' has invalid Type (":FTYPE:") for an SQL table" end case * Get file's F- or Q-record from VOC, save it (in RVAR) GETFVOC: * Open the VOC file to VOCVAR openpath VPATH to VOCVAR else fileunlock DVAR close DVAR stop "Can't run ":CMDNAME:": Can't open '":VPATH:"'" end LSLEEP = MAXSLEEP GETFVOC1: if LSLEEP <= 0 then fileunlock DVAR close DVAR close VOCVAR stop "Can't run ":CMDNAME:": '":VPATH:"' is locked" end readl RVAR from VOCVAR,FILENM locked LSLEEP -= 1 sleep 2 goto GETFVOC1 end else fileunlock DVAR close DVAR close VOCVAR stop "Can't run ":CMDNAME:": Can't read from '":VPATH:"'" end * Find out if _SQLDEF already exists (keep info in SVAR) DEFNM = change(FILENM," ","_"):"_SQLDEF" readl SVAR from VOCVAR,DEFNM else SVAR = "" * Close the VOC file close VOCVAR * Verify that the file's VOC entry is either an F-record or a Q-record VOCCODE = upcase(RVAR<1>[1,1]) if (VOCCODE # "F" and VOCCODE # "Q") then fileunlock DVAR close DVAR stop "VOC entry for '":FILENM:"' is neither an F-record nor a Q-record" end * Verify that the file (if it has an F-pointer) is not a multi-level file if VOCCODE = "F" and upcase(RVAR<4>) matches 'M...' then fileunlock DVAR close DVAR stop "File '":FPATH:"' is a multi-level file (invalid for an SQL table)" end * Prepare to create and/or delete SQLDEF file SQLDEF: DELDEF = "DELETE.FILE ":DEFNM if CREATE.SYNTAX = "PICK" then CREDEF = "CREATE.FILE ":DEFNM:" 1 1,2,3" end else CREDEF = "CREATE.FILE ":DEFNM:" 3 1 2" end if SVAR = "" then goto GENDEF ; * goto GENDEF if SQLDEF file doesn't exist * A SQLDEF file exists gosub OPENDEF ; *open the SQLDEF file to NVAR, and its dict to DNVAR if OPENERR then goto GENDEF ; * goto GENDEF if SQLDEF file doesn't exist if NEWDEF then goto DELEX if (TEST or CRTAB) then print "Using existing file '":DEFNM:"'" goto REPORT end print "File '":DEFNM:"' exists. Do you wish to overwrite? [N] ": input TVAR if not(upcase(TVAR) = "Y" or upcase(TVAR) = "YES") then goto REPORT * Delete existing SQLDEF file DELEX: print "Generating file '":DEFNM:"' ..": print ".": clearfile NVAR goto GENDEF1 * Generate new SQLDEF file GENDEF: print "Generating file '":DEFNM:"' ..": execute CREDEF capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) print ".": gosub OPENDEF ; *open the SQLDEF file to NVAR, and its dict to DNVAR if OPENERR then goto GOODBYE GENDEF1: print ".": * Create select list of original dictionary recid's into DICTLIST (used to * check for duplicate dictionary entries when creating artificial columns - * this is inefficient, but before changing it look at ALL references in code). select DVAR print ".": readlist DICTLIST else print "" gosub UCAF print "DICT '":FILENM:"' is empty. Can't convert file" execute DELDEF capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) goto GOODBYE end * Copy all records from DICT FILENM to the SQLDEF file (and determine largest * field number for a stored field while doing so, to use when creating arrays) select DICTLIST print ".": NOMORE = 0 loop until NOMORE readnext ATID then read DICTREC from DVAR,ATID else goto RDERR write DICTREC to NVAR,ATID else goto WRERR CODETEMP = upcase(DICTREC<1>[1,2]) LOCTEMP = DICTREC<2> CORRTEMP = DICTREC<8> begin case case (CODETEMP = "A" or CODETEMP = "A ") and num(LOCTEMP) if CORRTEMP # "" then LOCTEMP = 0 case (CODETEMP = "S" or CODETEMP = "S ") and num(LOCTEMP) if CORRTEMP # "" then LOCTEMP = 0 case CODETEMP[1,1] = "D" case 1 LOCTEMP = 0 end case if LOCTEMP > MAXC and LOCTEMP <= TOPMAX then MAXC = LOCTEMP+0 MAXNEW = MAXC end end else NOMORE = 1 repeat print ".": * Put useful entries in SQLDEF's dictionary (F1-F6, @, and INFX) LSLEEP = MAXSLEEP WRDICT: if LSLEEP <= 0 then print "Can't read F1 from DICT ":DEFNM:" because it is locked" fileunlock DVAR close DVAR fileunlock NVAR close NVAR fileunlock DNVAR close DNVAR goto GOODBYE end readu TVAR from DNVAR,"F1" locked LSLEEP -= 1 sleep 2 print ".": goto WRDICT end then print "...": goto MAKEDINFO end else for M = 1 to 6 FFF = "D":@FM:M:@FM:@FM:@FM:"2L":@FM:"S" GGG = "F":M write FFF to DNVAR,GGG else goto WRERR next M EEE = "D":@FM:2:@FM:@FM:@FM:"60T":@FM:"S" write EEE to DNVAR,"F2" else goto WRERR print ".": HHH = "PH":@FM:"F1 F2 F3 F4 F5 F6" ; *?? write HHH to DNVAR,"@" else goto WRERR print ".": IDESC = "IF (@ID MATCH 'SQL_A...' OR @ID MATCH 'SQL_C...'" IDESC := " OR @ID MATCH 'SQL_K...')" IDESC := " THEN F2 ELSE F2:' ':F3:' ':F4:' ':F5:' ':F6" TVAR = "I":@FM:IDESC:@FM:@FM:"SQL Table Information":@FM:"62T":@FM:"S" write TVAR to DNVAR,"INFX" else goto WRERR print ".": CDICT = "CD ":DEFNM:" INFX" execute CDICT capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) end * Create WARNINGS, KEYNAMES, ATNAMES, and SELNAMES arrays MAKEDINFO: VOCOPEN = 0 ; * This flag is used in subroutine EXPANDPH to avoid * repeatedly opening the VOC file once it has been opened dim WARNINGS (MAXWARN) mat WARNINGS = "" WARNX = 1 * Create KEYNAMES array TRYKEY: NEEDATKEY = 0 KEYLAST = 0 SEPCHAR = "" read DICTREC from NVAR,"@KEY" then if upcase(DICTREC<1>[1,2]) # "PH" then goto TRYAT end else goto TRYAT end DICTTEMP = trim(DICTREC<2>) PHNAME = "@KEY" ; gosub EXPANDPH dim KEYNAMES (TOKCNT+1,2) mat KEYNAMES = "" MSGTEMP = "" loop while DICTTEMP # "" do TOKTEMP = field(DICTTEMP," ",1) DICTTEMP = field(DICTTEMP," ",2,999) * Check for duplicated tokens in @KEY; only put one of them in KEYNAMES() if KEYLAST > 0 then for I = 1 to KEYLAST until KEYNAMES(I) = TOKTEMP next I if I <= KEYLAST then WARNINGS(WARNX) = "Duplicate token '":TOKTEMP WARNINGS(WARNX) := "' in @KEY phrase is ignored" if WARNX < MAXWARN then WARNX += 1 continue end end read RECTEMP from NVAR,TOKTEMP then CODETEMP = upcase(RECTEMP<1>[1,2]) LOCTEMP = RECTEMP<2> CORRTEMP = RECTEMP<8> KEYLAST += 1 KEYNAMES(KEYLAST,1) = TOKTEMP begin case case CODETEMP[1,1] = "I" KEYNAMES(KEYLAST,2) = "I" case (CODETEMP = "A" or CODETEMP = "A ") and num(LOCTEMP) and LOCTEMP # "" and CORRTEMP # "" KEYNAMES(KEYLAST,2) = "A" case (CODETEMP = "S" or CODETEMP = "S ") and num(LOCTEMP) and LOCTEMP # "" and CORRTEMP # "" KEYNAMES(KEYLAST,2) = "S" case 1 KEYLAST -= 1 if MSGTEMP # "" then WARNINGS(WARNX) = "@KEY token '":MSGTEMP:"' is ignored:" WARNINGS(WARNX) := ' must be I-type or Correlative' if WARNX < MAXWARN then WARNX += 1 end MSGTEMP = TOKTEMP end case end else WARNINGS(WARNX) = "@KEY token '":TOKTEMP:"' is ignored:" WARNINGS(WARNX) := ' not in dictionary' if WARNX < MAXWARN then WARNX += 1 end repeat if TOKCNT > 1 and MSGTEMP # "" then WARNINGS(WARNX) = "@KEY token '":MSGTEMP:"' is ignored:" WARNINGS(WARNX) := ' must be I-type or Correlative' if WARNX < MAXWARN then WARNX += 1 end * Put key-separator character (if any) in SEPCHAR read DICTREC from NVAR,"@KEY_SEPARATOR" then if upcase(DICTREC<1>[1,1]) = "X" then SEPCHAR = DICTREC<2>[1,1] end * Create ATNAMES array TRYAT: ATLAST = 0 SELLAST = 0 NEWATSEL = 0 USESELECT = 0 read DICTREC from NVAR,"@" else goto TRYSEL if upcase(DICTREC<1>[1,2]) = "PH" then DICTTEMP = DICTREC<2> PHNAME = "@" ; gosub EXPANDPH dim SELNAMES (TOKCNT+1,2) mat SELNAMES = "" gosub MKSELAT dim ATNAMES (TOKCNT+1,2) mat ATNAMES = mat SELNAMES ATLAST = SELLAST end * Create SELNAMES array TRYSEL: read DICTREC from NVAR,"@SELECT" else goto GOTNOSEL if upcase(DICTREC<1>[1,2]) = "PH" then DICTTEMP = DICTREC<2> PHNAME = "@SELECT" ; gosub EXPANDPH dim SELNAMES (TOKCNT+1,2) mat SELNAMES = "" gosub MKSELAT if SELLAST > 0 then goto BUILDSELD end GOTNOSEL: if ATLAST > 0 then NEWATSEL = 1 SELLAST = 0 dim SELNAMES (TOKCNT+2,2) mat SELNAMES = "" if IDSUP = 0 and KEYLAST <= 1 then DICTTEMP = "@ID" ; gosub MKSELAT * At this point SELLAST is either 0 or 1 for I = 1 to ATLAST SELNAMES(I+SELLAST,1) = ATNAMES(I,1) SELNAMES(I+SELLAST,2) = ATNAMES(I,2) next I SELLAST += I-1 end goto BUILDSELD * This subroutine fills array SELNAMES (for eventual use either as ATNAMES * or as SELNAMES) with an ordered list of tokens which represent D, I, A, * or S dictionary entries (or the speciial token @ASSOC_ROW) * Input: SELNAMES must be dim'd and mat'd * DICTTEMP contains space-separated list of tokens in proper order * Output: SELNAMES is now loaded * SELLAST contains the number of rows in SELNAMES MKSELAT: SELLAST = 0 loop while DICTTEMP # "" do TOKTEMP = field(DICTTEMP," ",1) DICTTEMP = field(DICTTEMP," ",2,999) read RECTEMP from NVAR,TOKTEMP then CODETEMP = upcase(RECTEMP<1>[1,2]) LOCTEMP = RECTEMP<2> SELLAST += 1 SELNAMES(SELLAST,1) = TOKTEMP begin case case (CODETEMP = "A" or CODETEMP = "A ") and num(LOCTEMP) and LOCTEMP # "" SELNAMES(SELLAST,2) = "A" case (CODETEMP = "S" or CODETEMP = "S ") and num(LOCTEMP) and LOCTEMP # "" SELNAMES(SELLAST,2) = "S" case (CODETEMP[1,1] = "D" or CODETEMP[1,1] = "I") SELNAMES(SELLAST,2) = CODETEMP[1,1] case 1 SELLAST -= 1 end case end else if TOKTEMP = "@ASSOC_ROW" then SELLAST += 1 SELNAMES(SELLAST,1) = TOKTEMP SELNAMES(SELLAST,2) = "Y" end end repeat return ; *from MKSELAT * Build select list of all valid D, A, and S records in dictionary * (note that A or S is invalid if 2nd character of F1 is non-blank) BUILDSELD: print ".": SELD = 'SELECT ':DEFNM:' WITH F1 LIKE "D..." ' SELD := 'OR F1 LIKE "A ..." OR F1 = "A" ' SELD := 'OR F1 LIKE "S ..." OR F1 = "S"' execute SELD capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) print ".." * Define array COLUMNS of field names MAKEARRAY: dim COLUMNS (MAXC+1,52) ;* First element is the code (D, A, or S) followed * by a multi-digit preference code (CODEX) * 2nd element is number of definitions of this field * 3rd element is field-name of this field * 4th, 5th,..elements are synonym-names mat COLUMNS = 0 COLLAST = 0 ; * Field number of last column to be created COLCNT = 0 ; * Number of columns to be created (not counting field 0) COLTOT = 0 ; * Number of fields defined (incl. AMC > MAXC, not incl. 0) * Define array ASSOCS of associations dim ASSOCS (50,MAXC+3) ;* First element is association-name * Elements 2 - MAXC+1 show which columns (1-MAXC) are * in this association; K means it is a key column * and X means that it is a non-key column * If element MAXC+2 is "X" then this assoc overlaps * a lower-numbered assoc definition * Element MAXC+3 contains information from this * association's @ASSOC_KEY X-record (if any): * S = Stable key * U = Unstable key * K = Key'd association * N = This association has no @ASSOC_KEY record mat ASSOCS = 0 ASSOCLAST = 0 ; * Number of the last association * Define array PHRASES for PHrases whose names are also in ASSOC field of dict dim PHRASES (50,MAXC+3) ; *First element is phrase-name (= assoc-name) * Elements 2 - MAXC+1 show which fields (1-MAXC) are in * this phrase; "1" means it is the first token in * the PHrase, "2" means it is the second token in * the PHrase, etc. * If element MAXC+2 is "X" then the PHrase includes a * token that is not a data field name in this file * (it might be an I-descriptor) * Element MAXC+3 is the number of data-field tokens * in the PHrase mat PHRASES = 0 * Define array NEWDICT of new (valid SQL) dictionary names to be created dim NEWDICT (MAXNEW) ; * Each element is a new name mat NEWDICT = 0 NEWLAST = 0 ; * Number of the last new dictionary name at any time * Initialize ATSELX, LEGALX, etc, which are "importance weightings" used in * deciding which dictionary definition (when there are several for the same * field) should be chosen as the basis for the column definition. * Each importance weighting must be different (9 = highest, 1 = lowest). ***** NOTE: these importance weightings must all be different *************** ATSELX = 9 ; * ATSELCODEX = 1 if fieldname is in user-supplied @SELECT phrase LEGALX = 8 ; * LEGALCODEX = 1 if fieldname is a legal identifier on this O/S MVAX = 7 ; * MVACODEX tells whether this field is in an association, etc: * MVACODEX = 0 if MULTI and AMC = 0; otherwise: * if dict entry has legal token in ASSOC field (or Pick equiv), * then = 9 if MULTI, in ASSOC phrase, is KEY in @ASSOC_KEY.assoc * = 8 if MULTI and in ASSOC phrase * = 4 if MULTI and is KEY in @ASSOC_KEY.assoc * = 3 if MULTI * = 1 if SINGLE (in which case ASSOC field is ignored) * if dict entry doesn't have legal ASSOC token (or Pick equiv), * then = 7 if MULTI and exists @ASSOC_KEY.namv for this field * = 6 if MULTI * = 5 if SINGLE TYPEX = 6 ; * TYPECODEX = 4 if dict datatype is DATE/TIME and CONV agrees * = 4 if dict datatype is DEC/NUMERIC and CONV agrees * = 3 if datatype is DATE/TIME/DEC/NUM and CONV = "" * = 2 if valid dict datatype (not DATE/TIME/DEC/NUM) * = 1 if dict datatype is DATE/TIME and CONV disagrees * = 1 if datatype is DEC/NUMERIC and CONV disagrees * = 0 if dict doesn't contain a valid SQL datatype ATKEYX = 5 ; * ATKEYCODEX = 1 if fieldname is in multi-token @KEY phrase ATX = 4 ; * ATCODEX = 1 if fieldname is in @ phrase NUMX = 3 ; * NUMCODEX = 1 if fieldname is NOT a valid SQL numeric literal ATIDX = 2 ; * ATIDCODEX = 1 if fieldname is NOT "@ID" DASX = 1 ; * DASCODEX = 3 for D-type, 2 for A-type, 1 for S-type * Initialize CODEX, used to rate different possible column-definitions. **** NOTE: CODEX must contain at least as many 0's as the largest "importance * weighting" number above (currently 5/20/97 this is 9 = ATSELX) CODEX = "000000000" * Build the COLUMNS array MAKE1: readnext ATID else goto MAKEEND if ATID[1,4] = '@Ak.' then goto MAKE1 read TVAR from NVAR,ATID else goto RDERR CODE = upcase(TVAR<1>[1,1]) *Reject A or S item with Correlative, since this is equivalent to I-type *Also reject A or S with empty LOC if (CODE = 'A' or CODE = 'S') then if len(trim(TVAR<8>)) > 0 then goto MAKE1 if len(trim(TVAR<2>)) = 0 then goto MAKE1 end LOC = trim(TVAR<2>) if (LOC = '' or LOC = 0) then LOC = '0' if len(LOC) > 1 then LOC = trim(LOC,"0","L") if not(num(LOC)) then WARNINGS(WARNX) = 'Dict entry "':ATID:'" is ignored:' WARNINGS(WARNX) := " non-numeric LOC field '":LOC:"'" if WARNX < MAXWARN then WARNX += 1 goto MAKE1 end if LOC > MAXC then WARNINGS(WARNX) = 'Dict entry "':ATID:'" is ignored:' WARNINGS(WARNX) := ' its LOC field (':LOC:') is too large' if WARNX < MAXWARN then WARNX += 1 COLTOT += 1 goto MAKE1 end AMC = LOC if LOC = 0 then LOC = MAXC+1 else if COLUMNS(LOC,2) = 0 then COLCNT += 1 COLTOT += 1 end if LOC > COLLAST then COLLAST = LOC end if COLUMNS(LOC,2) = 50 then if AMC = 0 then LOC = '0' if len(LOC) > 1 then LOC = trim(LOC,"0","L") WARNINGS(WARNX) = 'Dict entry "':ATID:'" is ignored:' WARNINGS(WARNX) := ' >50 definitions for location ':LOC if WARNX < MAXWARN then WARNX += 1 goto MAKE1 end COLUMNS(LOC,2) += 1 if CODE = "D" then SQLTYPE = TVAR<8> CONV = TVAR<3> ASSOCID = TVAR<7> MULTI = upcase(TVAR<6>[1,1]) end else SQLTYPE = TVAR<6> CONV = TVAR<7> PICKA = TVAR<4> if len(PICKA) > 2 and (PICKA[1,2] = "C;" or PICKA[1,2] = "D;") then ASSOCID = "@DC":LOC if AMC <> 0 then MULTI = "M" else MULTI = "S" end else ASSOCID = "" if TVAR<5> = "M" and AMC <> 0 then MULTI = "M" else MULTI = "S" end end if len(SQLTYPE) = 0 then TYPECODEX = "0" else SQLX = SQLTYPE gosub CONVST if CSTERR then if seq(SQLX[1,1]) <= 31 and seq(SQLX[1,1]) >= 0 then SQLX = "(hex 00-1F)" end else SQLX = "'":SQLX:"'" end WARNINGS(WARNX) = 'In dict entry "':ATID:'",' WARNINGS(WARNX) := " illegal DATATYPE ":SQLX:" is ignored" if WARNX < MAXWARN then WARNX += 1 TYPECODEX = "0" end else * See if CONV is consistent with DATATYPE in dictionary begin case case SQLTYPE = "DATE" begin case case CONV[1,1] = "D" TYPECODEX = "4" case CONV = "" TYPECODEX = "3" case 1 WARNINGS(WARNX) = 'In field "':ATID:'",' WARNINGS(WARNX) := " CONV '":CONV:"' disagrees" WARNINGS(WARNX) := " with DATATYPE '":SQLX:"'" if WARNX < MAXWARN then WARNX += 1 TYPECODEX = "1" end case case SQLTYPE = "TIME" begin case case CONV[1,2] = "MT" TYPECODEX = "4" case CONV = "" TYPECODEX = "3" case 1 WARNINGS(WARNX) = 'In field "':ATID:'",' WARNINGS(WARNX) := " CONV '":CONV:"' disagrees" WARNINGS(WARNX) := " with DATATYPE '":SQLX:"'" if WARNX < MAXWARN then WARNX += 1 TYPECODEX = "1" end case case SQLTYPE[1,3] = "DEC" or SQLTYPE[1,7] = "NUMERIC" SCALET = "0" if count(SQLTYPE,',') = 1 then SCALET = SQLTYPE[2][1,1] begin case case CONV[1,2] = "MD" or CONV[1,2] = "ML" or CONV[1,2] = "MR" gosub GETSCALE if SCALEX = SCALET then TYPECODEX = "4" end else WARNINGS(WARNX) = 'In field "':ATID:'",' WARNINGS(WARNX) := " CONV '":CONV:"' disagrees" WARNINGS(WARNX) := " with DATATYPE '":SQLX:"'" if WARNX < MAXWARN then WARNX += 1 TYPECODEX = "1" end case CONV = "" TYPECODEX = "3" case 1 WARNINGS(WARNX) = 'In field "':ATID:'",' WARNINGS(WARNX) := " CONV '":CONV:"' disagrees" WARNINGS(WARNX) := " with DATATYPE '":SQLX:"'" if WARNX < MAXWARN then WARNX += 1 TYPECODEX = "1" end case case 1 TYPECODEX = "2" end case end end if ASSOCID # "" then IDENT = ASSOCID ; IDTYPE = "ASSOC" ; gosub CKLEGAL if ILLEGAL then WARNINGS(WARNX) = 'ASSOC field of dict entry "':ATID:'" is' WARNINGS(WARNX) := ' ignored: ':ILLEGAL if WARNX < MAXWARN then WARNX += 1 goto IGNOREF7 end else if MULTI = "M" then gosub CKASSOCPH ; * find out if this ASSOCID has an assoc phrase * and if so whether ATID is in it gosub CKASSOCKEY1 ; * find out if this ASSOCID has an @ASSOC_KEY * X-record and if so whether ATID is in it if INASSOCKEY then if INASSOCPH then MVACODEX = "9" else MVACODEX = "4" end else if INASSOCPH then MVACODEX = "8" else MVACODEX = "3" end end else MVACODEX = "1" end end end else IGNOREF7: if MULTI = "M" then gosub CKASSOCKEY2 ; * find out if this ATID has an @ASSOC_KEY record if ISASSOCKEY then MVACODEX = "7" end else MVACODEX = "6" end end else MVACODEX = "5" end end if AMC = 0 and MULTI = "M" then MVACODEX = "0" end goto SELKEYCODES CKASSOCPH: INASSOCPH = 0 read APH from NVAR,ASSOCID then if upcase(APH<1>[1,2]) = "PH" then DICTTEMP = trim(APH<2>) PHNAME = ASSOCID ; gosub EXPANDPH if VOCOPEN then close VOCVAR ; VOCOPEN = 0 loop ; until DICTTEMP = "" do if ATID = field(DICTTEMP," ",1,1) then INASSOCPH = 1 until INASSOCPH DICTTEMP = field(DICTTEMP," ",2,999) repeat end end return ; *from CKASSOCPH CKASSOCKEY1: INASSOCKEY = 0 read KEYX from NVAR,"@ASSOC_KEY.":ASSOCID then if upcase(KEYX<1>[1,1]) = "X" then KEYX2 = trim(KEYX<2>) if field(KEYX2," ",1,1) = "KEY" then KEYX2 = field(KEYX2," ",2,99) loop ; until KEYX2 = "" do if ATID = field(KEYX2," ",1,1) then INASSOCKEY = 1 until INASSOCKEY KEYX2 = field(KEYX2," ",2,99) repeat end end end return ; *from CKASSOCKEY1 CKASSOCKEY2: ISASSOCKEY = 0 read KEYX from NVAR,"@ASSOC_KEY.":ATID then if upcase(KEYX<1>[1,1]) = "X" then ISASSOCKEY = 1 end return ; *from CKASSOCKEY2 SELKEYCODES: * See if column name is in user-specified @SELECT phrase gosub CKSEL if INSEL then ATSELCODEX = "1" else ATSELCODEX = "0" * See if column name is in multi-token @KEY phrase gosub CKKEY if INKEY then ATKEYCODEX = "1" else ATKEYCODEX = "0" * See if column name is in @ phrase gosub CKAT if INAT then ATCODEX = "1" else ATCODEX = "0" * See if column name is a legal SQL identifier IDENT = ATID ; IDTYPE = "COLUMN" ; gosub CKLEGAL if ILLEGAL then WARNINGS(WARNX) = 'Field name "':ATID:'" is illegal' WARNINGS(WARNX) := ' as a column name: ':ILLEGAL if WARNX < MAXWARN then WARNX += 1 LEGALCODEX = "0" end else LEGALCODEX = "1" end * See if column name is "@ID" if ATID = "@ID" then ATIDCODEX = "0" else ATIDCODEX = "1" begin case case CODE = 'D' DASCODEX = "3" case CODE = 'A' DASCODEX = "2" case CODE = 'S' DASCODEX = "1" case 1 DASCODEX = "0" end case * See if the column name is a valid SQL numeric literal if num(ATID) then NUMCODEX = "0" else NUMCODEX = "1" * Assemble the column-definition preference code (CODEX) CODEX[10-NUMX,1] = NUMCODEX CODEX[10-TYPEX,1] = TYPECODEX CODEX[10-MVAX,1] = MVACODEX CODEX[10-ATSELX,1] = ATSELCODEX CODEX[10-ATKEYX,1] = ATKEYCODEX CODEX[10-LEGALX,1] = LEGALCODEX CODEX[10-ATIDX,1] = ATIDCODEX CODEX[10-ATX,1] = ATCODEX CODEX[10-DASX,1] = DASCODEX * Make appropriate adjustments to current entry in COLUMNS() ARRAY I = COLUMNS(LOC,2)+2 if CODEX <= COLUMNS(LOC,1)[2,9] then * The current column-definition is less "preferred" than previous one COLUMNS(LOC,I) = ATID end else * The current column-definition is more "preferred" than previous one if COLUMNS(LOC,2) > 1 then COLUMNS(LOC,I) = COLUMNS(LOC,3) COLUMNS(LOC,1) = CODE:CODEX COLUMNS(LOC,3) = ATID end goto MAKE1 MAKEEND: ******* debug messages ******************* if DEBUG then print "COLUMNS() 0 through 5:" print " ": for N = 1 to 9 print COLUMNS(MAXC+1,N):", ": next N print COLUMNS(MAXC+1,10) for M = 1 to 5 print " ": for N = 1 to 9 print COLUMNS(M,N):", ": next N print COLUMNS(M,10) next M print "SELNAMES() 1 through ":SELLAST:":" for M = 1 to SELLAST print " ": print SELNAMES(M,1):", '":SELNAMES(M,2):"'" next M print "KEYNAMES() 1 through ":KEYLAST:":" for M = 1 to KEYLAST print " ": print KEYNAMES(M,1):", '":KEYNAMES(M,2):"'" next M end ******* debug messages ******************* * Create primary key definition MAKEPK: if KEYLAST > 1 then for I = 1 to KEYLAST LOC = (-1) * I ATID = KEYNAMES(I,1) if KEYNAMES(I,2) = "I" then CODE = "D" else CODE = KEYNAMES(I,2) read ATREC from NVAR,ATID else BERX = 6 ; goto BADERR ALPHID = "A" gosub CREATECOL next I goto MAKEOTHER end if COLUMNS(MAXC+1,2) <= 0 then gosub UCAF print "No record-id defined in DICT '":FILENM:"'. Can't convert file" execute DELDEF capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) goto GOODBYE end LOC = 0 CODE = COLUMNS(MAXC+1,1)[1,1] ATID = COLUMNS(MAXC+1,3) read ATREC from NVAR,ATID else goto RDERR ; *??what should I do? gosub TRIMAT if upcase(ATREC<1>[1,1]) <> CODE then BERX = 7 ; goto BADERR if ATREC<2> <> LOC then BERX = 8 ; goto BADERR ALPHID = "A" gosub CREATECOL gosub WRCOL * Create primary key synonyms MAKEPKSYN: if COLUMNS(MAXC+1,2) = 1 then goto MAKEOTHER for I = 1 to COLUMNS(MAXC+1,2)-1 LOC = 0 ATID = COLUMNS(MAXC+1,3+I) read ATREC from NVAR,ATID else goto RDERR ; *??what should I do? gosub TRIMAT if ATREC<2> <> LOC then BERX = 9 ; goto BADERR BASEID = COLUMNS(MAXC+1,3) CODE = upcase(ATREC<1>[1,1]) if ALPHID = "Z" then ALPHID = "a" else ALPHID = char(seq(ALPHID)+1) end gosub CREATECOL next I * Create remaining column definitions and synonyms MAKEOTHER: for K = 1 to COLLAST LOC = K if COLUMNS(LOC,2) <= 0 then gosub CREATENONE ; continue CODE = COLUMNS(LOC,1)[1,1] ATID = COLUMNS(LOC,3) read ATREC from NVAR,ATID else goto RDERR ; *??what should I do? gosub TRIMAT if upcase(ATREC<1>[1,1]) <> CODE then BERX = 1 ; goto BADERR if ATREC<2> <> LOC then BERX = 2 ; goto BADERR ALPHID = "A" gosub CREATECOL gosub WRCOL if COLUMNS(LOC,2) = 1 then continue for J = 1 to COLUMNS(LOC,2)-1 ATID = COLUMNS(LOC,3+J) read ATREC from NVAR,ATID else goto RDERR ; *??what should I do? gosub TRIMAT if ATREC<2> <> LOC then BERX = 3 ; goto BADERR BASEID = COLUMNS(LOC,3) CODE = ATREC<1>[1,1] if ALPHID = "Z" then ALPHID = "a" else ALPHID = char(seq(ALPHID)+1) end gosub CREATECOL next J next K if ASSOCLAST = 0 then goto WRINFO ******* debug messages ******************* if DEBUG then print "ASSOCS() 1 through 5; elements 1-9 and ":MAXC+2:":" for M = 1 to 5 print " ": for N = 1 to 9 print ASSOCS(M,N):", ": next N print "..., ":ASSOCS(M,MAXC+2) next M print "PHRASES() 1 through 5; elements 1-9, ":MAXC+2:", ":MAXC+3:":" for M = 1 to 5 print " ": for N = 1 to 9 print PHRASES(M,N):", ": next N print "..., ":PHRASES(M,MAXC+2):", ":PHRASES(M,MAXC+3) next M end ******* debug messages ******************* * Create associations MAKEASSOCS: if ASSOCLAST = 0 then goto WRINFO for K = 1 to ASSOCLAST ALPHID = char(seq("A")-1) AIX = K ASSOCID = ASSOCS(K,1) gosub CREATEASSOC next K ******* debug messages ******************* if DEBUG then print "ASSOCS() 1 through 5; elements 1-9 and ":MAXC+2:":" for M = 1 to 5 print " ": for N = 1 to 9 print ASSOCS(M,N):", ": next N print "..., ":ASSOCS(M,MAXC+2) next M end ******* debug messages ******************* WRINFO: * Create and write the SQL_SELECT record in SQLDEF file TVAR = "X":@FM if SELLAST > 0 then * Create SQL_SELECT record if there was an @SELECT or @ phrase in dict if NEWATSEL then USESELECT = 1 for I = 1 to SELLAST AMCAGAIN = 0 * First see if this @SELECT token is in @KEY if KEYLAST > 1 then for J = 1 to KEYLAST until KEYNAMES(J,1) = SELNAMES(I) next J if J <= KEYLAST then if KEYNAMES(J,2) = "FOUND" then * This can only happen if @SELECT contains the same * keypart name more than once USESELECT = 1 AMCAGAIN = 1 end else KEYNAMES(J,2) = "FOUND" end end L = COLLAST end else L = MAXC+1 end * Now see if this @SELECT token is a stored-column definition loop until L = 0 KNUM = COLUMNS(L,2) for J = 3 to 2+KNUM until COLUMNS(L,J) = SELNAMES(I) next J if J > 2+KNUM then if L = MAXC+1 then L = COLLAST else L -= 1 continue end if COLUMNS(L,1) = "FOUND" then * This can only happen if @SELECT contains more than one * field name defining the same field position (AMC) USESELECT = 1 AMCAGAIN = 1 end else COLUMNS(L,1) = "FOUND" if J <> 3 then SELNAMES(I) = COLUMNS(L,3) USESELECT = 1 end end until 1 repeat if not(AMCAGAIN) then TVAR := SELNAMES(I):" " next I if TVAR[1] = " " then TVAR = TVAR[1,len(TVAR)-1] write TVAR to NVAR,"SQL_SELECT" else goto WRERR end else * Create SQL_SELECT record if there was no @SELECT or @ phrase in dict if KEYLAST > 1 then for L = 1 to KEYLAST TVAR := KEYNAMES(L,1):" " next L end else TVAR := COLUMNS(MAXC+1,3):" " end for L = 1 to COLLAST if COLUMNS(L,2) > 0 then TVAR := COLUMNS(L,3):" " next L if TVAR[1] = " " then TVAR = TVAR[1,len(TVAR)-1] write TVAR to NVAR,"SQL_SELECT" else goto WRERR USESELECT = 1 end * Create and write the SQL_INFO record gosub GETDAT ; * get current date/time in DATETIME DSTAMP = "(SQLDEF was generated ":DATETIME:")" TVAR = "X":@FM:FILENM:@FM:COLLAST:@FM:ASSOCLAST:@FM:CURREVCODE:@FM:DSTAMP TVAR := @FM:SELLAST:@FM:KEYLAST:@FM:SEPCHAR:@FM:USESELECT:@FM:NEEDATKEY write TVAR to NVAR,"SQL_INFO" else goto WRERR * Create and write the SQL_VOC record TVAR = "X":@FM:FPATH:@FM:DPATH:@FM:VOCCODE if RVAR<5> <> "" then if RVAR<6> <> "" then TVAR := @FM:RVAR<5>:@FM:RVAR<6> else TVAR := @FM:RVAR<5> end end else if RVAR<6> <> "" then TVAR := @FM:@FM:RVAR<6> end write TVAR to NVAR,"SQL_VOC" else goto WRERR REPORT: * The SQLDEF file (NVAR) and its dict (DNVAR) are open and filelocked read INFREC from NVAR,"SQL_INFO" else goto RDERR TABNM = INFREC<2> COLLAST = INFREC<3> ASSOCLAST = INFREC<4> REVCODE = INFREC<5> DSTAMP = INFREC<6> SELLAST = INFREC<7> KEYLAST = INFREC<8> SEPCHAR = INFREC<9> USESELECT = INFREC<10> NEEDATKEY = INFREC<11> * If SQLDEF file was created with incompatible rev of CONVERT.SQL, recreate it if REVCODE # CURREVCODE then goto DELEX * Print Col and Assoc definitions if DISP is set * Build CREATE EXISTING TABLE in array CRX PINFO: dim CRX (MAXLINES+2) mat CRX = "" CRX(1) = 'CREATE EXISTING TABLE "':change(TABNM,'"','""'):'"' CRNEX = 2 * The ith element of array CRXCOL contains the line number (in the CREATE * EXISTING TABLE statement) where column i is defined; used by MKDEFASSOC dim CRXCOL (COLLAST+5) mat CRXCOL = 0 if DISP then print 'Table name: "':TABNM:'"':space(3): if len(TABNM) < 18 then print space(18 - len(TABNM)): print DSTAMP print "Columns:" end NN = "NOT NULL" PK = "PRIMARY KEY" COLFIRST = 0 * Handle multi-part primary key (case: KEYLAST > 1) if KEYLAST > 1 then PKCLAUSE = PK if SEPCHAR # "" then PKCLAUSE := " '":SEPCHAR:"'" PKCLAUSE := " (" CRX(CRNEX) = "(" for I = 1 to KEYLAST if I <= 9 then I2 = "0":I else I2 = I read DEF1 from NVAR,"SQL_K":I2 else goto RDERR NEEDQ = DEF1<2> ; gosub QFIRST DEF12 = NEEDQ if DISP then print " K":I2:" ":DEF12 PKCLAUSE := field(DEF12," ",1,1):", " findstr " ":NN in DEF12 setting FMC then CRX(CRNEX) := DEF12:"," end else CRX(CRNEX) := field(DEF12," ",1,2) if field(DEF12," ",2,1) = "DOUBLE" then CRX(CRNEX) := " ":field(DEF12," ",3,1) CRX(CRNEX) := " ":NN:" ":field(DEF12," ",4,99):"," end else CRX(CRNEX) := " ":NN:" ":field(DEF12," ",3,99):"," end end CRNEX += 1 next I PKCLAUSE = PKCLAUSE[1,len(PKCLAUSE)-2] CRX(CRNEX) = PKCLAUSE:")," CRNEX += 1 COLFIRST = 1 end LESS100 = 1 * Build sorted select list of column synonyms for columns 0 through 99, * and read first record-id from the list into SQLID. gosub BUILDSELCOL PINFO4: for I = COLFIRST to COLLAST if I <= 9 then I2 = "0":I else I2 = I read DEF1 from NVAR,"SQL_C":I2 else goto RDERR NEEDQ = DEF1<2> ; gosub QFIRST DEF12 = NEEDQ if DISP then print " ":I2:" ":DEF12 * Handle single-part primary key if I2 = "00" then NNPK = " ":NN:" ":PK:" " findstr PK in DEF12 setting FMC then CRX(CRNEX) = "(":DEF12:"," end else CRX(CRNEX) = "(":field(DEF12," ",1,2) if field(DEF12," ",2,1) = "DOUBLE" then CRX(CRNEX) := " ":field(DEF12," ",3,1) CRX(CRNEX) := NNPK:field(DEF12," ",4,99):"," end else CRX(CRNEX) := NNPK:field(DEF12," ",3,99):"," end end end else CRX(CRNEX) = DEF12:"," end PINFO3: CRXCOL(I) = CRNEX CRNEX += 1 BASEID = field(DEF1<2>," ",1,1) * If column number is > 99 and a second list hasn't been built yet, * build sorted select list of column synonyms for columns greater * than 99 and read first record-id from the list into SQLID. if I > 99 and LESS100 then LESS100 = 0 clearselect gosub BUILDSELCOL end PINFO1: if CRNEX > MAXLINES then print "Too many column/association definitions (>":MAXLINES:")" gosub UCAF goto GOODBYE end loop while SQLID # "NOMORE" do if num(SQLID[8,1]) then ALPHID = SQLID[9,1] NUMID = SQLID[6,3] end else ALPHID = SQLID[8,1] NUMID = SQLID[6,2] end while NUMID < I do readnext SQLID else SQLID = "NOMORE" repeat if SQLID = "NOMORE" or NUMID > I then continue read DEF2 from NVAR,SQLID else goto RDERR readnext SQLID else SQLID = "NOMORE" if upcase(DEF2<3>) = "D" then goto PINFO1 * Print out synonyms (but not the alphid which defines the preferred column) if DISP then if field(trim(DEF2<2>)," ",1,1) <> field(trim(DEF1<2>)," ",1,1) then NEEDQ = DEF2<2> ; gosub QFIRST print " ":I2:ALPHID:" ":NEEDQ end end goto PINFO1 next I clearselect if ASSOCLAST = 0 then goto FINCRX if DISP then print "Associations:" for I = 1 to ASSOCLAST if CRNEX > MAXLINES then print "Too many column/association definitions (>":MAXLINES:")" gosub UCAF goto GOODBYE end OLAP = 0 if I <= 9 then I2 = "0":I else I2 = I read DEF1 from NVAR,"SQL_A":I2 else goto RDERR if upcase(DEF1<3>) = "D" then continue if upcase(DEF1<3>) = "O" then OLAP = 1 else NEEDQ = DEF1<2> ; gosub QFIRST ADEF = NEEDQ if DISP then print " ":I2:" ":ADEF gosub MKDEFASSOC CRX(CRNEX) = "ASSOC ":COLDEF:"," ; CRNEX += 1 end AC = "A" ; gosub BUILDSELAC PINFO2: readnext SQLID else continue read DEF2 from NVAR,SQLID else goto RDERR ALPHID = SQLID[8,1] if (((DEF2<2> <> DEF1<2>) or OLAP) and DISP) then print " ":I2:ALPHID:" ": NEEDQ = DEF2<2> ; gosub QFIRST print NEEDQ: if OLAP then print space(6):"Overlapping association not used" else print space(6):"PHrase differs from ASSOC" end end goto PINFO2 next I * Finish the CREATE EXISTING TABLE statement * Replace trailing comma, on last column or assoc definition, by ");" FINCRX: CRL = CRX(CRNEX-1) CRX(CRNEX-1) = CRL[1,len(CRL)-1]:");" CRXDONE = 1 if WARNX > 1 then NUMAST = 43 - len(FILENM) if NUMAST < 4 then NUMAST = 4 NUMAST2 = int(NUMAST/2) NUMAST1 = NUMAST2 if NUMAST2 <> NUMAST/2 then NUMAST1 += 1 BANNER = change(space(NUMAST1)," ","*"):' Inconsistencies found in DICT "' BANNER := FILENM:'" ':change(space(NUMAST2)," ","*") print BANNER for I = 1 to WARNX-1 print " ":WARNINGS(I) next I print "****************************************************************": print "*************" end if SHOW then gosub PCRX if CRTAB then goto CRXTAB if TEST then if TESTEDIT then TEST = 0 else goto GOODBYE end * Allow user to edit the column definitions and association definitions EDIT: print "Enter C..., D..., U..., R..., ": print "R, S, X, Q, or H for Help [R]: ": if TESTEDIT then TVAR = INPUTS(INCOUNT) print TVAR INCOUNT += 1 end else input TVAR end EDIT1: * Reset SHOW and DISP in case they were changed by previous "S" typein SHOW = 0 DISP = 1 begin case * case upcase(TVAR) = "V" **?? * gosub MAKEVFLAG * goto EDIT case TVAR = "" or upcase(TVAR) = "R" goto REPORT case upcase(TVAR[1,1]) = "R" EDCOM = TVAR gosub DISPCA if EDERR then gosub PEDERR goto EDIT case upcase(TVAR) = "S" if CRXDONE then gosub PCRX goto EDIT end else SHOW = 1 DISP = 0 goto REPORT end case upcase(TVAR) = "X" CRTAB = 1 SAVE = 0 DISP = 0 goto REPORT case upcase(TVAR) = "X.SAVEDATA" CRTAB = 1 SAVE = 1 DISP = 0 goto REPORT case upcase(TVAR) = "Q" gosub UCAF goto GOODBYE case upcase(TVAR) = "H" goto HELP case upcase(TVAR) = "M" goto MOREHELP case upcase(TVAR[1,1]) = "C" CRXDONE = 0 EDCOM = TVAR gosub CHANGECA if EDERR then gosub PEDERR goto EDIT case upcase(TVAR[1,1]) = "D" CRXDONE = 0 EDCOM = TVAR gosub DELETECA if EDERR then gosub PEDERR goto EDIT case upcase(TVAR[1,1]) = "U" CRXDONE = 0 EDCOM = TVAR gosub USECA if EDERR then gosub PEDERR goto EDIT case 1 print " Invalid response" ; goto EDIT end case HELP: *print "You may now change column or association definitions:" *print " Enter V to Validate all current definitions" print " Enter C... to Change a column or association" print " Enter D... to Delete an association" print " Enter U... to Use another column or association" print " Enter R... to Redisplay a column or association" print " Enter M for More help on the above options" print " Enter R to Redisplay all current definitions (default)" print " Enter S to Show the CREATE EXISTING TABLE statement" print " Enter X to eXecute the CREATE EXISTING TABLE statement" print " Enter X.SAVEDATA to save the file's data and do the X option" print " Enter Q to Quit" print " Enter H for Help" print "What is your choice? [R] ": ; input TVAR goto EDIT1 MOREHELP: print " CCn/xx/yy[/G] changes column n, replacing string 'xx' by 'yy'" print " CKn/xx/yy[/G] changes key-part n, replacing string 'xx' by 'yy'" print " CAn/xx/yy[/G] changes association n, replacing string 'xx' by 'yy'" print " CCn T type changes datatype of column n to 'type'" print " CKn T type changes datatype of key-part n to 'type'" print " DAn deletes association n" print " UCna uses synonym 'a' as preferred definition of column n" print " UAna uses synonym 'a' as definition of association n" print " RCn redisplays column n with all of its synonyms" print " RKn redisplays key-part n" print " RAn redisplays association n" goto EDIT * Prepare to Build and Execute the CREATE EXISTING TABLE statement CRXTAB: * Delete @KEY phrase from dictionary if it needs to be changed if NEEDATKEY then read TVAR from DVAR,"@KEY" then delete DVAR,"@KEY" end fileunlock DVAR close DVAR * If SAVEDATA option, create _SQLSAVE and copy data into it if SAVE then openpath VPATH to VOCVAR else gosub UCAF stop CMDNAME:" aborted. Can't open '":VPATH:"'" end SAVNM = change(FILENM," ","_"):"_SQLSAVE" * Check if _SQLSAVE exists; if so, don't create it LSLEEP = MAXSLEEP CRXTAB1: if LSLEEP <= 0 then close VOCVAR gosub UCAF stop CMDNAME:" aborted. '":VPATH:"' is locked" end readl TVAR from VOCVAR,SAVNM locked LSLEEP -= 1 sleep 2 goto CRXTAB1 end then release VOCVAR,SAVNM CLSAVE = "CLEAR.FILE ":SAVNM print "Generating file '":SAVNM:"'" execute CLSAVE capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) goto CRXTAB2 end else release VOCVAR,SAVNM if CREATE.SYNTAX = "PICK" then CRSAVE = "CREATE.FILE ":SAVNM:" 1 ":PMODSEP:",":FTYPE end else CRSAVE = "CREATE.FILE ":SAVNM:" ":FTYPE if FMODSEP <> "" then CRSAVE := " ":FMODSEP end print "Generating file '":SAVNM:"'" execute CRSAVE capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) CRXTAB2: CPSAVE = "COPYI FROM ":FILENM:" TO ":SAVNM:" ALL" execute CPSAVE capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) close VOCVAR ; *close the VOC file end print "Preparing to create table ......" * Now build the CREATE EXISTING TABLE statement CRXDEF = CRX(1):" " for I = 2 to CRNEX-1 CRXDEF := CRX(I):" " next I CRXDEF = CRXDEF[1,len(CRXDEF)-1] TVAR = 9 * Now execute the CREATE EXISTING TABLE statement * If outputting to printer, then capture-and-print output because otherwise * sdml writes its output to error-out which goes to screen if LPTR then execute CRXDEF capturing CRTABOUT setting TVAR print change(CRTABOUT,char(254),char(10),0,1) end else execute CRXDEF setting TVAR end * Check to see if CREATE EXISTING TABLE failed if TVAR <> 0 then if TVAR <> -1 then goto NORETURN print "Table could not be created." * Silently issue a CREATE EXISTING TABLE...RESTORE command since the * table may be partially created in some error situations CRXDEF = 'CREATE EXISTING TABLE "':change(FILENM,'"','""'):'" RESTORE;' execute CRXDEF capturing CRTABOUT setting TVAR POUT = change(CRTABOUT,char(254),char(10),0,1) if POUT[1] = char(10) then POUT = POUT[1,len(POUT)-1] if DEBUG then print POUT * Silently restore the dictionary from the SQLDEF file since it might * be partially modified in some error situations open "DICT",FILENM to DVAR else goto CRXTAB5 * Copy the saved dictionary records from SQLDEF to DICT FILENM clearfile DVAR SELNX = 'SELECT ':DEFNM:' WITH NOT (@ID LIKE "SQL_..." AND F1 LIKE "X...")' execute SELNX capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) NOMORE = 0 loop until NOMORE readnext ATID then read DICTREC from NVAR,ATID else goto RDERR write DICTREC to DVAR,ATID else goto WRERR end else NOMORE = 1 repeat close DVAR goto CRXTAB5 end else * Write @SELECT record (unless no change needed) to the table's dictionary if USESELECT = "1" then read TVAR from NVAR,"SQL_SELECT" then open "DICT",FILENM to DVAR else OPSTAT = status() print "Can't open DICT '":FILENM:"'. ": gosub POPERR goto CRXTAB5 end write "PH":@FM:TVAR<2> to DVAR,"@SELECT" else goto WRERR close DVAR end end end CRXTAB5: fileunlock NVAR close NVAR fileunlock DNVAR close DNVAR GOODBYE: * I think next is unnecessary because 1005 seems to get reset anyway but... if SYS1005 = 0 then assign 0 to system(1005) stop ***************** * Subroutines * ***************** * Subroutine to put current date/time in printable format (into DATETIME) GETDAT: DATETIME = oconv(date(),'D'):" ":oconv(time(),'MT') return ; *from GETDAT * Subroutine to rewrite SQL_INFO record with new date/time stamp NEWDSTAMP: read INFREC from NVAR,"SQL_INFO" else goto RDERR gosub GETDAT INFREC<6> = " (SQLDEF last updated ":DATETIME:")" write INFREC to NVAR,"SQL_INFO" else goto WRERR return ; *from NEWDSTAMP * TRIMAT subroutine *4/29/97 All this routine does is fix up field 2. *4/29/97 It doesn't trim other fields any more. *NONO Trim all fields in ATREC and eliminate completely blank fields.NONONONO * For ATREC<2>, the location field, change empty or multiple 0's to a single 0. * Also remove leading zeros from location field. TRIMAT: * for T = 1 to 10 * ATREC = trim(ATREC) * if ATREC = " " then ATREC = "" * next T if (ATREC<2> = '' or ATREC<2> = 0) then ATREC<2> = '0' if len(ATREC<2>) > 1 then ATREC<2> = trim(ATREC<2>,"0","L") return ; *from TRIMAT * Setup for the "INFO" argument SETUPINFO: CNTD = "COUNT DICT " CNTAS2 = ' WITH CODE = "A" OR CODE LIKE "A ..."' CNTAS2 := ' OR CODE = "S" OR CODE LIKE "S ..."' CNTDD2 = ' WITH CODE LIKE "D..."' SUMDD = "SELECT BREAK.ON LOC FMT '2R' COL.HDG 'LOC'," SUMDD := " @ID FMT '18L' COL.HDG 'FIELD NAME'," SUMDD := " SM FMT '2L' COL.HDG 'SM'," SUMDD := " FORMAT FMT '4L' COL.HDG 'FMT'," SUMDD := " CONV FMT '6L' COL.HDG 'CONV'," SUMDD := " NAME FMT '24L' COL.HDG 'DISPLAY NAME'," SUMDD := " SQLTYPE FMT '16L' COL.HDG 'SQLTYPE'" SUMDD := " FROM DICT " SUMDD2 = " WHERE CODE LIKE 'D%' ORDER BY LOC HEADING " SUMDD2 := '"Type D entries from DICT ' SUMDD2 := "'F18' 'T'" SUMDD2 := '" COUNT.SUP;' SUMAS = "SELECT BREAK.ON F2 FMT '2R' COL.HDG 'LOC'," SUMAS := " @ID FMT '18L' COL.HDG 'FIELD NAME'," SUMAS := " F9 FMT '2L' COL.HDG 'TY'," SUMAS := " F10 FMT '4L' COL.HDG 'WID'," SUMAS := " F7 FMT '6L' COL.HDG 'CONV'," SUMAS := " F3 FMT '24L' COL.HDG 'DISPLAY NAME'," SUMAS := " F1 FMT '2L' COL.HDG 'AS'," SUMAS := " F8 FMT '9L' COL.HDG 'CORR'," SUMAS := " F6 FMT '3L' COL.HDG 'SQL'" SUMAS := " FROM DICT " SUMAS2 = " WHERE F1 = 'A' OR F1 LIKE 'A %' OR F1 = 'S'" SUMAS2 := " OR F1 LIKE 'S %' ORDER BY LOC HEADING " SUMAS2 := '"Type A and S entries from DICT ' SUMAS2 := "'F18' 'T'" SUMAS2 := '" COUNT.SUP;' return ; *from SETUPINFO * Print dictionary info (part of INFO option) * This subr removes ** and *** lines, press-any-key lines, clear-screen lines, * superfluous blank lines (really?), and heading lines except the first * Input is TVAR (captured output of a SELECT statement from DICT...) PRINTOUT: LOOPP = 0 HDG = 0 BLINE = 0 loop LOOPP += 1 while TVAR <> "" and LOOPP <= 999 do TVARF = field(TVAR,@FM,1,1) if seq(TVARF[1,1]) = 27 then LOOPN = 0 loop LOOPN += 1 while TVARF <> "" and TVARF[1,4] <> "Type" and LOOPN <= 99 do TVARF = TVARF[2,len(TVARF)-1] repeat end * Next takes care of INFO flavor BREAK.ON (line consists of **) if TVARF = "**" then del TVAR<1> ; continue * Next takes care of PICK flavor BREAK.ON (*** line followed by blank line) if TVARF = "***" then del TVAR<1> if trim(TVAR<1>) = "" then del TVAR<1> continue end if TVARF[1,5] = "Press" then del TVAR<1> ; continue if TVARF[1,4] = "Type" and HDG = 2 then del TVAR<1> ; continue if TVARF[1,5] = "LOC F" and HDG = 2 then del TVAR<1> ; continue print TVARF begin case case HDG = 0 if TVARF[1,4] <> "Type" and TVARF <> "" then print "Error in dictionary list output" return end else if TVARF <> "" then HDG = 1 end case HDG = 1 if TVARF[1,5] <> "LOC F" and TVARF <> "" then print "Error in dictionary list output" return end else if TVARF <> "" then HDG = 2 end end case if TVARF = "" then BLINE = 1 else BLINE = 0 del TVAR<1> repeat return ; *from PRINTOUT * Get count of number of dictionary items of type D, or of type A or S * Input is CNTASD (which is the COUNT statement ready to execute) * Output is CNTCNT: * "" means we can't COUNT this dictionary and message has been issued * else CNTCNT contains the requested COUNT (which, of course, may be 0) GETCNT: execute CNTASD capturing TVAR if TVAR[1,1] = @FM then TVAR = trim(TVAR[2,29]) else TVAR = trim(TVAR[1,29]) if count(TVAR,"records counted") <> 1 then CNTCNT = "" print "Can't count DICT '":FILENM:"'" return end CNTCNT = field(TVAR[1,29]," ",1,1) if not(num(CNTCNT)) then CNTCNT = "" print "Can't count DICT '":FILENM:"'" return end return ; *from GETCNT * Build select list to get all definitions of the nth column or association * (except the "planned" definition" * Input is: I2 (2-or-more-digit column number) * AC ("C" for column, "A" for association) BUILDSELAC: SELAC = 'SELECT ':DEFNM:' BY @ID WITH @ID LIKE "' SELAC := "'SQL_":AC:I2:"'1A...":'"' execute SELAC capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) return ; *from BUILDSELAC * Build sorted select list of all column synonyms (either columns in the * range 00 - 99 or columns with numbers greater than 99, depending on the * value of input parameter LESS100). Then read the first record-id into * SQLID, setting SQLID = "NOMORE" there are no records. BUILDSELCOL: SELAC = 'SELECT ':DEFNM:' BY @ID WITH @ID LIKE "' if LESS100 then SELAC := "'SQL_C'2N1A...":'"' end else SELAC := "'SQL_C'3N1A...":'"' end execute SELAC capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) readnext SQLID else SQLID = "NOMORE" return ; *from BUILDSELCOL * Check if a given column name is in user-specified @SELECT phrase * by consulting the SELNAMES() array. * Input: ATID is column name to be checked * Output: INSEL = 1 if there is a user-specified @SELECT and ATID is in it * INSEL = 0 otherwise CKSEL: INSEL = 0 if NEWATSEL or (SELLAST = 0) then return for I = 1 to SELLAST until SELNAMES(I,1) = ATID next I if I <= SELLAST then INSEL = 1 return ; *from CKSEL * Check if a given column name is in @KEY phrase (if @KEY contains more than * one token) by consulting the KEYNAMES() array. * Input: ATID is column name to be checked * Output: INKEY = 1 if there is a multi-token @KEY phrase and ATID is in it * INKEY = 0 otherwise CKKEY: INKEY = 0 if KEYLAST <= 1 then return for I = 1 to KEYLAST until KEYNAMES(I,1) = ATID next I if I <= KEYLAST then INKEY = 1 return ; *from CKKEY * Check if a given column name is in @ phrase by consulting ATNAMES() array. * Input: ATID is column name to be checked * Output: INAT = 1 if there is an @ phrase and ATID is in it * INAT = 0 otherwise CKAT: INAT = 0 if ATLAST <= 0 then return for I = 1 to ATLAST until ATNAMES(I,1) = ATID next I if I <= ATLAST then INAT = 1 return ; *from CKAT * Create column definition from D, A, or S type dictionary record * Builds COLDEF consisting of * * then optionally * * * * * Inputs are: ATID (record-id) * ATREC (record-contents) * CODE (D, A, or S) * LOC (field location) * Note: LOC < 0 means this is a key-part of a multi-part key; * in this case, if the field is an I-descriptor, the * value of CODE will be D CREATECOL: if LOC < 0 then LOC2 = LOC * (-1) if LOC2 <= 9 then LOC2 = "0":LOC2 end else if LOC <= 9 then LOC2 = "0":LOC else LOC2 = LOC end * Get SQLTYPE if CODE = 'D' then SQLTYPE = ATREC<8> else SQLTYPE = ATREC<6> * Get single/multi (MULTI), and get assoc info (ASSOC) MULTI = 'S' ASSOC = "" if CODE = 'D' then if ATREC<6>[1,1] = 'M' then MULTI = 'M' ASSOC = ATREC<7> if LOC <= 0 then if MULTI = 'M' then WX = 'Dict entry "':ATID:'" defines' if LOC < 0 then WX := " a Key-part" else WX := " field 0" WARNINGS(WARNX) = WX:" so its SM = 'M' is illegal" if WARNX < MAXWARN then WARNX += 1 MULTI = 'S' ASSOC = "" end else if ASSOC # "" then WX = 'Dict entry "':ATID:'" defines' if LOC < 0 then WX := " a Key-part" else WX := " field 0" WARNINGS(WARNX) = WX:" so its ASSOC '":ASSOC:"' is ignored" if WARNX < MAXWARN then WARNX += 1 ASSOC = "" end end end end else AR4 = ATREC<4> if ATREC<5> = 'M' then MULTI = 'M' if len(AR4) > 2 and (AR4[1,2] = "D;" or AR4[1,2] = "C;") then MULTI = 'M' ASSOC = AR4 end if LOC <= 0 then if ASSOC # "" then WX = 'Dict entry "':ATID:'" defines' if LOC < 0 then WX := " a Key-part" else WX := " field 0" WARNINGS(WARNX) = WX:" so its ASSOC '":ASSOC:"' is illegal" if WARNX < MAXWARN then WARNX += 1 MULTI = 'S' ASSOC = "" end else if MULTI = 'M' then WX = 'Dict entry "':ATID:'" defines' if LOC < 0 then WX := " a Key-part" else WX := " field 0" WARNINGS(WARNX) = WX:" so its SM = 'M' is illegal" if WARNX < MAXWARN then WARNX += 1 MULTI = 'S' end end end if ASSOC[1,2] = "D;" then ASSOC = "" end * Get COLHDG if CODE = 'D' then COLHDG = ATREC<4> else COLHDG = ATREC<3> * Get CONV if CODE = 'D' then CONV = ATREC<3> else CONV = ATREC<7> * Get FMT if CODE = 'D' then FMT = ATREC<5> else FMT = ATREC<10> if ATREC<9> = "" then if FMT <> "" then FMT := 'L' end else FMT := ATREC<9> end end gosub ANALFMT * At this point: SQLTYPE (from dict, may be empty) * MULTI (M or S or PK) * COLHDG (from dict, may be empty) * CONV (from dict, may be empty) * FMT (empty, , or ) * FMTJ (justification) * FMTW (width) * ASSOC (from dict, empty if A/S 'D;...') * Add info to ASSOCS array if relevant if ASSOC <> "" and MULTI = "M" then if CODE = 'D' then ASSOCID = ASSOC else ASSOCID = "@DC":LOC for I = 1 to ASSOCLAST until ASSOCS(I,1) = ASSOCID next I begin case case I > 50 WARNINGS(WARNX) = "ASSOC '":ASSOC:"' in dict entry" WARNINGS(WARNX) := ' "':ATID:'" is ignored: >50 associations' if WARNX < MAXWARN then WARNX += 1 goto CONVSQLTYPE case I > ASSOCLAST if ASSOCS(I,LOC+1) = "0" then ASSOCS(I,LOC+1) = "X" ASSOCLAST += 1 ASSOCS(I,1) = ASSOCID ASSOCS(I,MAXC+3) = "N" read KEYX from NVAR,"@ASSOC_KEY.":ASSOCID then KEYX2 = trim(KEYX<2>) begin case case upcase(KEYX<1>[1,1]) # "X" case KEYX2 = "STABLE" ASSOCS(I,MAXC+3) = "S" case KEYX2 = "UNSTABLE" ASSOCS(I,MAXC+3) = "U" case field(KEYX2," ",1,1) = "KEY" KEYX2 = field(KEYX2," ",2,999) FOUND = 0 loop ; until KEYX2 = "" do COLID = field(KEYX2," ",1,1) for L = 1 to COLLAST KNUM = COLUMNS(L,2) for J = 3 to 2+KNUM until COLUMNS(L,J) = COLID next J if J > 2+KNUM then continue FOUND = 1 ASSOCS(I,L+1) = "K" until 1 next L KEYX2 = field(KEYX2," ",2,999) repeat if FOUND then ASSOCS(I,MAXC+3) = "K" end case end read APH from NVAR,ASSOCID then if upcase(APH<1>[1,2]) = "PH" then PHRASES(I,1) = ASSOCID PHORD = 1 DICTTEMP = APH<2> PHNAME = ASSOCID ; gosub EXPANDPH if VOCOPEN then close VOCVAR ; VOCOPEN = 0 loop ; until DICTTEMP = "" do COLID = field(DICTTEMP," ",1,1) * (5/20/97) At this point I was tempted to verify that COLID actually exists * in the dictionary (else give error message), but then I realized that (a) * keywords such as HEADING may legitimately appear in an association phrase, * and furthermore (b) subroutine EXPANDPH has already purged any such tokens * from DICTTEMP. for L = 1 to COLLAST KNUM = COLUMNS(L,2) for J = 3 to 2+KNUM until COLUMNS(L,J) = COLID next J if J > 2+KNUM then continue PHRASES(I,1+L) = PHORD PHORD += 1 until 1 next L DICTTEMP = field(DICTTEMP," ",2,999) repeat PHRASES(I,MAXC+3) = PHORD-1 end end case 1 if ASSOCS(I,LOC+1) = "0" then ASSOCS(I,LOC+1) = "X" end case if CODE # 'D' then ASC2 = trim(ASSOC[3,99]) for J = 1 to 98 NEXTNUM = trim(field(ASC2,";",1)) NEXTNUM = trim(NEXTNUM,"0","L") until NEXTNUM = "" ASC2 = field(ASC2,";",2,50) if not(num(NEXTNUM)) then continue if NEXTNUM > MAXC then continue ASSOCS(I,NEXTNUM+1) = "X" next J end end * Convert SQLTYPE to correct format if it is present in dictionary CONVSQLTYPE: if len(SQLTYPE) > 0 then gosub CONVST if not(CSTERR) then goto MKDEFCOL end * Determine data type if SQLTYPE not present * (note that there is code below to handle cases where FMTW = "" even though * I don't think that can happen) MAKETYPE: if CONV = "" then begin case case FMT = "" SQLTYPE = "VARCHAR" case FMTJ = 'R' SQLTYPE = "INT" case FMTJ[1,1] = 'Q' SQLTYPE = "REAL" * If we reach this point, the Justification is L, T, or U case 1 SQLTYPE = "VARCHAR" if FMTW # "" then if FMTW > 254 and FMTW < 65536 then SQLTYPE := "(":FMTW:")" end end case end else CONV12 = upcase(CONV[1,2]) begin case case CONV12 = 'MD' or CONV12 = 'ML' or CONV12 = 'MR' gosub GETSCALE if SCALEX = "0" then SQLTYPE = "INT" else SQLTYPE = "DEC(9,":SCALEX:")" ; * Should prec always be 9?? end case CONV12 = 'MB' or CONV12 = 'MO' or CONV12 = 'MX' or CONV12 = 'NR' SQLTYPE = "INT" case CONV12[1,1] = 'Q' SQLTYPE = "REAL" case CONV12[1,1] = 'D' SQLTYPE = "DATE" case CONV12 = 'MT' SQLTYPE = "TIME" case 1 ; * There is a CONV but it isn't one of the above SQLTYPE = "VARCHAR" if FMTW # "" then if FMTW > 254 and FMTW < 65536 then SQLTYPE := "(":FMTW:")" end end case end if FMTW = "" then FMT = "" * Build column definition string MKDEFCOL: COLDEF = SQLTYPE if MULTI[1,1] = 'M' then COLDEF := " MULTIVALUED" if COLHDG # "" then USTRING = COLHDG ; gosub QSTRING COLDEF := " COL.HDG ":USTRING end if FMT # "" then USTRING = FMT ; gosub QSTRING COLDEF := " FMT ":USTRING end if CONV # "" then begin case * If type is DATE or TIME and CONV disagrees, don't emit CONV case SQLTYPE = "DATE" and CONV[1,1] # "D" case SQLTYPE = "TIME" and CONV[1,2] # "MT" case 1 USTRING = CONV ; gosub QSTRING COLDEF := " CONV ":USTRING end case end COLDEF = ATID:" ":COLDEF TVAR = "X":@FM:COLDEF if LOC < 0 then AVAR = "SQL_K":LOC2 ; * key-part of multi-part key end else AVAR = "SQL_C":LOC2:ALPHID:"_":ATID end * Write synonym (alphid) definition, or key-part definition, to SQLDEF file write TVAR to NVAR,AVAR else goto WRERR return ; *from CREATECOL * Write preferred column definition (except for key-part) to SQLDEF file WRCOL: AVAR = "SQL_C":LOC2 if LOC = 0 then TVAR<3> = COLUMNS(MAXC+1,2) end else TVAR<3> = COLUMNS(LOC,2) end write TVAR to NVAR,AVAR else goto WRERR return ; *from WRCOL * Check SQLTYPE (from dictionary) for validity and convert it to proper format * for CREATE TABLE. If invalid, set CSTERR = 1 and set SQLTYPE = "". CONVST: CSTERR = 0 SQLTYPE = change(SQLTYPE,"INTEGER","INT",1,1) SQLTYPE = change(SQLTYPE,"DECIMAL","DEC",1,1) SQLTYPE = change(SQLTYPE,"CHARACTER","CHAR",1,1) NCOMMA = count(SQLTYPE,",") begin case case SQLTYPE = "INT" case SQLTYPE = "SMALLINT" case SQLTYPE = "REAL" case SQLTYPE = "DATE" case SQLTYPE = "TIME" case SQLTYPE = "DOUBLE" SQLTYPE = "DOUBLE PRECISION" * Next 4 cases allow for commas in some SQLTYPEs case SQLTYPE[1,3] = "DEC" STYPE = "DEC" if (NCOMMA = 1 or NCOMMA = 2) then goto CST1 SQLTYPE = STYPE case SQLTYPE[1,7] = "NUMERIC" STYPE = "NUMERIC" if (NCOMMA = 1 or NCOMMA = 2) then goto CST1 SQLTYPE = STYPE case SQLTYPE[1,5] = "FLOAT" STYPE = "FLOAT" if NCOMMA = 1 then goto CST1 SQLTYPE = STYPE case SQLTYPE[1,4] = "CHAR" or SQLTYPE[1,7] = "VARCHAR" if NCOMMA = 1 then CSTNUM = field(SQLTYPE,',',2,99) begin case case not(num(CSTNUM)) SQLTYPE = "VARCHAR" case CSTNUM < 1 or CSTNUM > 65535 SQLTYPE = "VARCHAR" case CSTNUM < 255 and SQLTYPE[1,4] = "CHAR" SQLTYPE = "CHAR(":CSTNUM:")" case 1 SQLTYPE = "VARCHAR(":CSTNUM:")" end case end else if SQLTYPE[1,4] = "CHAR" then SQLTYPE = "CHAR" end else SQLTYPE = "VARCHAR" end end case 1 SQLTYPE = "" CSTERR = 1 return ; *from CONVST (SQLTYPE is bad) end case return ; *from CONVST (no error) CST1: NUM1 = field(SQLTYPE,',',2) NUM2 = field(SQLTYPE,',',3) if not(num(NUM1)) or NUM1 = "" then SQLTYPE = STYPE ; return if NUM1 < 1 or NUM1 <> int(NUM1) then SQLTYPE = STYPE ; return SQLTYPE = STYPE:"(":NUM1+0 if NCOMMA = 1 then SQLTYPE := ")" ; return if not(num(NUM2)) or NUM2 = "" then SQLTYPE := ")" ; return if NUM2 < 0 or NUM2 <> int(NUM2) then SQLTYPE := ")" ; return if NUM2 > NUM1 then NUM2 = NUM1 if NUM2 > 9 then NUM2 = 9 SQLTYPE := ",":NUM2+0:")" return ; *from CONVST (no error) * Get the scale factor from MD, ML, or MR conversion * Input: CONV contains the conversion code (already known to be MD, ML, or MR) * Output: SCALEX contains the scale as a single digit in the range 0-9 GETSCALE: if not(num(CONV[3,1])) or CONV[3,1] = "" then SCALEX = "0" ; return if not(num(CONV[4,1])) or CONV[4,1] = "" then SCALEX = CONV[3,1] end else SCALEX = CONV[4,1] end return ; *from GETSCALE * Create column definition for field which has no dictionary definition * Builds COLDEF consisting of * * * * Inputs are: LOC (field location) * CREATENONE: if LOC <= 9 then LOC2 = "0":LOC else LOC2 = LOC LEGAL = "SQL_C":LOC2 gosub CKDUPDICT * if ISDUP then VALCODE = 1 else if not(ISDUP) then NEWLAST += 1 if NEWLAST > MAXNEW then print "Too many (>":MAXNEW:") newly created dictionary names" goto GOODBYE end NEWDICT(NEWLAST) = LEGAL end COLDEF = LEGAL COLDEF := " VARCHAR MULTIVALUED" TVAR = "X":@FM:COLDEF:@FM:"1" AVAR = "SQL_C":LOC2 write TVAR to NVAR,AVAR else goto WRERR return ; *from CREATENONE * Create association definition from an entry in ASSOCS * Builds COLDEF consisting of * ( KEY, * ... ) * * Inputs are AIX (index into ASSOCS array) * ASSOCID (association name) * CREATEASSOC: if AIX <= 9 then AIX2 = "0":AIX else AIX2 = AIX COLDEF = "(" if PHRASES(AIX,1) = ASSOCID then PHZ = 1 else PHZ = 0 OLAPERR = 0 PHZERR = 0 FIRST = 1 * Check consistency of this association's definition with: * (a) the column-makeup of lower-numbered associations (ie, overlap), and * (b) a PHrase having same name (if one exists) * Set OLAPERR if there is an overlap; set PHZERR if PHrase exists and differs for J = 1 to MAXC if J <=9 then J2 = "0":J else J2 = J if ASSOCS(AIX,J+1) = 0 then if PHZ and PHRASES(AIX,J+1) <> 0 then PHZERR = 1 continue end if ASSOCS(AIX,J+1) = "K" then if AIX > 1 then for M = 1 to AIX-1 if (ASSOCS(M,J+1) # 0 and ASSOCS(M,MAXC+2) = 0) then OLAPERR = 1 next M end if PHZ and PHRASES(AIX,J+1) = 0 then PHZERR = 1 if FIRST then FIRST = 0 else COLDEF := ", " COLDEF := J2:" KEY" continue end if ASSOCS(AIX,J+1) = "X" then if AIX > 1 then for M = 1 to AIX-1 if (ASSOCS(M,J+1) # 0 and ASSOCS(M,MAXC+2) = 0) then OLAPERR = 1 next M end if PHZ and PHRASES(AIX,J+1) = 0 then PHZERR = 1 if FIRST then FIRST = 0 else COLDEF := ", " COLDEF := J2 continue end next J COLDEF := ")" if PHRASES(AIX,MAXC+2) <> 0 then PHZERR = 1 * If this association overlaps another association, mark it in ASSOCS() if OLAPERR then ASSOCS(AIX,MAXC+2) = "X" * If there is a PHrase for this association, and it agrees with the assoc * inferred from data field defs in dictionary, then order the columns in * the chosen association definition according to the PHrase ordering if (PHZ and not(PHZERR)) then gosub REORDER if ASSOCS(AIX,MAXC+3) = "S" then COLDEF = "INSERT PRESERVING ":COLDEF if ASSOCS(AIX,MAXC+3) = "U" then COLDEF = "INSERT LAST ":COLDEF CHODEF = ASSOCID:" ":COLDEF * If this association overlaps another association, mark it as overlapping * Now write out the chosen association definition to _SQLDEF * TVAR = "X":@FM:CHODEF if OLAPERR then TVAR := @FM:"O" AVAR = "SQL_A":AIX2 write TVAR to NVAR,AVAR else goto WRERR * If there is a PHrase for this association, then order the columns in the * "association-synonym" according to the PHrase ordering if PHZ then gosub REORDER if ASSOCS(AIX,MAXC+3) = "S" then COLDEF = "INSERT PRESERVING ":COLDEF if ASSOCS(AIX,MAXC+3) = "U" then COLDEF = "INSERT LAST ":COLDEF COLDEF = ASSOCID:" ":COLDEF * Now write the "assoc-synonym" definition to _SQLDEF TVAR = "X":@FM:COLDEF if ALPHID = "Z" then ALPHID = "a" else ALPHID = char(seq(ALPHID)+1) end AVAR = "SQL_A":AIX2:ALPHID:"_":ASSOCID write TVAR to NVAR,AVAR else goto WRERR return ; *from CREATEASSOC * Subroutine to reorder assoc according to PHrase ordering REORDER: COLDEF = "(" FIRST = 1 if PHRASES(AIX,MAXC+3) = 0 then goto REORD1 for I = 1 to PHRASES(AIX,MAXC+3) for J = 1 to MAXC if PHRASES(AIX,J+1) = I then if J <= 9 then J2 = "0":J else J2 = J if FIRST then FIRST = 0 else COLDEF := ", " COLDEF := J2 if ASSOCS(AIX,J+1) = "K" then COLDEF := " KEY" end goto REORD2 end next J REORD2: next I REORD1: if PHRASES(AIX,MAXC+2) <> 0 then if not(FIRST) then COLDEF := ", " COLDEF := "??" end COLDEF := ")" return ; *from REORDER * Create association definition in CREATE TABLE format * Also update column def(s) to add NOT NULL for association KEY(s) * (if not already there) * Also update column def(s) to add MULTIVALUED (if not already there) * Output is COLDEF * Inputs are: ADEF association definition with column numbers not names * CRXCOL() array of positions in CRXTAB statemt of chosen columns MKDEFASSOC: COLDEF = field(ADEF,"(",1,1):"(" ADEF = trim(field(ADEF,"(",2,99)) if ADEF[1] = ")" then ADEF = trim(ADEF[1,len(ADEF)-1]) if ADEF[3] = ",??" then ADEF = trim(ADEF[1,len(ADEF)-3]) if ADEF[4] = ", ??" then ADEF = trim(ADEF[1,len(ADEF)-4]) FIRST = 1 loop ; until dcount(ADEF,",") < 1 do CHGCOLM = 0 if FIRST then FIRST = 0 else COLDEF := ", " A2 = field(ADEF," ",1,1) ; if A2[1] = "," then A2 = A2[1,len(A2)-1] read DEF3 from NVAR,"SQL_C":A2 else goto MKDEFA1 if DEF3<2>[1,1] # '"' then DEF321 = '"':change(field(DEF3<2>," ",1,1),'"','""'):'"' end else DEF321 = field(DEF3<2>," ",1,1) COLDEF := DEF321 DEF32 = DEF321:" ":field(DEF3<2>," ",2,1) if field(DEF32," ",2,1) = "DOUBLE" then DEF32 := " ":field(DEF3<2>," ",3,1) DBL = 1 end else DBL = 0 MULTIV = " MULTIVALUED" findstr MULTIV in DEF3<2> setting FMC else DEF32 := MULTIV CHGCOLM = 1 end if field(ADEF," ",2,1)[1,3] = "KEY" then COLDEF := " KEY" findstr " ":NN in DEF3<2> setting FMC else DEF32 := " ":NN CHGCOLM = 1 end end MKDEFA1: if CHGCOLM then if DBL then DEF32 := " ":field(DEF3<2>," ",4,99):"," end else DEF32 := " ":field(DEF3<2>," ",3,99):"," end CRX(CRXCOL(trim(A2,"0","L"))) = DEF32 end ADEF = trim(field(ADEF,",",2,99)) repeat COLDEF := ")" return ; *from MKDEFASSOC * Analyze FMT and generate FMTJ (justification) and FMTW (width) ANALFMT: if FMT # "" then * put width in FMTW TVAR = FMT FMTW = "" loop until TVAR = "" or not(num(TVAR[1,1])) do FMTW := TVAR[1,1] TVAR = TVAR[2,len(TVAR)-1] repeat * If FMT doesn't specify 'width', try to get width from 'mask' if FMTW = "" then FMTW = '10' FMT9 = fmt(change(space(254)," ","9"),FMT) FMTSTAT = status() if FMTSTAT = 0 then if len(FMT9) < 255 then FMTW = len(FMT9) end end if FMTW = 0 then FMTW = '0' end else FMTW = trim(FMTW,'0','L') end if TVAR = "" then TVAR = "T" if TVAR[1,1] = "'" then * bypass quoted fill character TVAR = field(TVAR,"'",3,99) if len(TVAR) = 0 then TVAR = "T" ; *syntax error in FMT goto FMT1 end T1 = TVAR[1,1] * bypass unquoted fill character if not(T1 = 'L' or T1 = 'R' or T1 = 'T' or T1 = 'U' or T1 = 'Q') then TVAR = TVAR[2,len(TVAR)-1] if len(TVAR) = 0 then TVAR = "T" ; *syntax error in FMT end FMT1: T1 = TVAR[1,1] if (T1 = 'L' or T1 = 'R' or T1 = 'T' or T1 = 'U' or T1 = 'Q') then FMTJ = T1 TVAR = TVAR[2,len(TVAR)-1] if len(TVAR) > 0 then if TVAR[1,1] = 'L' then FMTJ = 'QL' if TVAR[1,1] = 'R' then FMTJ = 'QR' end end else if len(TVAR) > 1 then FMTJ = TVAR[2,1] else FMTJ = 'T' end end else FMTJ = 'T' FMTW = '10' end return ; *from ANALFMT * Put appropriate quotes (single or double) around a character string * Input: USTRING contains string to be quoted * Output: USTRING has been appropriately quoted QSTRING: DQUOTE = "'" if count(USTRING,"'") = 0 then goto QSEND if count(USTRING,'"') = 0 then DQUOTE = '"' ; goto QSEND USTRING = change (USTRING,"'",'"',0,1) QSEND: USTRING = DQUOTE:USTRING:DQUOTE return ; *from QSTRING * Enclose the first token of a string within double-quote-marks, and * replace every double-quote in that token by a pair of double-quotes, * if this hasn't already been done. * Input: The string to be modified is in NEEDQ * Output: The modified string is put back into NEEDQ QFIRST: if NEEDQ[1,1] # '"' then NQ1 = '"':change(field(NEEDQ," ",1),'"','""'):'"' NEEDQ = fieldstore(NEEDQ," ",1,-1,NQ1) end return ; *from QFIRST * In a phrase, recursively replace PH-tokens by their contents until no * PH-tokens remain. This subroutine is called from MAKEDINFO to process * @SELECT, @, and @KEY phrases. It is also called (from CKASSOCPH and * from within CREATECOL) to process association phrases. * NOTE: This subroutine deals with the fact that phrases may contain certain * multi-token clauses such as BREAK.SUP "text" fieldname or BY.EXP fieldname. * Input: DICTTEMP contains the original phrase * NVAR is the file-variable for the SQLDEF file (containing dict recs) * VOCOPEN is a flag indicating whether the VOC is currently open * PHNAME is the name of the PHrase being expanded * Output: At return, DICTTEMP contains only non-PH tokens * TOKCNT contains the number of tokens (used later for array size) * IDSUP = 1 if "ID.SUP" was encountered, else 0 * VOCOPEN will be set to 1 by this subroutine if it opens the VOC EXPANDPH: IDSUP = 0 loop PHF = 0 DICTT2 = "" TOKCNT = 0 DICTTEMP = trim(DICTTEMP) loop while DICTTEMP # "" do * Skip quoted string, including embedded spaces, if it is the next "token" if DICTTEMP[1,1] = '"' and count(DICTTEMP,'"') > 1 then DICTTEMP = trim(field(DICTTEMP,'"',3,999)) end else if DICTTEMP[1,1] = "'" and count(DICTTEMP,"'") > 1 then DICTTEMP = trim(field(DICTTEMP,"'",3,999)) end end TOKTEMP = field(DICTTEMP," ",1) DICTTEMP = field(DICTTEMP," ",2,999) * Skip token if same as original phrase name (GTAR 23597) if TOKTEMP = PHNAME then continue read RECTEMP from NVAR,TOKTEMP then if upcase(RECTEMP<1>[1,2]) = 'PH' then DICTT2 := " ":trim(RECTEMP<2>) PHF = 1 end else DICTT2 := " ":TOKTEMP TOKCNT += 1 end end else if TOKTEMP = "ID.SUP" then IDSUP = 1 ; goto EXP2 if TOKTEMP = "@ASSOC_ROW" then DICTT2 := " ":TOKTEMP TOKCNT += 1 goto EXP2 end if not(VOCOPEN) then openpath VPATH to VOCVAR else gosub UCAF stop "Can't open '":VPATH:"'" end VOCOPEN = 1 end LSLEEP = MAXSLEEP EXP1: if LSLEEP <= 0 then close VOCVAR gosub UCAF stop "Record '":TOKTEMP:"' in '":VPATH:"' is locked" end readl KVAR from VOCVAR,TOKTEMP locked LSLEEP -= 1 sleep 2 goto EXP1 end then release VOCVAR,TOKTEMP if upcase(KVAR<1>[1,1]) = "K" then KV2 = KVAR<2> begin case case KV2 = 12 or KV2 = 13 ; * BY or BY.DSND case KV2 = 48 or KV2 = 49 ; * BY.EXP or BY.EXP.DSND case KV2 = 303 ; * ASSOC.WITH case KV2 = 42 ; * BREAK.SUP * Skip quoted string (if present) after BREAK.SUP if DICTTEMP[1,1] = '"' and count(DICTTEMP,'"') > 1 then DICTTEMP = trim(field(DICTTEMP,'"',3,999)) end else if DICTTEMP[1,1] = "'" and count(DICTTEMP,"'") > 1 then DICTTEMP = trim(field(DICTTEMP,"'",3,999)) end end case KV2 = 18 ; * ID.SUP other spellings IDSUP = 1 goto EXP2 case 1 goto EXP2 end case * Skip fieldname after BY, BY.DSND, BY.EXP, BY.EXP.DSND, * ASSOC.WITH, and BREAK.SUP (and their alternate spellings) DICTTEMP = field(DICTTEMP," ",2,999) end end end EXP2: repeat DICTTEMP = trim(DICTT2) while PHF repeat return ; *from EXPANDPH * Subroutine to show the planned CREATE EXISTING TABLE statement PCRX: if CRNEX < 3 then print " CREATE EXISTING TABLE statement too short" return end print CRX(1) print " ":CRX(2) if CRNEX = 3 then return for I = 3 to CRNEX-1 print " ":CRX(I) next I return ; *from PCRX * Check for legal SQL quoted identifier * Input: IDENT is the identifier to be checked * IDTYPE is the type of identifier (TABLE, COLUMN, or ASSOC) * Output: if ILLEGAL = 0 then the identifier is OK * else ILLEGAL contains a reason why the identifier is illegal (NULL, * PERIOD, NTCHAR, MARKCHAR, CONTROL, SPACE, SLASHQ, or QUOTES) CKLEGAL: ILLEGAL = 0 if isnull(IDENT) then ILLEGAL = "it is SQL NULL" ; return IDCH = IDENT[1,1] if len(IDENT) = 1 and IDCH = @NULL.STR then ILLEGAL = "it is SQL NULL" return end if OS.TYPE = "UNIX" and IDCH = "." and IDTYPE = "TABLE" then ILLEGAL = "starts with Period" return end IDQ = "" NTCHAR = "contains NT-restricted character" SDQUOT = "contains both single and double Quotes" MKCHAR = "contains Mark character" loop ; until IDENT = "" do IDCH = IDENT[1,1] if OS.TYPE # "UNIX" then if IDCH = '"' or IDCH = '%' or IDCH = '*' then ILLEGAL = NTCHAR if IDCH = '\' or IDCH = ':' or IDCH = '<' then ILLEGAL = NTCHAR if IDCH = '>' then ILLEGAL = NTCHAR end if seq(IDCH) >= 251 and seq(IDCH) <= 255 then ILLEGAL = MKCHAR if seq(IDCH) >= 0 and seq(IDCH) <= 31 then ILLEGAL = "contains Hex 00-1F" if IDCH = ' ' and IDTYPE = "COLUMN" then ILLEGAL = "contains Space" if IDCH = '/' and IDTYPE = "TABLE" then ILLEGAL = "contains Slash" if IDCH = '?' and IDTYPE = "TABLE" then ILLEGAL = "contains Question mark" if IDCH = '"' and IDTYPE = "TABLE" then if IDQ = "SINGLE" then ILLEGAL = SDQUOT end else IDQ = "DOUBLE" end if IDCH = "'" and IDTYPE = "TABLE" then if IDQ = "DOUBLE" then ILLEGAL = SDQUOT end else IDQ = "SINGLE" end if ILLEGAL then return IDENT = IDENT[2,len(IDENT)-1] repeat return ; *from CKLEGAL * Check for duplicate entry in dictionary; generate non-dup name if necessary * Input string is LEGAL (new name to be checked for uniqueness in dictionary) * Output is ISDUP: if 0, then LEGAL is OK (possibly after some modification) * if 1, then we can't find a valid name after many attempts * and LEGAL is set to "NO_NAME" CKDUPDICT: gosub CDUP0 if ISDUP then gosub CRNEW if LEGAL = "" then ISDUP = 1 LEGAL = "NO_NAME" end else ISDUP = 0 end end return ; *from CKDUPDICT * Check for duplicate entry in dictionary * Input string is LEGAL (new name to be checked for uniqueness in dictionary) * Output is ISDUP: if 0, then LEGAL is OK * if 1, then LEGAL is a duplicate CDUP0: ISDUP = 0 select DICTLIST CDUP1: readnext DICTID else goto CDUP2 if DICTID = LEGAL then goto CDUP9 else goto CDUP1 CDUP2: if NEWLAST = 0 then return ; * LEGAL is OK, it doesn't duplicate anything for N = 1 to NEWLAST if NEWDICT(N) = LEGAL then goto CDUP9 next N return ; * LEGAL is OK, it doesn't duplicate anything CDUP9: ISDUP = 1 return ; *from CDUP0 with ISDUP set to 1 * Create new unique legal name for dictionary entry * Input = LEGAL (previously failed attempted new name) * Output = LEGAL: if non-empty, contains new unique legal name * if empty then we can't find a good name after many tries CRNEW: SAVLEG = LEGAL if len(SAVLEG) > 16 then SAVLEG = SAVLEG[1,16] for M = 1 to 9 LEGAL = SAVLEG:"_":char(48+M) gosub CDUP0 if not(ISDUP) then return ; * LEGAL is now OK, ending with _1 to _9 next M for M = 1 to 26 LEGAL = SAVLEG:"_":char(64+M) gosub CDUP0 if not(ISDUP) then return ; * LEGAL is now OK, ending with _A to _Z next M for M = 1 to 26 LEGAL = SAVLEG:"_":char(96+M) gosub CDUP0 if not(ISDUP) then return ; * LEGAL is now OK, ending with -a to -z next M LEGAL = "" return ; *from CRNEW - can't find good name after many tries * Subroutines to let user change a column or association definition * Input is EDCOM (the typed-in edit command) * Output is EDERR: 0 if no error * 1 if command is wrong length * 2 if column number is non-numeric * 3 if synonym-identifier is non-alphabetic * 4 if column has been deleted * 5 if illegal command * 6 if column-synonym is non-existent * 7 if column number too large * 8 if association number too large * 9 if column not found (shouldn't happen) * 10 if command not implemented yet * 11 if key-part number is < 1 * 12 if assoc number is non-numeric * 13 if no datatype was specified * 14 if assoc has been deleted (or is overlapping) * 16 if assoc-synonym is non-existent * 17 if key-part number too large * 18 if invalid datatype is entered * 19 if assoc not found (shouldn't happen) * 20 if datatype CHAR[ACTER] VARYING is entered CHANGECA: EDERR = 0 EDCOM = EDCOM[2,len(EDCOM)-1] if upcase(EDCOM[1,1]) = "A" then goto CHANGEA * Change column or key-part if upcase(EDCOM[1,1]) = "K" then EK = 1 EDCOM = EDCOM[2,len(EDCOM)-1] end else EK = 0 if upcase(EDCOM[1,1]) = "C" then EDCOM = EDCOM[2,len(EDCOM)-1] end gosub GETNUM if NUMERR and EK then EDERR = 11 ; return if NUMERR then EDERR = 2 ; return if EC2[1,1] = " " then EC2 = EC2[2,len(EC2)-1] if len(EC2) < 2 and upcase(EC2) # "T" then EDERR = 1 ; return EC3 = EC2[2,len(EC2)-1] EC2 = EC2[1,1] if EK then if I2 > KEYLAST then EDERR = 17 ; return if I2 < 1 then EDERR = 11 ; return CREC = "SQL_K":I2 end else if I2 > COLLAST then EDERR = 7 ; return if I2 < 1 and KEYLAST > 1 then EDERR = 15 ; return CREC = "SQL_C":I2 end read CDEF from NVAR,CREC else EDERR = 9 ; return DEF = CDEF<2> begin case case EC2 = "/" or EC2 = "\" if upcase(field(EC3,EC2,3)[1,1]) = "G" and field(EC3,EC2,1) # "" then NUMREP = -1 else NUMREP = 1 DEF = ereplace(DEF,field(EC3,EC2,1),field(EC3,EC2,2),NUMREP) OLDNAME = field(CDEF<2>," ",1) NEWNAME = field(DEF," ",1) gosub REWRITESEL CDEF<2> = DEF write CDEF to NVAR,CREC else goto WRERR gosub NEWDSTAMP NEEDQ = DEF ; gosub QFIRST if EK then print " K":I2:" ":NEEDQ else print " ":I2:" ":NEEDQ case upcase(EC2) = "N" if upcase(EC3[1,3]) = "AME" then EC3 = EC3[4,len(EC3)-3] NEWNAME = trim(EC3) DEF = fieldstore(DEF," ",1,-1,NEWNAME) OLDNAME = field(CDEF<2>," ",1) gosub REWRITESEL CDEF<2> = DEF write CDEF to NVAR,CREC else goto WRERR gosub NEWDSTAMP NEEDQ = DEF ; gosub QFIRST if EK then print " K":I2:" ":NEEDQ else print " ":I2:" ":NEEDQ case upcase(EC2) = "T" if upcase(EC3[1,3]) = "YPE" then EC3 = EC3[4,len(EC3)-3] NEWTYPE = upcase(trim(EC3)) TYPE2 = "" TYPEFLAG = 0 begin case case NEWTYPE = "" EDERR = 13 ; return case NEWTYPE = "DOUBLE PRECISION" or NEWTYPE = "REAL" case NEWTYPE = "SMALLINT" or NEWTYPE = "INT" or NEWTYPE = "INTEGER" case NEWTYPE = "DEC" or NEWTYPE = "DECIMAL" or NEWTYPE = "FLOAT" case NEWTYPE = "NUMERIC" or NEWTYPE = "DATE" or NEWTYPE = "TIME" case NEWTYPE = "CHAR" or NEWTYPE = "CHARACTER" or NEWTYPE = "VARCHAR" case NEWTYPE[1,12] = "CHAR VARYING" EDERR = 20 ; return case NEWTYPE[1,17] = "CHARACTER VARYING" EDERR = 20 ; return case NEWTYPE[1,5] = "FLOAT" TYPE2 = change(NEWTYPE[6,len(NEWTYPE)-5]," ","") NEWTYPE = "FLOAT" case NEWTYPE[1,7] = "VARCHAR" TYPE2 = change(NEWTYPE[8,len(NEWTYPE)-7]," ","") NEWTYPE = "VARCHAR" case NEWTYPE[1,9] = "CHARACTER" TYPE2 = change(NEWTYPE[10,len(NEWTYPE)-9]," ","") NEWTYPE = "CHARACTER" case NEWTYPE[1,4] = "CHAR" TYPE2 = change(NEWTYPE[5,len(NEWTYPE)-4]," ","") NEWTYPE = "CHAR" case NEWTYPE[1,7] = "NUMERIC" TYPE2 = change(NEWTYPE[8,len(NEWTYPE)-7]," ","") NEWTYPE = "NUMERIC" TYPEFLAG = 1 case NEWTYPE[1,7] = "DECIMAL" TYPE2 = change(NEWTYPE[8,len(NEWTYPE)-7]," ","") NEWTYPE = "DECIMAL" TYPEFLAG = 1 case NEWTYPE[1,3] = "DEC" TYPE2 = change(NEWTYPE[4,len(NEWTYPE)-3]," ","") NEWTYPE = "DEC" TYPEFLAG = 1 case 1 EDERR = 18 ; return end case if TYPE2 # "" then if TYPE2[1,1] # "(" or TYPE2[1] # ")" then EDERR = 18 ; return begin case case count(TYPE2,",") > 1 EDERR = 18 ; return case count(TYPE2,",") = 1 ; * DEC or NUMERIC with precision & scale if TYPEFLAG = 0 then EDERR = 18 ; return SBNUM = field(TYPE2,",",1)[2,99] gosub TESTNUM if NOTNUM then EDERR = 18 ; return if SBNUM < 1 then EDERR = 18 ; return PRECNUM = SBNUM SBNUM = field(TYPE2,",",2) SBNUM = SBNUM[1,len(SBNUM)-1] gosub TESTNUM if NOTNUM then EDERR = 18 ; return if SBNUM > 9 or SBNUM > PRECNUM then EDERR = 18 ; return NEWTYPE = NEWTYPE:TYPE2 case 1 ; * DEC, NUMERIC, FLOAT with prec; CHAR, VARCHAR with size SBNUM = TYPE2[2,len(TYPE2)-2] gosub TESTNUM if NOTNUM then EDERR = 18 ; return if SBNUM < 1 then EDERR = 18 ; return if NEWTYPE[1,1] = "C" and SBNUM > 254 then EDERR = 18 ; return if NEWTYPE[1,1] = "V" and SBNUM > 65535 then EDERR = 18 ; return NEWTYPE = NEWTYPE:TYPE2 end case end if field(DEF," ",3) = "PRECISION" then DEF = fieldstore(DEF," ",2,-2,NEWTYPE) end else DEF = fieldstore(DEF," ",2,-1,NEWTYPE) end CDEF<2> = DEF write CDEF to NVAR,CREC else goto WRERR gosub NEWDSTAMP NEEDQ = DEF ; gosub QFIRST if EK then print " K":I2:" ":NEEDQ else print " ":I2:" ":NEEDQ case upcase(EC2) = "V" ; * Future possibility to change SM (valuedness) EDERR = 10 case upcase(EC2) = "F" ; * Future possibility to change FMT EDERR = 10 case upcase(EC2) = "H" ; * Future possibility to change COL.HDG EDERR = 10 case upcase(EC2) = "C" ; * Future possibility to change CONV EDERR = 10 case 1 EDERR = 5 end case return ; *from CHANGECA after changing a column definition TESTNUM: NOTNUM = 0 WKNUM = SBNUM if WKNUM = "" then NOTNUM = 1 ; return loop until WKNUM = "" or NOTNUM if not(num(WKNUM[1,1])) then NOTNUM = 1 WKNUM = WKNUM[2,99] repeat return ; *from TESTNUM CHANGEA: * Change association EDCOM = EDCOM[2,len(EDCOM)-1] gosub GETNUM if NUMERR then EDERR = 12 ; return if EC2[1,1] = " " then EC2 = EC2[2,len(EC2)-1] if len(EC2) < 2 then EDERR = 1 ; return EC3 = EC2[2,len(EC2)-1] EC2 = EC2[1,1] begin case case EC2 = "/" or EC2 = "\" if I2 > ASSOCLAST then EDERR = 8 ; return if I2 < 1 then EDERR = 12 ; return AREC = "SQL_A":I2 read ADEF from NVAR,AREC else EDERR = 19 ; return if upcase(ADEF<3>) = "D" then EDERR = 14 ; return DEF = ADEF<2> if upcase(field(EC3,EC2,3)[1,1]) = "G" and field(EC3,EC2,1) # "" then NUMREP = -1 else NUMREP = 1 DEF = ereplace(DEF,field(EC3,EC2,1),field(EC3,EC2,2),NUMREP) ADEF<2> = DEF write ADEF to NVAR,AREC else goto WRERR gosub NEWDSTAMP NEEDQ = DEF ; gosub QFIRST print " ":I2:" ":NEEDQ case upcase(EC2) = "N" EDERR = 10 case upcase(EC2) = "K" EDERR = 10 case 1 EDERR = 5 end case return ; *from CHANGECA after changing an assoc definition * Delete a column or association definition DELETECA: EDERR = 0 EDCOM = EDCOM[2,len(EDCOM)-1] if upcase(EDCOM[1,1]) = "A" then goto DELETEA * Delete column -- mark it "deleted" in field 3 ******* The following line of code was added 5/22/97 ************************ EDERR = 5 ; return ******* The following code is no longer used (as of 5/22/97) but ************ ******* I am reluctant to delete it just yet ****************************** if upcase(EDCOM[1,1]) = "C" then EDCOM = EDCOM[2,len(EDCOM)-1] gosub GETNUM if NUMERR then EDERR = 2 ; return if EC2[1,1] = " " then EC2 = EC2[2,len(EC2)-1] if len(EC2) <> 1 then EDERR = 1 ; return if I2 > COLLAST then EDERR = 7 ; return if not(alpha(EC2)) then EDERR = 3 ; return SELAC = 'SELECT ':DEFNM:' WITH @ID LIKE "SQL_C':I2 SELAC := "'":EC2:"'..." SELAC := '"' execute SELAC capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) readnext SQLID else EDERR = 6 ; return read CDEF from NVAR,SQLID else EDERR = 9 ; return if upcase(CDEF<3>) = "D" then EDERR = 4 ; return CDEF<3> = "D" write CDEF to NVAR,SQLID else goto WRERR gosub NEWDSTAMP print " Column-synonym deleted" return ; *from DELETECA after deleting a column ******* The above code is no longer used (as of 5/22/97) but **************** ******* I am reluctant to delete it just yet ****************************** * Delete an association entirely -- mark it deleted in field 3 DELETEA: EDCOM = EDCOM[2,len(EDCOM)-1] gosub GETNUM if NUMERR then EDERR = 12 ; return if len(EC2) <> 0 then EDERR = 1 ; return if I2 > ASSOCLAST then EDERR = 8 ; return if I2 < 1 then EDERR = 12 ; return AREC = "SQL_A":I2 read ADEF from NVAR,AREC else EDERR = 19 ; return if upcase(ADEF<3>) = "D" then EDERR = 14 ; return ADEF<3> = "D" write ADEF to NVAR,AREC else goto WRERR gosub NEWDSTAMP print " Association deleted" return ; *from DELETECA after deleting an association * Use another column or association definition USECA: EDERR = 0 EDCOM = EDCOM[2,len(EDCOM)-1] if upcase(EDCOM[1,1]) = "A" then goto USEA * Use other definition for the "chosen" column EK = 0 ; * this is set in case we call subroutine REWRITESEL if upcase(EDCOM[1,1]) = "C" then EDCOM = EDCOM[2,len(EDCOM)-1] gosub GETNUM if NUMERR then EDERR = 2 ; return if EC2[1,1] = " " then EC2 = EC2[2,len(EC2)-1] if len(EC2) <> 1 then EDERR = 1 ; return if I2 > COLLAST then EDERR = 7 ; return if not(alpha(EC2)) then EDERR = 3 ; return SELAC = 'SELECT ':DEFNM:' WITH @ID LIKE "SQL_C':I2 SELAC := "'":EC2:"'..." SELAC := '"' execute SELAC capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) readnext SQLID else EDERR = 6 ; return read CDEF from NVAR,SQLID else EDERR = 9 ; return if upcase(CDEF<3>) = "D" then EDERR = 4 ; return read TVAR from NVAR,"SQL_C":I2 else EDERR = 9 ; return OLDNAME = field(TVAR<2>," ",1) NEWNAME = field(CDEF<2>," ",1) gosub REWRITESEL write CDEF to NVAR,"SQL_C":I2 else goto WRERR gosub NEWDSTAMP NEEDQ = CDEF<2> ; gosub QFIRST print " ":I2:" ":NEEDQ return ; *from USECA after setting column definition to Use another def USEA: * Use other definition for the "chosen" association EDCOM = EDCOM[2,len(EDCOM)-1] gosub GETNUM if NUMERR then EDERR = 12 ; return if EC2[1,1] = " " then EC2 = EC2[2,len(EC2)-1] if len(EC2) <> 1 then EDERR = 1 ; return if I2 > ASSOCLAST then EDERR = 7 ; return if I2 < 1 then EDERR = 12 ; return if not(alpha(EC2)) then EDERR = 3 ; return SELAC = 'SELECT ':DEFNM:' WITH @ID LIKE "SQL_A':I2 SELAC := "'":EC2:"'..." SELAC := '"' execute SELAC capturing TVAR if DEBUG then print change(TVAR,char(254),char(10),0,1) readnext SQLID else EDERR = 16 ; return read ADEF from NVAR,SQLID else EDERR = 19 ; return if upcase(ADEF<3>) = "D" then EDERR = 14 ; return if upcase(ADEF<3>) = "O" then EDERR = 14 ; return write ADEF to NVAR,"SQL_A":I2 else goto WRERR gosub NEWDSTAMP NEEDQ = ADEF<2> ; gosub QFIRST print " ":I2:" ":NEEDQ return ; *from USECA after setting assoc definition to Use another def * Redisplay one column or association definition DISPCA: EDERR = 0 EDCOM = EDCOM[2,len(EDCOM)-1] if upcase(EDCOM[1,1]) = "A" then goto DISPA * Redisplay column or key-part def if upcase(EDCOM[1,1]) = "K" then EK = 1 EDCOM = EDCOM[2,len(EDCOM)-1] end else EK = 0 if upcase(EDCOM[1,1]) = "C" then EDCOM = EDCOM[2,len(EDCOM)-1] end gosub GETNUM if NUMERR and EK then EDERR = 11 ; return if NUMERR then EDERR = 2 ; return if len(EC2) <> 0 then EDERR = 1 ; return if EK then if I2 > KEYLAST then EDERR = 17 ; return if I2 < 1 then EDERR = 11 ; return print "Column K":I2:":" read DEF1 from NVAR, "SQL_K":I2 else EDERR = 9 ; return NEEDQ = DEF1<2> ; gosub QFIRST print " K":I2:" ":NEEDQ goto DISPENDC end if I2 > COLLAST then EDERR = 7 ; return if I2 < 1 and KEYLAST > 1 then EDERR = 15 ; return print "Column ":I2:":" read DEF1 from NVAR, "SQL_C":I2 else EDERR = 9 ; return NEEDQ = DEF1<2> ; gosub QFIRST print " ":I2:" ":NEEDQ AC = "C" ; gosub BUILDSELAC DISPRNC: readnext SQLID else goto DISPENDC read DEF2 from NVAR, SQLID else EDERR = 9 ; return if upcase(DEF2<3>) = "D" then goto DISPRNC ALPHID = SQLID[8,1] if num(ALPHID) then ALPHID = SQLID[9,1] if field(trim(DEF2<2>)," ",1,1) <> field(trim(DEF1<2>)," ",1,1) then NEEDQ = DEF2<2> ; gosub QFIRST print " ":I2:ALPHID:" ":NEEDQ end goto DISPRNC DISPENDC: return ; *from DISPCA after Redisplaying a column * Redisplay assoc def DISPA: EDCOM = EDCOM[2,len(EDCOM)-1] gosub GETNUM if NUMERR then EDERR = 12 ; return if len(EC2) <> 0 then EDERR = 1 ; return if I2 > ASSOCLAST then EDERR = 8 ; return if I2 < 1 then EDERR = 12 ; return read DEF1 from NVAR,"SQL_A":I2 else EDERR = 19 if upcase(DEF1<3>) = "D" then EDERR = 14 ; return if upcase(DEF1<3>) = "O" then EDERR = 14 ; return print "Association ":I2:":" NEEDQ = DEF1<2> ; gosub QFIRST print " ":I2:" ":NEEDQ AC = "A" ; gosub BUILDSELAC DISPRNA: readnext SQLID else goto DISPENDA read DEF2 from NVAR,SQLID else EDERR = 19 ; return if upcase(DEF2<3>) = "O" then OLAP = 1 else OLAP = 0 ALPHID = SQLID[8,1] if (DEF2<2> <> DEF1<2>) then NEEDQ = DEF2<2> ; gosub QFIRST print " ":I2:ALPHID:" ":NEEDQ: if OLAP then print space(6):"Overlapping association not used" else print space(6):"PHrase differs from ASSOC" end end goto DISPRNA DISPENDA: return ; *from DISPCA after Redisplaying an association * Rewrite the @SELECT phrase (SQL_SELECT record in SQLDEF file) if it exists, * replacing (every occurence of) a specified old column name by a specified * new column name if the new name is different. This subroutine is called from * the following editing operations: Use-column-synonym, Change-column-def, and * Change-column-name. * Inputs: OLDNAME is previous name of the column being changed * NEWNAME is the new name of the column being changed * EK = 1 if the column is a Key-part, EK = 0 otherwise * Outputs: The effect of this subroutine is to rewrite the SQL_SELECT record * (if there is one) in the SQLDEF file. Also, variables USESELECT * and NEEDATKEY are changed if appropriate, and if so the SQL_INFO * record is rewritten with updated values for USESELECT and NEEDATKEY. * Also, OLDNAME and NEWNAME may be modified: this subroutine unquotes * OLDNAME and NEWNAME if they are delimited, since the @SELECT phrase * must not contain delimited identifiers. REWRITESEL: if OLDNAME[1,1] = '"' and OLDNAME[1] = '"' and len(OLDNAME) > 2 then OLDNAME = OLDNAME[2,len(OLDNAME)-2] OLDNAME = change(OLDNAME,'""','"') end if NEWNAME[1,1] = '"' and NEWNAME[1] = '"' and len(NEWNAME) > 2 then NEWNAME = NEWNAME[2,len(NEWNAME)-2] NEWNAME = change(NEWNAME,'""','"') end if NEWNAME = OLDNAME then return ; *from REWRITESEL if name didn't change read SELREC from NVAR,"SQL_SELECT" then if upcase(SELREC<1>[1,1]) # "X" then return TVAR = "" SELREC = trim(SELREC) loop while SELREC # "" do TOKTEMP = field(SELREC," ",1) SELREC = field(SELREC," ",2,999) if TOKTEMP = OLDNAME then TVAR := " ":NEWNAME end else TVAR := " ":TOKTEMP end repeat write trim(TVAR) to NVAR,"SQL_SELECT" else goto WRERR * Rewrite SQL_INFO record if necessary to force new SQL_SELECT to be used * and/or, if the name being changed is a Key-part name, to force @KEY * to be re-generated in the dictionary by CREATE EXISTING TABLE; this * is accomplished by setting USESELECT = "1" and/or NEEDATKEY = "1", * respectively. if USESELECT = "0" or (EK and NEEDATKEY = "0") then read INFREC from NVAR,"SQL_INFO" then if upcase(INFREC<1>[1,1]) # "X" then return USESELECT = "1"; INFREC<10> = USESELECT if EK then NEEDATKEY = "1" ; INFREC<11> = NEEDATKEY write INFREC to NVAR,"SQL_INFO" else goto WRERR end end end return ; *from REWRITESEL after rewriting SQL_SELECT (and perhaps SQL_INFO) ***** GETNUM Subroutine to find column, key-part, or association number in * an Editing command (C, D, U, or R) * Input: EDCOM contains string of which the first part should be a number * Outputs: NUMERR = 0 if a valid non-negative integer was found; in this case, * I2 will contain the actual integer as 2 or more digits in * the form required for reading from SQLDEF (eg, 00, 01, * ... 09, 10, ..., 99, 100, ...). Also, * EC2 will contain the remainder of the original string after * the numeric part was removed (EC2 may contain empty) * NUMERR = 1 if no number was found at beginning of string * NUMERR = 2 if a number was found but it's invalid (eg negative, * fractional, or exponential) GETNUM: NUMERR = 0 EC2 = "" I2 = EDCOM loop until num(I2) do EC2 = I2[1]:EC2 I2 = I2[1,len(I2)-1] repeat if I2 = "" then NUMERR = 1 ; return I2 = trim(I2," ","T") if int(I2) <> I2 or I2 < 0 then NUMERR = 2 ; return if count(I2,".") > 0 then NUMERR = 2 ; return if count(I2,"+") > 0 then NUMERR = 2 ; return if count(I2,"-") > 0 then NUMERR = 2 ; return if count(I2,"E") > 0 then NUMERR = 2 ; return if count(I2,"e") > 0 then NUMERR = 2 ; return if I2 = 0 then I2 = "00" ; return I2 = trim(I2,"0","L") if I2 <= 9 then I2 = "0":I2 return ; *from GETNUM * Subroutine to check validity of entire set of col and assoc definitions MAKEVFLAG: return ; **??temporary until this routine is implemented * Open the SQLDEF file to NVAR, and its dict to DNVAR, then filelock both OPENDEF: open DEFNM to NVAR else OPSTAT = status() print "Can't open '":DEFNM:"'. ": gosub POPERR if ARGA[1,7] # "RESTORE" then fileunlock DVAR close DVAR end OPENERR = 1 return end filelock NVAR locked print "Can't filelock ":DEFNM if ARGA[1,7] # "RESTORE" then fileunlock DVAR close DVAR end close NVAR OPENERR = 1 return end open "DICT",DEFNM to DNVAR else OPSTAT = status() print "Can't open 'DICT ":DEFNM:"'. ": gosub POPERR if ARGA[1,7] # "RESTORE" then fileunlock DVAR close DVAR end fileunlock NVAR close NVAR OPENERR = 1 return end filelock DNVAR locked print "Can't filelock DICT ":DEFNM if ARGA[1,7] # "RESTORE" then fileunlock DVAR close DVAR end fileunlock NVAR close NVAR close DNVAR OPENERR = 1 return end OPENERR = 0 return ; *from OPENDEF * Open the SQLSAVE file to VVAR, and its dict to DVVAR, then filelock both OPENSAVE: open SAVNM to VVAR else OPSTAT = status() print "Can't open '":SAVNM:"'. ": gosub POPERR OPENERR = 1 return end filelock VVAR locked print "Can't filelock ":SAVNM close VVAR OPENERR = 1 return end open "DICT",SAVNM to DVVAR else OPSTAT = status() print "Can't open 'DICT ":SAVNM:"'. ": gosub POPERR fileunlock VVAR close VVAR OPENERR = 1 return end filelock DVVAR locked print "Can't filelock DICT ":SAVNM fileunlock VVAR close VVAR close DVVAR OPENERR = 1 return end OPENERR = 0 return ; *from OPENSAVE * Print message for error occurring during interactive editing * input = EDERR, which contains error code PEDERR: print " Operation not done. ": begin case case EDERR = 1 print "Command is wrong length" case EDERR = 2 print "Invalid or missing column number" case EDERR = 3 print "Synonym-identifier must be alphabetic" case EDERR = 4 print "Specified synonym has been deleted" case EDERR = 5 print "Illegal command" case EDERR = 6 print "Specified synonym doesn't exist" case EDERR = 7 print "Specified column number too large" case EDERR = 8 print "Specified association number too large" case EDERR = 9 print "Column definition not found" case EDERR = 10 print "Command not yet implemented" case EDERR = 11 print "Invalid or missing key-part number" case EDERR = 12 print "Invalid or missing association number" case EDERR = 13 print "No datatype specified" case EDERR = 14 print "Specified association has been deleted or is overlapping" case EDERR = 15 print "Column 0 is invalid; specify a Key-part" case EDERR = 16 print "Specified association doesn't exist" case EDERR = 17 print "Specified key-part number too large" case EDERR = 18 print "Invalid datatype" case EDERR = 19 print "Association definition not found" case EDERR = 20 print "Use VARCHAR, not CHAR VARYING" case 1 print "Error code ":EDERR end case return ; *from PEDERR * Print error message when unable to open file (partial msg is already printed) * input = OPSTAT, which contains status() POPERR: begin case case OPSTAT = -1 print "Filename not in VOC" case OPSTAT = -2 print "Non-existent or inaccessible file" case OPSTAT = -3 print "No UNIX permission" case OPSTAT = -4 print "No UNIX permission or invalid file" case OPSTAT = -5 print "UNIX read error" case OPSTAT = -6 print "Can't lock file header" case OPSTAT = -7 print "Bad file rev or byte-swap" case OPSTAT = -8 print "Invalid part-file info" case OPSTAT = -9 print "Invalid type 30 info" case OPSTAT = -10 print "File marked inconsistent" case OPSTAT = -11 print "SQL view" case OPSTAT = -12 print "No SQL permission" case OPSTAT = -13 print "Problem with index" case OPSTAT = -14 print "Can't open NFS file" case OPSTAT = -987 print "Bad Q-pointer" case 1 print "Status = ":OPSTAT end case return ; *from POPERR * Unlock and Close all files UCAF: fileunlock DVAR close DVAR fileunlock DNVAR close DNVAR fileunlock NVAR close NVAR return ; *from UCAF DELERR: stop "Can't delete record" *?? WRERR: stop "Can't write record" * ?? RDERR: stop "Can't read record" * ?? * Allegedly, this BADERR error exit should never be invoked BADERR: stop "BADERR: code = ":BERX * ?? SELERR: stop "SELERR" * ?? Getschinfo: * This subroutine determines whether the current account is a schema, and * if so it returns the schema name. This routine doesn't use @SCHEMA * because, unfortunately, @SCHEMA doesn't get updated until a user logs * out of uniVerse and back in again, so @SCHEMA isn't always reliable. * inputs are PATH is the full pathname of the account * outputs are SCH = schema name if this is a schema, else empty string * * Open UV_SCHEMA hush on setting OLDHUSH open "UV_SCHEMA" to FVAR else hush OLDHUSH OPSTAT = status() print "Can't open UV_SCHEMA. ": gosub POPERR stop end hush OLDHUSH * Lock UV_SCHEMA LSLEEP = MAXSLEEP Getsin1: if LSLEEP <=0 then close FVAR stop "Can't lock UV_SCHEMA." end filelock FVAR locked LSLEEP -= 1 sleep 2 goto Getsin1 end * Search UV_SCHEMA for path of this account select FVAR SCH = "" FOUND = 0 NOMORE = 0 loop until (FOUND or NOMORE) do readnext SCH then read SCHREC from FVAR,SCH then if IS.EQPATHS(trim(SCHREC<2>), PATH) then FOUND = 1 end else fileunlock FVAR close FVAR stop "Can't read UV_SCHEMA." end end else NOMORE = 1 repeat fileunlock FVAR close FVAR return ; * return from Getschinfo NORETURN: stop "Invalid system return code from sdml" end