/***** 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 ********************************************************/