****************************************************************************** * * Dataloader Facility * * Module %M% Version %I% Date %H% * * (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved * This is unpublished proprietary source code of Ardent Software Inc. * The copyright notice above does not evidence any actual or intended * publication of such source code. ****************************************************************************** * * Maintenence log - insert most recent change descriptions at top * * Date.... GTAR# WHO Description......................................... * 10/14/98 23801 SAP Change copyrights. * 06/28/96 18440 SHJ Program rewrite * 18440 TMC New file * ******************************************************************************* DEFFUN UVREADMSG(num,args) CALLING '*UVREADMSG' * There are two main loops, the first reads the input file, the second * does the actual loading errargs = "" thiscol = "" could.be.end = 0 conf.eof = 0 item.count = 0 ;* Counter for items processed newfile = 0 recnum = 0 destfile.fnd = 0 itype.flag = 0 quote.locs = "" alt.quote.locs = "" processed = UVREADMSG(85322,"") ;* processed message GOSUB read.configuration * GOSUB print.configuration GOSUB do.loading CALL *UVPRINTMSG(074300, "") GOTO program.end error.exit: CALL *UVPRINTMSG(errmessage,errargs) CALL *UVPRINTMSG(074301, "") @SYSTEM.RETURN.CODE = -1 GOTO program.end *************************************************************************** * * * Read in the configuration file line by line and parse the data into * * something we understand and can use when it comes time to load the * * data. * * * *************************************************************************** read.configuration: * get the first argument and open the file sentence = @SENTENCE * Convert any Tab characters to whitespace CONVERT CHAR(9) TO ' ' IN sentence * take last token check.token = FIELD(sentence," ",DCOUNT(sentence, " ")) OPENSEQ check.token TO fv.config LOCKED errmessage = 074302 errargs<1> = check.token GOTO error.exit END ELSE errmessage = 074303 errargs<1> = check.token GOTO error.exit END * file was able to be opened, parse it * Read it a line at a time, saving pertinent information while processing ************************************************************************** * The Format of the configuration file is: *FILE NUMBER: * LOCATION: * ROW SEPARATOR CHARACTER(S): * COLUMN SEPARATOR CHARACTER(S): * QUOTE CHARACTER: * ALTERNATE QUOTE CHARACTER: * ESCAPE CHARACTER: * COLUMN NUMBER: * SOURCE FORMAT: * WIDTH: * NEXT SEPARATOR CHARACTER(S): * BYTE ORDER: *DESTINATION FILE: * LOCATION: * CREATE FILE: YES/no True/False * CREATE TABLE: YES/no True/False * PARAMETER(S): * AUTOSIZE: YES/no True/False * AUTOSIZE ROWS: * KEY COLUMN(S): * COLUMN NUMBER: * COLUMN NAME: * SOURCE FILE NUMBER(S): * SOURCE COLUMN NUMBER(S): * CONVERSION TYPE: (I/O/B) * CONVERSION CODE: ************************************************************************** EQU maxinfiles TO 100 ; * allow 100 input files for now EQU maxdestfiles TO 1 ; * only 1 destination file allowed EQU no.in.params TO 15 ; * 11 parameter fields for input file EQU no.out.params TO 18 ; * 18 parameter fields for output file EQU readblksiz TO 1024 DIM infile(maxinfiles, no.in.params) MAT infile = "" DIM destfile(maxdestfiles,no.out.params) MAT destfile = "" * input file equates * if additional fields are added, adjust no.in.params above EQU FILE.NUMBER TO 1 EQU LOCATION TO 2 EQU ROW.SEP.CHAR TO 3 EQU COL.SEP.CHAR TO 4 EQU QUOTE.CHAR TO 5 EQU ALT.QUOTE.CHAR TO 6 EQU ESCAPE.CHAR TO 7 EQU COL.NUMBER TO 8 EQU SRC.FORMAT TO 9 EQU WIDTH TO 10 EQU NEXT.SEP.CHAR TO 11 EQU BYTE.ORDER TO 12 EQU QUOTE.SEP TO 13 * dest file equates * if additional fields are added, adjust no.out.params above * FILE.NUMBER and LOCATION are defined above as 1 and 2 * we'll reuse them for the destination file EQU CREATE.FILE TO 3 EQU CREATE.TABLE TO 4 EQU PARAMS TO 5 EQU AUTOSIZE TO 6 EQU AUTOSIZE.ROWS TO 7 EQU KEY.COLUMNS TO 8 EQU DCOL.NUMBER TO 9 EQU DCOL.NAME TO 10 EQU SRC.FILE.NO TO 11 EQU SRC.COL.NO TO 12 EQU CONV.TYPE TO 13 EQU CONV.CODE TO 14 * other equates EQU PARAM.LINE LIT "TRIM(FIELD(confline,':',2,9999))" * yes/no array yes.no.check = "N":@FM:"NO":@FM:"F":@FM:"FALSE":@FM yes.no.check := "Y":@FM:"YES":@FM:"T":@FM:"TRUE" * array of valid formats informats = "INTEGER":@FM:"SMALLINT":@FM:"FLOAT":@FM:"DOUBLE" informats := "BYTEINT":@FM:"DECIMAL":@FM:"CURRENCY":@FM:"RAW" * We can use READSEQ to read data until the file is consumed since data * must be on a line by line basis numfiles = 0 getconflineerr = 0 linenum = 0 filenum = -1 GOSUB getconfline IF conf.eof THEN GOTO confreaderror GOSUB conflinecheck * first line read must begin a FILE paragraph if not(newfile) then errmessage = 074346 GOTO error.exit end * reset newfile and destfile flags newfile = 0 destfile.fnd = 0 * loop for each file begin.new.file: LOOP numcols = 0 GOSUB getconfline GOSUB conflinecheck IF conf.eof THEN EXIT IF newfile AND oldfilenum # -1 ;* check oldfilenum to be safe THEN * we're starting a new FILE NUMBER entry. Verify that the previous * file's information was complete first. * * if the number of cols found = 0 then there is a problem IF oldnumcols = 0 THEN errmessage = 074328 errargs<1> = infile(oldfilenum, FILE.NUMBER) GOTO error.exit END * set defaults infile(filenum,ROW.SEP.CHAR) = CHAR(10) infile(filenum,COL.SEP.CHAR) = " " infile(filenum,QUOTE.CHAR) = "" infile(filenum,ALT.QUOTE.CHAR) = "" infile(filenum,ESCAPE.CHAR) = "" infile(filenum,BYTE.ORDER) = 0 infile(filenum,QUOTE.SEP) = 1 infile(filenum, COL.NUMBER) = "" infile(filenum, SRC.FORMAT) = "" infile(filenum, WIDTH) = "" infile(filenum, NEXT.SEP.CHAR) = "" * reset newfile again or else we'll set the defaults every time we read newfile = 0 END REPEAT * if the number of files found = 0 then there is a problem IF numfiles = 0 THEN errmessage = 074312 GOTO error.exit END * if no destination file was specifed, there's a problem IF NOT(destfile.fnd) THEN errmessage = 074351 GOTO error.exit END * check to see if ONE of AUTOSIZE, CREATE FILE, or CREATE TABLE is true onecheck = SUM(destfile(dfilenum, CREATE.FILE):@FM:destfile(dfilenum, CREATE.TABLE):@FM:destfile(dfilenum, AUTOSIZE)) IF NOT(onecheck = 1 OR onecheck = 0) THEN errmessage = 074315 GOTO error.exit END * check to see if the destination file already exists if AUTOSIZE, CREATE * FILE or CREATE TABLE was specified IF onecheck THEN OPEN destfile(dfilenum,LOCATION) TO fv.outfile THEN errmessage = 074352 errargs<1> = destfile(dfilenum,LOCATION) GOTO error.exit END END ****************************************** * close configuration file CLOSE fv.config RETURN ****************************************** * retrieve a line of data from the configuration file ****************************************** getconfline: READSEQ confline FROM fv.config THEN linenum += 1 END ELSE IF could.be.end AND STATUS() = 1 THEN conf.eof = 1 RETURN END ELSE GOTO confreaderror END * ignore blank lines IF confline = "" THEN GOTO getconfline confline = TRIM(confline) lastconfline = confline RETURN ****************************************** * figure out what data was given on this line ****************************************** conflinecheck: parm = UPCASE(FIELD(confline,":",1)) BEGIN CASE CASE parm = "FILE NUMBER" newfile = 1 IF destfile.fnd THEN * cannot specify additional input files after the destination file in * configuration file. errmessage = 074348 GOTO error.exit END oldfilenum = filenum oldnumcols = numcols filenum = PARAM.LINE numfiles += 1 IF NOT(NUM(filenum)) OR (filenum < 1) THEN errmessage = 074305 errargs<1> = parm errargs<2> = linenum GOTO error.exit END IF (numfiles > maxinfiles) THEN errmessage = 074347 GOTO error.exit END CASE parm = "LOCATION" * confirm location location = PARAM.LINE IF destfile.fnd THEN * this is the location specification for the destination file destfile(dfilenum,LOCATION) = location END ELSE * this is the location specification for an input file infile(filenum, LOCATION) = location OPENSEQ location TO infile(filenum, FILE.NUMBER) ELSE errmessage = 074306 errargs<1> = location GOTO error.exit END END CASE parm = "ROW SEPARATOR CHARACTER(S)" rowsep = PARAM.LINE * if rowsep is numeric, then convert it to characters * and concatenate into one string IF NUM(FIELD(rowsep," ",1)) THEN rowsep = CHARS(CONVERT(" ",@FM,rowsep)) rowsep = CONVERT(@FM,"",rowsep) END infile(filenum, ROW.SEP.CHAR) = rowsep CASE parm = "COLUMN SEPARATOR CHARACTER(S)" colsep = PARAM.LINE * if colsep is numeric, then convert it to characters * and concatenate into one string IF NUM(FIELD(colsep," ",1)) THEN colsep = CHARS(CONVERT(" ",@FM,colsep)) colsep = CONVERT(@FM,"",colsep) END infile(filenum, COL.SEP.CHAR) = colsep CASE parm = "QUOTE CHARACTER" quote.char = PARAM.LINE IF NUM(quote.char) THEN * have numbers, convert them to characters and save them infile(filenum, QUOTE.CHAR) = CHAR(quote.char) END ELSE infile(filenum, QUOTE.CHAR) = quote.char IF LEN(quote.char) # 1 THEN errmessage = 074307 errargs<1> = quote.char GOTO error.exit END END IF infile(filenum,QUOTE.CHAR) = infile(filenum,ROW.SEP.CHAR) OR infile(filenum,QUOTE.CHAR) = infile(filenum,COL.SEP.CHAR) THEN * quote character cannot be the same as row or column sep char errmessage = 074358 GOTO error.exit END CASE parm = "ALTERNATE QUOTE CHARACTER" alt.quote.char = PARAM.LINE IF NUM(alt.quote.char) THEN * have numbers, convert them to characters and save them infile(filenum, ALT.QUOTE.CHAR) = CHAR(alt.quote.char) END ELSE infile(filenum, ALT.QUOTE.CHAR) = alt.quote.char IF LEN(alt.quote.char) # 1 THEN errmessage = 074307 errargs<1> = alt.quote.char GOTO error.exit END END IF infile(filenum,ALT.QUOTE.CHAR) = infile(filenum,ROW.SEP.CHAR) OR infile(filenum,ALT.QUOTE.CHAR) = infile(filenum,COL.SEP.CHAR) THEN * quote character cannot be the same as row or column sep char errmessage = 074359 GOTO error.exit END CASE parm = "ESCAPE CHARACTER" esc.char = PARAM.LINE IF NUM(esc.char) THEN * have numbers, convert them to characters and save them infile(filenum, ESCAPE.CHAR) = CHAR(esc.char) END ELSE infile(filenum, ESCAPE.CHAR) = esc.char IF LEN(esc.char) # 1 THEN errmessage = 074308 errargs<1> = esc.char GOTO error.exit END END CASE parm = "COLUMN NUMBER" IF destfile.fnd THEN * I'm processing a destination file, but I found a stray column number * which should have been processed under KEY COLUMN errmessage = 074353 errargs<1> = parm errargs<2> = linenum GOTO error.exit END * beginning column information newcol.found: numcols += 1 thiscolnum = PARAM.LINE IF NOT(NUM(thiscolnum)) OR (thiscolnum < 1) THEN errmessage = 074305 errargs<1> = thiscolnum errargs<2> = linenum GOTO error.exit END * set column number and initialize everything else for this column infile(filenum,COL.NUMBER) = thiscolnum infile(filenum,SRC.FORMAT) = "RAW" infile(filenum,WIDTH) = 0 infile(filenum,NEXT.SEP.CHAR) = "" LOOP * get next line of information GOSUB getconfline colparm = UPCASE(FIELD(confline,":",1)) BEGIN CASE * case of possibilities for column information CASE colparm = "SOURCE FORMAT" thisformat = UPCASE(PARAM.LINE) * set default IF thisformat # "" THEN * make sure user specified a valid format LOCATE thisformat IN informats SETTING junk ELSE errmessage = 074310 errargs<1> = thisformat errargs<2> = thiscolnum errargs<3> = infile(filenum, FILE.NUMBER) GOTO error.exit END infile(filenum,SRC.FORMAT) = thisformat END CASE colparm = "WIDTH" width = PARAM.LINE IF NOT(NUM(width)) OR (width < 0) THEN errmessage = 074305 errargs<1> = colparm errargs<2> = linenum GOTO error.exit END infile(filenum,WIDTH) = width CASE colparm = "NEXT SEPARATOR CHARACTER(S)" nextsep = PARAM.LINE * if nextsep is numeric, then convert it to characters * and concatenate into one string IF NUM(FIELD(nextsep," ",1)) THEN nextsep = CHARS(CONVERT(" ",@FM,nextsep)) nextsep = CONVERT(@FM,"",nextsep) END infile(filenum, NEXT.SEP.CHAR) = nextsep CASE colparm = "COLUMN NUMBER" * we found the start of the next column's information parm = colparm ; * for sanity's sake colparm = "" GOTO newcol.found CASE 1 * we're not looking at column information anymore * go to beginning of conflinecheck and start fresh GOTO conflinecheck END CASE REPEAT CASE parm = "SOURCE FORMAT" * found a stray instruction errmessage = 074350 errargs<1> = parm errargs<2> = linenum GOTO error.exit CASE parm = "WIDTH" * found a stray instruction errmessage = 074350 errargs<1> = parm errargs<2> = linenum GOTO error.exit CASE parm = "NEXT SEPARATOR CHARACTER(S)" * found a stray instruction errmessage = 074350 errargs<1> = parm errargs<2> = linenum GOTO error.exit CASE parm = "BYTE ORDER" * check to see it is 0 or 1 byte.order = PARAM.LINE IF (byte.order # 0) AND (byte.order # 1) THEN errmessage = 074340 errargs<1> = byte.order errargs<2> = infile(filenum, LOCATION) GOTO error.exit END ELSE infile(filenum, BYTE.ORDER) = byte.order END CASE parm = "DESTINATION FILE" IF destfile.fnd THEN * we already had a destination file specified -- you only get one errmessage = 074349 GOTO error.exit END destfile.fnd = 1 * dfilenum is hardcoded to 1 for now since we only support 1 * destination file dfilenum = 1 * set up destination file defaults destfile(dfilenum,CREATE.FILE) = 0 destfile(dfilenum,CREATE.TABLE) = 0 destfile(dfilenum,PARAMS) = "" destfile(dfilenum,AUTOSIZE) = 0 destfile(dfilenum,AUTOSIZE.ROWS) = 10 CASE parm = "CREATE FILE" checkval = PARAM.LINE GOSUB check.true.false IF checkval THEN destfile(dfilenum,CREATE.FILE) = 1 ELSE destfile(dfilenum,CREATE.FILE) = 0 CASE parm = "CREATE TABLE" checkval = PARAM.LINE GOSUB check.true.false IF checkval THEN destfile(dfilenum,CREATE.TABLE) = 1 ELSE destfile(dfilenum,CREATE.TABLE) = 0 CASE parm = "PARAMETER(S)" * only valid for CREATE.FILE IF PARAM.LINE # "" THEN IF NOT(destfile(dfilenum, CREATE.FILE) OR destfile(dfilenum,CREATE.TABLE)) THEN errmessage = 074332 GOTO error.exit END END destfile(dfilenum, PARAMS) = PARAM.LINE CASE parm = "AUTOSIZE" checkval = PARAM.LINE GOSUB check.true.false IF checkval THEN destfile(dfilenum,AUTOSIZE) = 1 ELSE destfile(dfilenum,AUTOSIZE) = 0 CASE parm = "AUTOSIZE ROWS" autosize.rows = PARAM.LINE * If user did not specify AUTOSIZE, but gave AUTOSIZE.ROWS, error IF autosize.rows # "" AND NOT(destfile(dfilenum,AUTOSIZE)) THEN errmessage = 074334 GOTO error.exit END IF destfile(dfilenum,AUTOSIZE) THEN * If user specified AUTOSIZE, but didn't specify AUTOSIZE.ROWS, then set default IF autosize.rows = "" THEN autosize.rows = 10 ; * default IF NOT(NUM(autosize.rows)) OR (autosize.rows < 0) THEN errmessage = 074305 errargs<1> = parm errargs<2> = linenum GOTO error.exit END END destfile(dfilenum, AUTOSIZE.ROWS) = autosize.rows CASE parm = "KEY COLUMN(S)" IF NOT(destfile.fnd) THEN errmessage = 074354 errargs<1> = linenum GOTO error.exit END key.cols = PARAM.LINE destfile(dfilenum, KEY.COLUMNS) = CONVERT(" ", @FM, key.cols) * initialize fields destfile(dfilenum, DCOL.NUMBER) = "" destfile(dfilenum, DCOL.NAME) = "" destfile(dfilenum, SRC.FILE.NO) = "" destfile(dfilenum, SRC.COL.NO) = "" destfile(dfilenum, CONV.TYPE) = "" destfile(dfilenum, CONV.CODE) = "" thiscolnum = 0 numoutcols = 0 * Begin process column information. Next line read should be a COLUMN spec. GOSUB getconfline parm = FIELD(confline,":",1) IF parm # "COLUMN NUMBER" THEN errmessage = 074355 GOTO error.exit END process.dest.cols: numoutcols += 1 thiscolnum = PARAM.LINE IF thiscolnum = "KEY" OR thiscolnum = 0 THEN * a column number of 0 indicates this is the information * for the key column, and not a field in the data record thiscolnum = 0 END ELSE if NOT(NUM(thiscolnum)) OR thiscolnum < 1 THEN errmessage = 074305 errargs<1> = parm errargs<2> = linenum GOTO error.exit END END destfile(dfilenum,DCOL.NUMBER) = thiscolnum LOOP * process column parameters GOSUB getconfline colparm = FIELD(confline,":",1) BEGIN CASE CASE colparm = "COLUMN NAME" colname = PARAM.LINE * check to see it's unique LOCATE colname IN destfile(dfilenum,DCOL.NAME) SETTING junk THEN errmessage = 074323 errargs<1> = colname GOTO error.exit END * cannot allow a null column name IF colname = "" THEN errmessage = 074356 errargs<1> = thiscolnum GOTO error.exit END destfile(dfilenum,DCOL.NAME) = colname CASE colparm = "SOURCE FILE NUMBER(S)" srcfilenum = PARAM.LINE srcfilenum = CONVERT(" ", @FM, srcfilenum) * every parameter given must be a number IF SUM(NUMS(srcfilenum)) # DCOUNT(srcfilenum,@FM) THEN errmessage = 074317 errargs<1> = colparm GOTO error.exit END destfile(dfilenum, SRC.FILE.NO) = CONVERT(@FM, @VM, srcfilenum) CASE colparm = "SOURCE COLUMN NUMBER(S)" srccolnum = PARAM.LINE srccolnum = CONVERT(" ", @FM, srccolnum) IF SUM(NUMS(srccolnum)) # DCOUNT(srccolnum,@FM) THEN errmessage = 074317 errargs<1> = colparm GOTO error.exit END IF destfile(dfilenum,SRC.FILE.NO) = "" THEN errmessage = 074320 errargs<1> = destfile(dfilenum,DCOL.NUMBER) errargs<2> = destfile(dfilenum,DCOL.NAME) GOTO error.exit END destfile(dfilenum, SRC.COL.NO) = CONVERT(@FM, @VM, srccolnum) * It's possible this is the end of the file, if I have one column's worth * of information collected. could.be.end = 1 CASE colparm = "CONVERSION TYPE" conv.type = UPCASE(PARAM.LINE) IF conv.type # "B" AND conv.type # "I" AND conv.type # "O" THEN errmessage = 074324 errargs<1> = conv.type errargs<2> = linenum GOTO error.exit END destfile(dfilenum, CONV.TYPE) = conv.type CASE colparm = "CONVERSION CODE" destfile(dfilenum, CONV.CODE) = PARAM.LINE CASE colparm = "COLUMN NUMBER" * Found the start of the next column's information * Check info for last read column GOSUB last.column.check * Go to top of loop. parm = colparm ;* for sanity's sake colparm = "" GOTO process.dest.cols END CASE UNTIL conf.eof REPEAT GOSUB last.column.check * check if key columns exist numkeys = DCOUNT(destfile(dfilenum,KEY.COLUMNS), @FM) IF numkeys < 1 THEN errmessage = 074336 GOTO error.exit END FOR i = 1 TO numkeys LOCATE destfile(dfilenum, KEY.COLUMNS) IN destfile(dfilenum,DCOL.NAME) SETTING thiscolnum ELSE errmessage = 074318 errargs<1> = destfile(dfilenum, KEY.COLUMNS) GOTO error.exit END NEXT i * must have a column name defined for every column, no skipping FOR thiscolnum = 1 TO numoutcols IF destfile(dfilenum, DCOL.NAME) = "" THEN errmessage = 074329 errargs<1> = thiscolnum GOTO error.exit END NEXT thiscolnum CASE parm = "COLUMN NUMBER" * found a stray instruction errmessage = 074353 errargs<1> = parm errargs<2> = linenum GOTO error.exit CASE parm = "COLUMN NAME" * found a stray instruction errmessage = 074353 errargs<1> = parm errargs<2> = linenum GOTO error.exit CASE parm = "SOURCE FILE NUMBER(S)" * found a stray instruction errmessage = 074353 errargs<1> = parm errargs<2> = linenum GOTO error.exit CASE parm = "SOURCE COLUMN NUMBER(S)" * found a stray instruction errmessage = 074353 errargs<1> = parm errargs<2> = linenum GOTO error.exit CASE parm = "CONVERSION TYPE" * found a stray instruction errmessage = 074353 errargs<1> = parm errargs<2> = linenum GOTO error.exit CASE parm = "CONVERSION CODE" * found a stray instruction errmessage = 074353 errargs<1> = parm errargs<2> = linenum GOTO error.exit CASE 1 if not(numfiles) then errmessage = 074346 GOTO error.exit end * invalid parameter errmessage = 074345 errargs<1> = parm GOTO error.exit END CASE RETURN check.true.false: checkval = UPCASE(checkval) LOCATE checkval IN yes.no.check SETTING truth.value ELSE errmessage = 074314 errargs<1> = confline GOTO error.exit END * false is 1,2,3,4 true is 5,6,7,8 checkval = (truth.value > 4) RETURN ************************************ * tell user an error was encountering while reading * the configuration file. ************************************ confreaderror: errmessage = 074316 errargs<1> = infile(filenum, LOCATION) errargs<2> = lastconfline GOTO error.exit ************************************ * Do some error checking on previous column spec. * Number of files should equal number of columns ************************************ last.column.check: num.of.srcfiles = DCOUNT(destfile(dfilenum, SRC.FILE.NO), @VM) num.of.srccols = DCOUNT(destfile(dfilenum,SRC.COL.NO),@VM) IF num.of.srcfiles # num.of.srccols THEN errmessage = 074319 errargs<1> = destfile(dfilenum,DCOL.NAME) GOTO error.exit END * check to see if these columns exist FOR i = 1 TO num.of.srcfiles checkfile = destfile(dfilenum,SRC.FILE.NO) * checkfile is the FILE.NUMBER. Check infile array to see if this slot was * processed, and that the input file was successfully opened. IF NOT(ASSIGNED(infile(checkfile,FILE.NUMBER))) THEN errmessage = 074321 errargs<1> = checkfile errargs<2> = destfile(dfilenum,DCOL.NAME) GOTO error.exit END checkcol = destfile(dfilenum,SRC.COL.NO) LOCATE checkcol in infile(checkfile,COL.NUMBER) SETTING fnd ELSE errmessage = 074322 errargs<1> = checkcol errargs<2> = checkfile errargs<3> = thiscolnum errargs<4> = destfile(dfilenum,DCOL.NAME) GOTO error.exit END NEXT i RETURN ********************************************** * * * The section will actually do the loading * * * ********************************************** do.loading: * sdata(x, 1) = data left * sdata(x, 2) = this record * sdata(x, 3) = eof? * sdata(x, 4) = filesize * sdata(x, 5) = current position * sdata(x, 6) = dynamic array of quotes found EQU REMAINING.DATA TO 1 EQU THIS.RECORD TO 2 EQU EOF TO 3 EQU FILESIZE TO 4 EQU CURRENT.POS TO 5 EQU QUOTE.POS TO 6 DIM sdata(numfiles, 6) * get the sizes of all the source files and initialize sdata dfilenum = 1 ;* only one destination file for now maxincols = 0 FOR filenum = 1 TO numfiles STATUS fvstat from infile(filenum, FILE.NUMBER) ELSE errmessage = 074325 errargs<1> = filenum errargs<2> = infile(filenum, LOCATION) GOTO error.exit END sdata(filenum, REMAINING.DATA) = "" sdata(filenum, THIS.RECORD) = "" sdata(filenum, EOF) = 0 sdata(filenum, FILESIZE) = fvstat<6> sdata(filenum, CURRENT.POS) = 0 sdata(filenum, QUOTE.POS) = "" IF maxincols < DCOUNT(infile(filenum,COL.NUMBER),@FM) THEN maxincols = DCOUNT(infile(filenum,COL.NUMBER),@FM) NEXT filenum * figure out how many columns in this file DIM coldata(numfiles, maxincols) * if autosize, set up output row data IF destfile(dfilenum,AUTOSIZE) THEN DIM saverows(destfile(dfilenum,AUTOSIZE.ROWS), 2) * set up key array -- numkeys is the number of KEY COLUMNS DIM outkeys(numkeys) ************************************************************* * set up destination file ( if CREATE.FILE or CREATE TABLE) * ************************************************************* IF destfile(dfilenum, CREATE.FILE) OR destfile(dfilenum,CREATE.TABLE) THEN IF destfile(dfilenum,CREATE.FILE) THEN exeline = "CREATE.FILE " ELSE exeline = "CREATE TABLE " exeline := destfile(dfilenum, LOCATION):" ":destfile(dfilenum, PARAMS) errargs<1> = exeline CALL *UVPRINTMSG(074335, exeline) EXECUTE exeline END * open the file if not autosize IF NOT(destfile(dfilenum,AUTOSIZE)) THEN OPEN destfile(dfilenum, LOCATION) TO fv.outfile ELSE errmessage = 074339 errargs<1> = destfile(dfilenum,LOCATION) GOTO error.exit END END ****************** * do the loading * ****************** quote.check.at = 0 totsize = 0 row.num = "" FOR filenum = 1 TO numfiles row.num=0 NEXT filenum LOOP havedata = 0 FOR filenum = 1 TO numfiles * Do we have quote characters to look for? check.quotes = (infile(filenum, QUOTE.CHAR)#"") OR (infile(filenum, ALT.QUOTE.CHAR)#"") LOOP * * This loop will find the next complete row, and put it in * sdata(filenum,THIS.RECORD). Everything else will go into * sdata(filenum,REMAINING.DATA). * ********The first time through this loop, we haven't read any data yet end.of.row = 0 curdata = sdata(filenum, REMAINING.DATA) * find next row seperator rowsep = infile(filenum, ROW.SEP.CHAR) rowsep.len = LEN(rowsep) escchar = infile(filenum,ESCAPE.CHAR) end.of.row = INDEX(curdata, rowsep, 1) * make sure it was not escaped IF (end.of.row > 1) AND (escchar # "") THEN next.instance = 1 LOOP * check the second to last character to see if it's * an escape character WHILE curdata[end.of.row-1, 1] = escchar old.eor = end.of.row next.instance += 1 end.of.row = INDEX(curdata, rowsep, next.instance) UNTIL NOT(end.of.row) REPEAT END IF end.of.row # 0 THEN * this record is everything before the end.of.row char sdata(filenum, THIS.RECORD) = LEFT(curdata, end.of.row - 1) newstart = end.of.row + rowsep.len newlen = LEN(curdata) - newstart + 1 sdata(filenum, REMAINING.DATA) = curdata[newstart, newlen] END ELSE * we didn't find the end of a row IF sdata(filenum, EOF) THEN * but we got to the end of file, so all of the * current data is considered one record. sdata(filenum, THIS.RECORD) = curdata sdata(filenum, REMAINING.DATA) = "" EXIT ; * quit loop when file is exhausted END ELSE read.more: chars.left = sdata(filenum, FILESIZE) - sdata(filenum, CURRENT.POS) IF chars.left <= 0 THEN * there aren't any characters left. eof reached. sdata(filenum, EOF) = 1 END ELSE IF chars.left < readblksiz THEN chars.to.read = chars.left ELSE chars.to.read = readblksiz READBLK thisblk FROM infile(filenum, FILE.NUMBER), chars.to.read THEN sdata(filenum, CURRENT.POS) += chars.to.read sdata(filenum, REMAINING.DATA) := thisblk END ELSE IF STATUS() = 1 THEN * * end of file was encountered by READBLK * newlen = (sdata(filenum,CURRENT.POS) + chars.to.read) IF (newlen # sdata(filenum,FILESIZE)) THEN errmessage = 074326 errargs<1> = filenum errargs<2> = infile(filenum, LOCATION) GOTO error.exit END ELSE sdata(filenum, EOF) = 1 END ELSE Errmessage = 074327 errargs<1> = filenum errargs<2> = infile(filenum, LOCATION) GOTO error.exit END END END END END UNTIL end.of.row REPEAT * * Done finding the next row. * row.num += 1 * check the row for quote characters IF check.quotes THEN curdata = sdata(filenum,THIS.RECORD) * process quote character first IF infile(filenum,QUOTE.CHAR) THEN quote.locs = "" instance = 0 true.instance = 0 LOOP next.quote = INDEX(curdata,infile(filenum,QUOTE.CHAR),true.instance+1) UNTIL next.quote = 0 * increment true.instance anytime we find a quote char true.instance += 1 * it doesn't count as a quote if it's preceded * by an escape character IF next.quote # 1 AND curdata[next.quote-1,1] # escchar THEN * don't want to increment instance until we know * we actually found the next instance of the quote char instance += 1 quote.locs=next.quote END REPEAT END * process alt quote character IF infile(filenum,ALT.QUOTE.CHAR) THEN alt.quote.locs = "" alt.instance = 0 true.instance = 0 LOOP next.quote = INDEX(curdata,infile(filenum,ALT.QUOTE.CHAR),true.instance+1) UNTIL next.quote = 0 * increment true.instance anytime we find a quote char true.instance += 1 * it doesn't count as a quote if it's preceded * by an escape character IF next.quote # 1 AND curdata[next.quote-1,1] # escchar THEN * don't want to increment alt.instance until we know * we actually found the next instance of the quote char alt.instance += 1 alt.quote.locs=next.quote END REPEAT IF alt.instance THEN * check for uneven number of alt.quote.chars (mismatched) IF MOD(alt.instance,2) THEN * mismatched alternate quote characters. Ignore last * one and warn user. errmessage = 074331 errargs<1> = infile(filenum,ALT.QUOTE.CHAR) errargs<2> = filenum errargs<3> = row.num CALL *UVPRINTMSG(errmessage,errargs) END * now look for quote.chars within alt.quote.chars, and * if any are found, don't count them as quote.chars, since * they're intended to be literal. alt.quote.len = LEN(infile(filenum,ALT.QUOTE.CHAR)) FOR i = 2 TO alt.instance STEP 2 * subtract length of alt quote char as well to get length * of the string only IF alt.quote.locs > 0 THEN substr.len = alt.quote.locs - alt.quote.locs - alt.quote.len substr = curdata[alt.quote.locs+alt.quote.len,substr.len] j=1 LOOP quote.char.fnd = INDEX(substr,infile(filenum,QUOTE.CHAR),j) UNTIL NOT(quote.char.fnd) * offset should be the actual location of the quote.char * within curdata, not the substring. offset = alt.quote.locs + quote.char.fnd * now pull offset value from quote.locs because it's * intended to be a literal character, not a quote LOCATE offset IN quote.locs SETTING pos THEN quote.locs = DELETE(quote.locs,pos) instance -= 1 END j += 1 REPEAT END NEXT i END END IF infile(filenum,QUOTE.CHAR) # "" THEN * now that we've weeded out the literal quote characters, * check for uneven number of quote.chars (mismatched) IF MOD(DCOUNT(quote.locs,@FM),2) THEN * mismatched quote characters. Ignore last * one and warn user. errmessage = 074331 errargs<1> = infile(filenum,QUOTE.CHAR) errargs<2> = filenum errargs<3> = row.num CALL *UVPRINTMSG(errmessage,errargs) END * if I don't have at least one pair of quote chars, then * I don't have to check quotes after all IF instance < 2 THEN check.quotes = 0 END END ; * check.quotes FOR thiscolnum = 1 TO DCOUNT(infile(filenum,COL.NUMBER),@FM) * process all the columns for this file curdata = sdata(filenum, THIS.RECORD) IF curdata = "" THEN thiscol = "" leftdata = "" GOTO start.next.col END byteorder = destfile(dfilenum, BYTE.ORDER) thisformat = infile(filenum, SRC.FORMAT) BEGIN CASE CASE thisformat = "DECIMAL" OR thisformat = "CURRENCY" OR thisformat = "RAW" * if length defined, use length IF infile(filenum, WIDTH) THEN end.of.col = infile(filenum, WIDTH) thiscol = LEFT(curdata, end.of.col) leftdata = RIGHT(curdata, LEN(curdata)-end.of.col) END ELSE * look for next column seperator IF infile(filenum, NEXT.SEP.CHAR) THEN thissep = infile(filenum, NEXT.SEP.CHAR) END ELSE thissep = infile(filenum, COL.SEP.CHAR) end.of.col = INDEX(curdata, thissep, 1) * make sure it was not escaped next.instance = 1 escape.check: IF (end.of.col > 1) AND (escchar # "") THEN LOOP WHILE curdata[end.of.col-1, 1] = escchar next.instance += 1 end.of.col = INDEX(curdata, thissep, next.instance) UNTIL NOT(end.of.col) REPEAT END * make sure it isn't between quote characters within.quotes = 0 IF check.quotes AND end.of.col THEN LOOP LOCATE end.of.col IN quote.locs BY "AR" SETTING pos THEN * ran into trouble. end.of.col character shouldn't * fall on a quote character's location errmessage = 074357 errargs<1> = row.num GOTO error.exit END * if pos is an even number, we're between quotes WHILE NOT(MOD(pos,2)) AND pos <= DCOUNT(quote.locs,@FM) next.instance += 1 within.quotes = 1 end.of.col = INDEX(curdata, thissep, next.instance) WHILE end.of.col REPEAT END * if we found a new end.of.col because the original was * within quotes, we have to go back up and check for * escape character again. IF within.quotes AND end.of.col THEN GOTO escape.check IF NOT(end.of.col) THEN * never found the end of column. Everything * will be considered one single column. thiscol = curdata leftdata = "" END ELSE thiscol = LEFT(curdata, end.of.col-1) leftdata.len = LEN(curdata)-end.of.col-LEN(thissep)+1 leftdata = RIGHT(curdata, leftdata.len) END column.length = LEN(thiscol) * remove escape characters * convert escaped escape to specchar -- there shouldn't * be any row separator characters left in this column, * so we're safe using that as specchar (two of them * concatenated in case there was a single escaped one * that got left in this column. IF escchar THEN specchar = rowsep:rowsep thiscol = CHANGE(thiscol,escchar:escchar,specchar) no.of.escchars = DCOUNT(thiscol,escchar) - 1 * remove remaining escapes thiscol = CHANGE(thiscol,escchar,"") * convert specchar to escape thiscol = CHANGE(thiscol,specchar,escchar) no.of.escchars = no.of.escchars + DCOUNT(thiscol,escchar) - 1 END ELSE no.of.escchars = 0 * remove quote characters * use the quote.locs array so we don't remove the * literal quote characters quotes.removed = 0 IF DCOUNT(quote.locs,@FM) THEN * have to use remove.array so that REMOVE pointer * is reset each time we come into this loop remove.array = quote.locs LOOP REMOVE quote.pos FROM remove.array SETTING more IF quote.pos < 0 AND quote.pos # "" THEN CONTINUE WHILE quote.pos # "" AND column.length >= quote.pos * adjust by whatever escchars we already removed quote.pos = quote.pos - quotes.removed - no.of.escchars thiscol[quote.pos,1] = rowsep:rowsep CONVERT rowsep:rowsep TO "" IN thiscol quotes.removed += 1 UNTIL NOT(more) REPEAT END * remove all alternate quote characters * use the alt.quote.locs array so we don't remove the * literal alternate quote characters (escaped) IF DCOUNT(alt.quote.locs,@FM) THEN counter = 0 * have to use remove.array so that REMOVE pointer * is reset each time we come into this loop remove.array = alt.quote.locs LOOP REMOVE quote.pos FROM remove.array SETTING more IF quote.pos < 0 AND quote.pos # "" THEN CONTINUE WHILE quote.pos # "" AND column.length >= quote.pos * adjust by whatever escchars and quote chars * we already removed quote.pos = quote.pos - counter - no.of.escchars - quotes.removed thiscol[quote.pos,1] = rowsep:rowsep CONVERT rowsep:rowsep TO "" IN thiscol counter += 1 UNTIL NOT(more) REPEAT END END * handle packed decimal IF thisformat = "DECIMAL" THEN decval = 0 IF byteorder = 1 THEN FOR i = LEN(thiscol) TO 1 STEP -2 decval = decval * 10 decval += 10*(MOD(MOD(SEQ(thiscol[i,1]), 16),10)) decval += MOD(INT(SEQ(thiscol[i,1])/16), 10) NEXT i END ELSE FOR i = 1 TO LEN(thiscol) STEP 2 decval = decval * 10 decval += 10*(MOD(MOD(SEQ(thiscol[i,1]), 16),10)) decval += MOD(INT(SEQ(thiscol[i,1])/16), 10) NEXT i END thiscol = decval END ELSE IF thisformat = "CURRENCY" THEN * handle currency * remove "," and $, should be a number CONVERT "$" TO "" IN thiscol CONVERT "," TO "" IN thiscol * remove all but last "." LOOP WHILE COUNT(thiscol, ".") > 1 thiscol = CHANGE(thiscol, ".", "", 1) REPEAT END CASE thisformat = "BYTEINT" * byteint is 1 char end.of.col = 1 thiscol = SEQ(curdata[1,1]) leftdata = RIGHT(curdata, LEN(curdata)-end.of.col) CASE thisformat = "INTEGER" * integer is 4 characters thiscol = 0 multiplier = 1 IF byteorder = 1 THEN FOR i = 4 TO 1 STEP -1 thiscol += SEQ(curdata[i,1]) * multiplier multiplier = multiplier * 256 NEXT i END ELSE FOR i = 1 TO 4 thiscol += SEQ(curdata[i,1]) * multiplier multiplier = multiplier * 256 NEXT i END leftdata = RIGHT(curdata, LEN(curdata)-4) CASE thisformat = "SMALLINT" * smallint is 2 characters IF byteorder = 1 THEN thiscol = SEQ(curdata[1,1]) + SEQ(curdata[2,1])*256 END ELSE thiscol = SEQ(curdata[2,1]) + SEQ(curdata[1,1])*256 END leftdata = RIGHT(curdata, LEN(curdata)-2) CASE thisformat = "FLOAT" * float is 8 characters * Interpret an IEEE floating point value from the number stored in buff. * IEEE specifies a 64 bit representation for floating point which * consists of: * * 1 sign bit (bit 63) 0 = +, 1 = - * 11 exponent bits (bit 62 - 52) 2^(exponent - 1023) * 52 fraction bits (bit 51 - 0) With implied leading 1 * * The 8 bytes of the floating point result are stored in REVERSE order * (low-to-high as addresses ascend) This is not to be confused with * the 80386 byte swapping. Floating point values are not swapped, but * reversed. * punt and use system call to convert it, possibly after reversing the bytes IF byteorder = 1 THEN thiscol = '' FOR i = 8 TO 1 STEP -1 thiscol := curdata[i, 1] NEXT i END ELSE thiscol = LEFT(curdata, 8) END thiscol = SYSTEM(1210, thiscol) leftdata = RIGHT(curdata, LEN(curdata)-end.of.col) CASE thisformat = "DOUBLE" * double is 8 characters thiscol = 0 multiplier = 1 IF byteorder = 1 THEN FOR i = 8 TO 1 STEP -1 thiscol += SEQ(curdata[i,1]) * multiplier multiplier = multiplier * 256 NEXT i END ELSE FOR i = 1 TO 8 thiscol += SEQ(curdata[i,1]) * multiplier multiplier = multiplier * 256 NEXT i END leftdata = RIGHT(curdata, LEN(curdata)-8) END CASE start.next.col: coldata(filenum, thiscolnum) = thiscol sdata(filenum, THIS.RECORD) = leftdata IF DCOUNT(quote.locs,@FM) THEN * figure out the adjusted quote locations for the next * column so we know where the quotes are IF (infile(filenum,WIDTH) > 0) THEN adjustment = infile(filenum,WIDTH) ELSE adjustment = column.length + LEN(thissep) quote.locs = SUBS(quote.locs,REUSE(adjustment)) END IF DCOUNT(alt.quote.locs,@FM) THEN * figure out the adjusted alt.quote locations for the next * column so we know where the alt.quotes are IF (infile(filenum,WIDTH) > 0) THEN adjustment = infile(filenum,WIDTH) ELSE adjustment = column.length + LEN(thissep) alt.quote.locs = SUBS(alt.quote.locs,REUSE(adjustment)) END IF thiscol # "" THEN havedata = 1 NEXT thiscolnum NEXT filenum * * Done breaking all of the columns apart into coldata for this row * all.eof = 1 filenum = 0 * * Make sure we actually found some data somewhere LOOP filenum += 1 IF NOT(sdata(filenum, EOF)) THEN all.eof = 0 UNTIL NOT(all.eof) OR NOT(havedata) OR (filenum >= numfiles) REPEAT IF NOT(all.eof) OR havedata THEN * assemble the destination record outrec = "" * num.of.cols = DCOUNT(destfile(dfilenum,DCOL.NUMBER),@FM) FOR destcolnum = 1 TO num.of.cols thiscol = "" keyoffset =0 FOR numsource = 1 TO DCOUNT(destfile(dfilenum, SRC.FILE.NO), @VM) fromfile = destfile(dfilenum,SRC.FILE.NO) fromcol = destfile(dfilenum,SRC.COL.NO) thiscol := coldata(fromfile, fromcol) NEXT numsource * run conversion if given conv.type = destfile(dfilenum,CONV.TYPE) BEGIN CASE CASE conv.type = "I" thiscol = ICONV(thiscol, destfile(dfilenum, CONV.CODE)) CASE conv.type = "O" thiscol = OCONV(thiscol, destfile(dfilenum, CONV.CODE)) CASE conv.type = "B" * For a conversion type B, we can write all the itypes now. * We'll set a flag so it only gets done once. * * If it's AUTOSIZE then file hasn't been created yet so we have to * use the dictionary of the VOC to compile the I-types. We will * keep track of the items we create and write them over to the * dictionary of the destination file after it's created. IF NOT(itype.flag) THEN IF (destfile(dfilenum,AUTOSIZE)) THEN file.to.use = "VOC" items.written = "" END ELSE file.to.use = destfile(dfilenum,LOCATION) itype.flag = 1 dfilenum = 1 ; * only one destination file for now no.of.dcols = DCOUNT(destfile(dfilenum,DCOL.NUMBER),@FM) * open dictionary file OPEN "DICT",file.to.use TO fv.dictfile ELSE * cannot open dictionary. CALL *UVPRINTMSG(074361, file.to.use) GOTO skip.itype END dictrec.itype = "I":@FM:@FM:@FM:@FM:"10R":@FM:"S" items.written = "" FOR dcolnum = 1 to no.of.dcols * If we run into trouble with any of these B types, print * a warning and unset the conversion type so we don't do * the conversion IF destfile(dfilenum,CONV.TYPE) = "B" THEN * write the conversion code onto COLUMN.B in dict dictrec.id = destfile(dfilenum,DCOL.NAME):".B" dictrec.itype<2> = destfile(dfilenum,CONV.CODE) WRITE dictrec.itype TO fv.dictfile,dictrec.id LOCKED CALL *UVPRINTMSG(074360,destfile(dfilenum,DCOL.NAME)) errargs<1> = dictrec.id errargs<2> = destfile(dfilenum,LOCATION) CALL *UVPRINTMSG(074362, errargs) destfile(dfilenum,CONV.TYPE) = "" END THEN items.written := dictrec.id:" " END ELSE CALL *UVPRINTMSG(074360,destfile(dfilenum,DCOL.NAME)) errargs<1> = dictrec.id errargs<2> = destfile(dfilenum,LOCATION) CALL *UVPRINTMSG(074363, errargs) destfile(dfilenum,CONV.TYPE) = "" END END NEXT dcolnum * compile dictionary CALL *UVPRINTMSG(074365,destfile(dfilenum,LOCATION)) EXECUTE "CD ":file.to.use:" ":items.written END * read in compiled itype * itype.flag indicates that the dictionary has been * compiled. IF itype.flag THEN dictrec.id = destfile(dfilenum,DCOL.NAME):".B" READ col.itype FROM fv.dictfile,dictrec.id ELSE CALL *UVPRINTMSG(074360,destfile(dfilenum,DCOL.NAME)) errargs<1> = dictrec.id errargs<2> = destfile(dfilenum,LOCATION) CALL *UVPRINTMSG(074364,errargs) destfile(dfilenum,CONV.TYPE) = "" GOTO skip.itype END * now run itype conversion @RECORD = thiscol thiscol = ITYPE(col.itype) END skip.itype: END CASE * check to see if this column name is one of the key columns LOCATE destfile(dfilenum,DCOL.NAME) IN destfile(dfilenum,KEY.COLUMNS) SETTING dkey.loc THEN outkeys(dkey.loc) = thiscol END thiscolnum = destfile(dfilenum,DCOL.NUMBER) IF thiscolnum # 0 THEN * A column number of 0 indicates key only. Since this * isn't 0, it can be included in the data record outrec = thiscol END * NEXT destcolnum * Done building record recnum +=1 * assemble key * multipart keys are text mark delimited. They really only make * sense if we're writing to a TABLE, but we'll trust the user to * understand that. Note that if the user did not define the CREATE * TABLE parameters with the primary key corresponding to these key * columns, the WRITEs will fail in this program. Again, the user * should understand this. destkey = "" FOR i = 1 TO numkeys IF i = numkeys THEN destkey := outkeys(i) ELSE destkey := outkeys(i):@TM NEXT i * write the destination record IF destfile(dfilenum,AUTOSIZE) THEN IF recnum > destfile(dfilenum,AUTOSIZE.ROWS) THEN * write row after autosize complete GOTO writeit END ELSE * save record saverows(recnum, 1) = outrec saverows(recnum, 2) = destkey totsize += len(outrec) autosize.check: IF recnum = destfile(dfilenum,AUTOSIZE.ROWS) THEN * autosize * compute average row size avrecsiz = totsize/destfile(dfilenum,AUTOSIZE.ROWS) * average record size CALL *UVPRINTMSG(074341, avrecsiz) * size of input totinsize = 0 FOR filenum = 1 TO numfiles totinsize += sdata(filenum, FILESIZE) NEXT filenum CALL *UVPRINTMSG(074342, totinsize) CALL *UVPRINTMSG(074343, totinsize/avrecsiz) min.mod = INT(totinsize/2048) * there's a minimum for the minimum modulus! IF min.mod < 1 THEN min.mod = 1 CALL *UVPRINTMSG(074344, min.mod) * create the file exeline = "CREATE.FILE " exeline := destfile(dfilenum, LOCATION):" DYNAMIC MINIMUM.MODULUS " exeline := min.mod errargs<1> = exeline CALL *UVPRINTMSG(074335, errargs) EXECUTE exeline * open the file OPEN destfile(dfilenum, LOCATION) TO fv.outfile ELSE errmessage = 074339 errargs<1> = destfile(dfilenum,LOCATION) GOTO error.exit END * write all the saved records FOR i = 1 TO destfile(dfilenum,AUTOSIZE.ROWS) WRITE saverows(i, 1) TO fv.outfile, saverows(i, 2) LOCKED errmessage = 074337 errargs<1> = saverows(i,2) errargs<2> = i errargs<3> = destfile(dfilenum, LOCATION) CALL *UVPRINTMSG(errmessage,errargs) END ELSE errmessage = 074338 errargs<1> = saverows(i,2) errargs<2> = i errargs<3> = destfile(dfilenum, LOCATION) GOTO error.exit END NEXT i * if we had any B conversion types, copy the * dict items from the VOC into the dest file IF itype.flag THEN items.written = TRIM(items.written) no.to.copy = DCOUNT(items.written," ") CALL *UVPRINTMSG(074366,errargs) FOR i = 1 to no.to.copy this.item = FIELD(items.written," ",i) cmd = "COPYI FROM DICT VOC TO DICT ":destfile(dfilenum,LOCATION):" ":this.item:" DELETING" EXECUTE cmd CAPTURING bequiet NEXT i * now close the dict VOC and reopen the dict of * the destination file. CLOSE fv.dictfile OPEN "DICT",destfile(dfilenum,LOCATION) TO fv.dictfile ELSE * cannot open dictionary. CALL *UVPRINTMSG(074361, destfile(dfilenum,LOCATION)) GOTO skip.itype END END END END END ELSE * normal write writeit: WRITE outrec TO fv.outfile, destkey LOCKED errmessage = 074337 errargs<1> = destkey errargs<2> = destfile(dfilenum, LOCATION) CALL *UVPRINTMSG(errmessage,errargs) END ELSE errmessage = 074338 errargs<1> = destkey errargs<2> = destfile(dfilenum, LOCATION) GOTO error.exit END END END * Display some type of movement IF recnum = 1 THEN PRINT IF NOT(MOD(recnum,25)) THEN PRINT '*': IF NOT(MOD(recnum,1000)) THEN ** " processed." PRINT FMT(recnum,"R#15"):processed END END UNTIL all.eof AND NOT(havedata) * before we allow ourselves to drop out of the loop altogether, * make sure that the total number of records wasn't less than * AUTOSIZE.ROWS, because if it was, we didn't write anything * yet and we need to go back and do that. IF destfile(dfilenum,AUTOSIZE) AND recnum < destfile(dfilenum,AUTOSIZE.ROWS) THEN * readjust AUTOSIZE.ROWS and go back up to create file destfile(dfilenum,AUTOSIZE.ROWS) = recnum GOTO autosize.check END REPEAT ** " total processed." PRINT FMT(recnum,"R#15"):UVREADMSG(85323,"") * close all input files FOR filenum = 1 TO numfiles CLOSE infile(filenum, FILE.NUMBER) NEXT filenum RETURN ****************************************************** * Print the configuration file information that the * program has loaded. This is for debugging purposes. ****************************************************** print.configuration: PRINT "The parameters are:" FOR filenum = 1 TO numfiles PRINT "FILE #":filenum STATUS fvstat from infile(filenum, 1) ELSE PRINT "error statusing file" GOTO print.next.file END PRINT " LOCATION='":fvstat<20>:"'" PRINT " should be='":infile(filenum, LOCATION):"'" PRINT " size=":fvstat<6> PRINT " ROW SEPARATOR(s)='":infile(filenum, ROW.SEP.CHAR):"'" PRINT " COLUMN SEPARATOR(s)='":infile(filenum, COL.SEP.CHAR):"'" PRINT " QUOTE CHARACTER='":infile(filenum, QUOTE.CHAR):"'" PRINT " ALT QUOTE CHARACTER='":infile(filenum, ALT.QUOTE.CHAR):"'" PRINT " ESCAPE CHARACTER='":infile(filenum, ESCAPE.CHAR):"'" no.cols = DCOUNT(infile(filenum,COL.NUMBER),@FM) PRINT " number of columns=":no.cols FOR thiscolnum = 1 TO no.cols PRINT " COLUMN #":infile(filenum,COL.NUMBER) PRINT " SOURCE FORMAT=": PRINT infile(filenum, SRC.FORMAT) PRINT " WIDTH=": PRINT infile(filenum, WIDTH) PRINT " NEXT.SEPARATOR='": PRINT infile(filenum, NEXT.SEP.CHAR):"'" NEXT thiscolnum print.next.file: NEXT filenum dfilenum = 1 PRINT "DESTINATION FILE" PRINT " LOCATION='":destfile(dfilenum, LOCATION):"'" PRINT " CREATE FILE=":destfile(dfilenum, CREATE.FILE) PRINT " CREATE TABLE=":destfile(dfilenum, CREATE.TABLE) PRINT " PARAMETER(S)='":destfile(dfilenum, PARAMS):"'" PRINT " AUTOSIZE=":destfile(dfilenum, AUTOSIZE) PRINT " AUTOSIZE ROWS=":destfile(dfilenum, AUTOSIZE.ROWS) PRINT " KEY COLUMN(S)=":destfile(dfilenum, KEY.COLUMNS) no.cols = DCOUNT(destfile(dfilenum,DCOL.NUMBER),@FM) PRINT " number of columns=":no.cols FOR i = 1 to no.cols PRINT " COLUMN NUMBER=":destfile(dfilenum,DCOL.NUMBER) PRINT " COLUMN NAME='":destfile(dfilenum,DCOL.NAME):"'" PRINT " SOURCE FILE NUMBER(S)='":destfile(dfilenum,SRC.FILE.NO):"'" PRINT " SOURCE COLUMN NUMBER(S)='":destfile(dfilenum,SRC.COL.NO):"'" PRINT " CONVERSION TYPE='":destfile(dfilenum,CONV.TYPE):"'" PRINT " CONVERSION CODE='":destfile(dfilenum,CONV.CODE):"'" NEXT i RETURN **************************** * End of program * **************************** program.end: END