.df for VSTs

I wrote this back in V9 ages:

/***** code begins***************************************************************/
/*
   30-04-2004 Richardk  append option added
   25-04-2004 Richardk  extent, mandatory and case-sensitive added
   25-04-2004 Richardk  compile error

   06-09-2003 by Richard Kelters
   Progress 91C
   Recieves a buffer handle and produces a Progress definition file.
   File is saved to specified file.

*/


DEFINE INPUT  PARAMETER hTempTable           AS HANDLE     NO-UNDO.
DEFINE INPUT  PARAMETER cDefinitionFile      AS CHARACTER  NO-UNDO.

  DEFINE VARIABLE h AS HANDLE     NO-UNDO.
  DEFINE VARIABLE i AS INTEGER    NO-UNDO.
  DEFINE VARIABLE j AS INTEGER    NO-UNDO.
  DEFINE VARIABLE c AS CHARACTER  NO-UNDO.
  DEFINE VARIABLE lAppend AS LOGICAL    NO-UNDO.

  DEFINE STREAM WriteFile.
  &SCOPED-DEFINE NAME WriteFile        /* SEEK statement and function need different arguments (?) */
  &SCOPED-DEFINE STREAM STREAM {&NAME} /* decided to use named stream */
  &SCOPED-DEFINE PUT PUT {&STREAM} UNFORMATTED

IF VALID-HANDLE(hTempTable) = FALSE
THEN
    RETURN. /* else prowin32 error */


IF SEARCH(cDefinitionFile) > ""
THEN
  MESSAGE "Append definition for table '" + hTempTable:NAME + "'"  SKIP
          "to excisting file; " +
          SEARCH(cDefinitionFile) SKIP(2)
          "AND" SKIP
          "are you sure the table hasn't been added before."
    VIEW-AS ALERT-BOX QUESTION
    BUTTONS OK-CANCEL
    UPDATE lAppend.
IF lAppend
THEN DO:
  INPUT {&STREAM} FROM VALUE(cDefinitionFile).
    /* we've written the file pointer at the end of the file
       where we should continu if we were to append
    */
    SEEK {&STREAM}  TO END.
    ASSIGN i = SEEK({&NAME}).
    SEEK {&STREAM}  TO i - 12.        /* 10-digits number plus end-of-line and end-of-file bytes */
    IMPORT {&STREAM} UNFORMATTED c.   /* we've got the filepointer location were we can continu */
  INPUT {&STREAM} CLOSE.
END.


OUTPUT {&STREAM} TO VALUE(cDefinitionFile) APPEND.

  IF lAppend
  THEN DO:
    ASSIGN lAppend = FALSE. /* sets error-status off */
    ASSIGN i = INT(c) NO-ERROR.
    IF ERROR-STATUS:ERROR
    THEN
      MESSAGE "Could not set file pointer to append to excisting file."
              "Overwrite file; " cDefinitionFile SKIP (2)
              "'No' will stop program."
        VIEW-AS ALERT-BOX WARNING
        BUTTONS OK-CANCEL
        UPDATE lAppend.
    ELSE
      lAppend = TRUE.
    IF lAppend
    THEN DO:
      /* set file-pointer where we can continu */
      SEEK {&STREAM} TO i.
    END.
    ELSE DO:
      OUTPUT {&STREAM} CLOSE.
      RETURN. /* stop program */
    END.
  END.
  ELSE DO:
    OUTPUT {&STREAM} CLOSE.
    OUTPUT {&STREAM} TO VALUE(cDefinitionFile). /* Overwrite */
  END.

  /* table */
  {&PUT} 'ADD TABLE "':u   + hTempTable:NAME + '"'  SKIP
         '  AREA "Schema Area"':u                   SKIP
         '  LABEL "':u     + hTempTable:NAME + '"'  SKIP
         '  DESCRIPTION "Automatically created"':u  SKIP
         '  DUMP-NAME "':u + hTempTable:NAME + '"'  SKIP(2).


  /* field */
  DO i = 1 TO hTempTable:NUM-FIELDS:

    ASSIGN h = hTempTable:BUFFER-FIELD(i).

    {&PUT} 'ADD FIELD "':u + h:NAME + '" OF "':u + hTempTable:NAME + '" AS ':u h:DATA-TYPE    SKIP
           '  DESCRIPTION "Automatically created, please update"':u    SKIP
           '  FORMAT "':u + h:FORMAT + '"'                             SKIP
           '  INITIAL "':u + TRIM(h:INITIAL) + '"'                     SKIP
           '  LABEL "':u + h:LABEL + '"'                               SKIP
           '  POSITION ':u + TRIM(STRING(i + 1))                       SKIP
           '  COLUMN-LABEL "':u + h:COLUMN-LABEL + '"'                 SKIP.

     IF h:HELP <> ?      THEN {&PUT} '  HELP "':u + h:HELP + '"':u SKIP.
     IF h:EXTENT > 0     THEN {&PUT} '  EXTENT ':u + STRING(h:EXTENT) SKIP.

     {&PUT} '  ORDER ':u + TRIM(STRING(i * 10)) SKIP(2).

     IF h:MANDATORY      THEN {&PUT} '  MANDATORY':u SKIP.
     IF h:CASE-SENSITIVE THEN {&PUT} '  CASE-SENSITIVE':u SKIP.

  END.


  /* index */
  DO i = 1 TO 200:
    IF hTempTable:INDEX-INFORMATION(i) = ?
    THEN LEAVE.
    ELSE ASSIGN c = hTempTable:INDEX-INFORMATION(i).

    {&PUT} 'ADD INDEX "':u + ENTRY(1,c) + '" ON "':u + hTempTable:NAME + '"' SKIP
           '  AREA "Schema Area"':u                                          SKIP.

    IF ENTRY(2,c) = "1" THEN {&PUT} '  UNIQUE':u     SKIP.
    IF ENTRY(3,c) = "1" THEN {&PUT} '  PRIMARY':u    SKIP.
    IF ENTRY(4,c) = "1" THEN {&PUT} '  WORD':u       SKIP.

    {&PUT} '  DESCRIPTION  "Automatically created, please update"'           SKIP.

    IF ENTRY(1,c) <> 'default':u /* no index available, Progress generates 'default' */
    THEN /* indexfield */
    DO j = 5 TO NUM-ENTRIES(c) BY 2:
      /* this needs the extra space at the end */
      {&PUT} '  INDEX-FIELD "':u + ENTRY(j,c) + '" ' + (IF ENTRY(j + 1,c) = "0"
                                                        THEN 'ASCENDING ':u
                                                        ELSE 'DESCENDING ':u) SKIP.
    END.
    {&PUT} SKIP(1).
  END.

  /*****************************************************************/
  /*                                                               */
  /*                       T R A I L E R                           */
  /*                                                               */
  /*   with current file pointer position written at end-of-file   */
  /*   in order to append later on                                 */
  /*                                                               */
  /*   Got this from: http://www.v9stuff.com/dynexport.htm ,       */
  /*   thanks Tony Lavinio and Peter van Dam                       */
  /*                                                               */
  /*****************************************************************/
  ASSIGN i = SEEK({&NAME}).

  {&PUT} "." SKIP
         "PSC":u SKIP
         "cpstream=":u SESSION:CPSTREAM SKIP
         "." SKIP
         STRING(i,"9999999999") SKIP.

OUTPUT {&STREAM} CLOSE.

RETURN.

/********** code ends ********************************************************/

It was I who told Thomas and when I dump from an empty db (copy of empty4) with hidden ticked on and all the tables selected I get:

.

PSC

cpstream=ISO8859-1

.

0000000003

I shold add this is Progress 11.2.1 on Win7.

Dumping with hidden turned on works in 10.2B (AIX) and 11.3.2 (AIX).... but only as long as you have one actual table in the database.

Dumping VSTs against sports works fine, dumping against an empty (schema wise) doesn't.

I tried this on a DB using 11.4 and got nearly 10,000 lines with 80 files.  Does that sound complete?

Guess I should have tried it myself first ...

I've worked it out. You have to have a table. You have to use the "_*" filter. If you use "*" then it only puts out the real tables, even though it selects all the hidden ones.

MadDBA, does James result match yours or is there a bug with empty?

What do you plan to do with this .df once you've created it?

I'm helping Thomas with his ABL2DB testing in various scenarios. The trouble is, our application is huge and it takes forever to run everything so I thought I'd get it running with a smaller project first to iron out the issues. I have a perfect little application for these purposes but it uses vst queries only.

I haven't spent much time looking at ABL2DB so I don't know what it does with .dfs.  Is it programmatically parsing the flat file?  

Otherwise I don't see the value of having this data in a .df because you're not going to load it into a Progress database that already has VST schema definitions.

Basically matching.... Some weird check is happening in the dump df code.

If you have at least 1 non hidden table and select using _* it will dump all of the _* tables.

If you don't have any non hidden tables and select some (but not all) of the hidden tables it will dump those.

If you don't have any non hidden tables and select all of the hidden tables it instantly puts out an empty DF.

Yes it's parsing the flat file.

ABL2DB parses one or more .dfs to build a set of tables which correspond to the schema, but are in ordinary files, not meta files.  Then as it reads the XREF and the like, it can create links between the compile units and the schema, but the schema of the application (including any metaschema files accessed by the application), not the schema of ABL2DB itself.

>> If you don't have any non hidden tables and select all of the hidden tables it instantly puts out an empty DF.

This issue is fixed in 11.5