/*
Subj:   Schema copy routine
Date:   95-10-13 17:12:07 EDT
From:   jagreen@netcom.com (John Green)
Sender: owner-progress-list@peg.com
To:     progress-list@rebecca.peg.com

A while back there was a short thread about copying schema and maintaining
CRCs.  A number of people sent me a request for an updated version of
schcopy.p, which is a utility that comes in source form with Roundtable.

At that time, our tech support hero (Gord), was working on fine tuning
this routine for v7 schema, and I've waited until now for him to finish
his work before posting.  I didn't notice any meta-schema differences
between v7 and v8, so this should work fine with v8.

This will maintain CRCs between your source and target database better
than a schema dump and load will.  However, there is one caveat.  It
seems that the CRC on sequences depends on the sequence(!) that they
were created in.  So it is possible to foul up this routine by just
deleting and re-adding a sequence.  The CRC calculation for sequences
is discussed in the Programming Handbook, section A.2.3.  Gord has
been discussing this problem with Progress.

This is a little long; I hope you don't mind me posting it.  I got the
impression that there was enough interest to warrent a post.

You use this routine by connecting your source and target databases
with "src" and "tar" logical db names.

Enjoy!
--
John A Green  -->  jagreen@netcom.com
StarBase Corporation, Roundtable Software Division
*/

/* schcopy.p -- Schema Copy Utility */

DEFINE VARIABLE Mfile-recid      AS RECID NO-UNDO.
DEFINE VARIABLE Mi               AS INTEGER NO-UNDO.
DEFINE VARIABLE Mfld-num         AS INTEGER NO-UNDO.
DEFINE VARIABLE Mtmp-order       AS INTEGER NO-UNDO.


IF NOT CONNECTED("src") THEN 
  DO ON ENDKEY UNDO, RETURN: 
  BELL.
  MESSAGE "Sorry! database 'src' is not connected.".
  PAUSE.
  RETURN.
  END.

IF NOT CONNECTED("tar") THEN 
  DO ON ENDKEY UNDO, RETURN:
  BELL.
  MESSAGE "Sorry! database 'tar' is not connected.".
  PAUSE.
  RETURN.
  END.

FIND FIRST tar._db WHERE tar._db._db-type = "PROGRESS" NO-LOCK.

FIND FIRST tar._file OF tar._db WHERE NOT tar._file._file-name BEGINS "_" 
  NO-LOCK NO-ERROR.

IF AVAILABLE tar._file THEN 
  DO ON ENDKEY UNDO, RETURN:
  BELL.
  MESSAGE "Sorry! target database already has files defined in it.".
  PAUSE.
  RETURN.
  END.

FIND FIRST src._db WHERE src._db._db-type = "PROGRESS" NO-LOCK.

/* Processing tables with no indices defined (default) appears to be tricky.
*/
/* Progress was handing out some not so surpising and very surprising
errors. */
/* The expected:   ** The keyword default may not be used as a name. (329).
*/
/* The unexpected: SYSTEM ERROR: Attempt to define too many indexes. (40).
*/
/* Putting them in a separate transaction block with no index code works...
*/

FOR EACH src._file
  WHERE NOT src._file._file-name BEGINS "_"
  NO-LOCK
  BY src._file._file-number:

  ASSIGN
    Mfld-num   = 1
    Mtmp-order = 0.

  IF NOT CAN-FIND(src._index WHERE src._index._file-recid = RECID(src._file)
                               AND src._index._index-name = "default")
  THEN DO TRANSACTION:
    /* Copy tables with indices defined.
*/
    /* Note _file fields: _cache, _crc, _db-lang, _fil-res1, _fil-res2,
*/
    /*                    _file-number, _last-change, _numfld, _numkcomp,
*/
    /*                    _numkey, _numkfld, and _template
*/
    /* are system reserved fields and cannot be updated.
*/

    CREATE tar._file.
    ASSIGN 
      tar._file._db-recid      = RECID(tar._db)
      tar._file._file-name     = src._file._file-name
      tar._file._desc          = src._file._desc
      tar._file._valexp        = src._file._valexp
      tar._file._valmsg        = src._file._valmsg
      tar._file._hidden        = src._file._hidden
      tar._file._frozen        = src._file._frozen
      tar._file._dump-name     = src._file._dump-name
      tar._file._can-dump      = src._file._can-dump
      tar._file._can-load      = src._file._can-load
      tar._file._file-label    = src._file._file-label
      tar._file._file-label-sa = src._file._file-label-sa
      tar._file._for-cnt1      = src._file._for-cnt1
      tar._file._for-cnt2      = src._file._for-cnt2
      tar._file._for-flag      = src._file._for-flag
      tar._file._for-format    = src._file._for-format
      tar._file._for-id        = src._file._for-id
      tar._file._for-info      = src._file._for-info
      tar._file._for-name      = src._file._for-name
      tar._file._for-number    = src._file._for-number
      tar._file._for-owner     = src._file._for-owner
      tar._file._for-size      = src._file._for-size
      tar._file._for-type      = src._file._for-type
      tar._file._valmsg-sa     = src._file._valmsg-sa
      tar._file._can-create    = src._file._can-create
      tar._file._can-delete    = src._file._can-delete
      tar._file._can-read      = src._file._can-read
      tar._file._can-write     = src._file._can-write
      tar._file._dft-pk        = src._file._dft-pk
      .

    DO Mi = 1 TO 8:
      ASSIGN
        tar._file._fil-misc1[Mi] = src._file._fil-misc1[Mi]
        tar._file._fil-misc2[Mi] = src._file._fil-misc2[Mi]
        .
    END.  /* do mi = 1 to 8 */

    ASSIGN
      Mfile-recid = recid(tar._file)
      .

    /* Copy file triggers */

    FOR EACH src._file-trig OF src._file NO-LOCK:
      CREATE tar._file-trig.
      ASSIGN
        tar._file-trig._file-recid = RECID(tar._file)
        tar._file-trig._event      = src._file-trig._event
        tar._file-trig._override   = src._file-trig._override
        tar._file-trig._proc-name  = src._file-trig._proc-name
        tar._file-trig._trig-crc   = src._file-trig._trig-crc
        .
      END.  /* for each src._file-trig of src._file */

    FOR EACH src._field OF src._file NO-LOCK 
      BY src._field._field-rpos:  /* note sort by _field-rpos to fix crc */

      ASSIGN Mfld-num = Mfld-num + 1.

      /* Create dummy fields to preserve _file._numfld count */

      DO Mfld-num = Mfld-num TO src._field._field-rpos - 1:
        ASSIGN Mtmp-order = Mtmp-order + 1.
        CREATE tar._field.
        ASSIGN
          tar._field._file-recid  = RECID(tar._file)
          tar._field._field-name  = "xxxxxxxxxxxxx" +
STRING(Mtmp-order,"999999")
          tar._field._order       = 10000000 - Mtmp-order 
          tar._field._mandatory   = no
          tar._field._data-type   = "character" 
          tar._field._decimals    = ?
          tar._field._extent      = 0
          tar._field._col-label   = ?
          tar._field._fld-case    = no
          .
        END.  /* do mfld-num = mfld-num to src._field._field-rpos - 1 */
 
      /* Copy fields.
*/
      /* Note _field fields: _dtype, _field-rpos, _fld-res1, _fld-res2,
*/
      /*                     and _sys-field
*/
      /* are system reserved fields and cannot be updated.
*/

      CREATE tar._field.
      ASSIGN
        tar._field._file-recid    = RECID(tar._file)
        tar._field._field-name    = src._field._field-name
        tar._field._order         = src._field._order
        tar._field._mandatory     = src._field._mandatory
        tar._field._data-type     = src._field._data-type
        tar._field._format        = src._field._format
        tar._field._initial       = src._field._initial
        tar._field._label         = src._field._label
        tar._field._decimals      = src._field._decimals
        tar._field._extent        = src._field._extent
        tar._field._valexp        = src._field._valexp
        tar._field._valmsg        = src._field._valmsg
        tar._field._help          = src._field._help
        tar._field._desc          = src._field._desc
        tar._field._col-label     = src._field._col-label
        tar._field._fld-case      = src._field._fld-case
        tar._field._can-read      = src._field._can-read
        tar._field._can-write     = src._field._can-write
        tar._field._col-label-sa  = src._field._col-label-sa
        tar._field._fld-stdtype   = src._field._fld-stdtype
        tar._field._fld-stlen     = src._field._fld-stlen
        tar._field._fld-stoff     = src._field._fld-stoff
        tar._field._for-allocated = src._field._for-allocated
        tar._field._for-id        = src._field._for-id
        tar._field._for-itype     = src._field._for-itype
        tar._field._for-maxsize   = src._field._for-maxsize
        tar._field._for-name      = src._field._for-name
        tar._field._for-primary   = src._field._for-primary
        tar._field._for-retrieve  = src._field._for-retrieve
        tar._field._for-scale     = src._field._for-scale
        tar._field._for-separator = src._field._for-separator
        tar._field._for-spacing   = src._field._for-spacing
        tar._field._for-type      = src._field._for-type
        tar._field._for-xpos      = src._field._for-xpos
        tar._field._format-sa     = src._field._format-sa
        tar._field._help-sa       = src._field._help-sa
        tar._field._initial-sa    = src._field._initial-sa
        tar._field._label-sa      = src._field._label-sa
        tar._field._valmsg-sa     = src._field._valmsg-sa
        tar._field._view-as       = src._field._view-as
        .

      DO Mi = 1 TO 8:
        ASSIGN
          tar._field._fld-misc1[Mi] = src._field._fld-misc1[Mi]
          tar._field._fld-misc2[Mi] = src._field._fld-misc2[Mi]
          .
        END.  /* do mi = 1 to 8 */

      /* Copy field triggers
*/
      /* Note _field-trig fields: _field-rpos
*/
      /* are system reserved fields and cannot be updated.
*/

      FOR EACH src._field-trig OF src._field NO-LOCK:
        CREATE tar._field-trig.
        ASSIGN
          tar._field-trig._file-recid   = RECID(tar._file)
          tar._field-trig._field-recid  = RECID(tar._field)
          tar._field-trig._event        = src._field-trig._event
          tar._field-trig._override     = src._field-trig._override
          tar._field-trig._proc-name    = src._field-trig._proc-name
          tar._field-trig._trig-crc     = src._field-trig._trig-crc
          .
        END.  /* for each src._field-trig of src._field */

      END.  /* for each src._field of src._file */

    /* Copy indices
*/
    /* Note _index fields: _i-res1, _i-res2, and _num-comp
*/
    /* are system reserved fields and cannot be updated.
*/

    FOR EACH src._index OF src._file NO-LOCK:

      CREATE tar._index.
      ASSIGN
        tar._index._file-recid = RECID(tar._file)
        tar._index._index-name = src._index._index-name
        tar._index._unique     = src._index._unique
        tar._index._idx-num    = src._index._idx-num  /* fix crc problem */
        tar._index._active     = src._index._active
        tar._index._wordidx    = src._index._wordidx
        tar._index._desc       = src._index._desc
        tar._index._for-name   = src._index._for-name
        tar._index._for-type   = src._index._for-type
        .

      DO Mi = 1 TO 8:
        ASSIGN
          tar._index._i-misc1[Mi] = src._index._i-misc1[Mi]
          tar._index._i-misc2[Mi] = src._index._i-misc2[Mi]
          .
        END.  /* do mi = 1 to 8 */

      IF src._file._prime-index = RECID(src._index) THEN
        ASSIGN tar._file._prime-index = RECID(tar._index).

      /* Copy index fields
*/
      /* Note _index-field fields: _if-res1, and _if-res2
*/
      /* are system reserved fields and cannot be updated.
*/

      FOR EACH src._index-field OF src._index NO-LOCK:
        FIND src._field OF src._index-field NO-LOCK.

        FIND tar._field OF tar._file
          WHERE tar._field._field-name = src._field._field-name NO-LOCK.

        CREATE tar._index-field.
        ASSIGN
          tar._index-field._index-recid = RECID(tar._index)
          tar._index-field._field-recid = RECID(tar._field)
          tar._index-field._index-seq   = src._index-field._index-seq
          tar._index-field._ascending   = src._index-field._ascending
          tar._index-field._abbreviate  = src._index-field._abbreviate
          tar._index-field._unsorted    = src._index-field._unsorted
          .

        DO Mi = 1 TO 8:
          ASSIGN
            tar._index-field._if-misc1[Mi] = src._index-field._if-misc1[Mi]
            tar._index-field._if-misc2[Mi] = src._index-field._if-misc2[Mi]
            .
          END.  /* do mi = 1 to 8 */

        END. /* for each src._field of src._index-field */

      END. /* for each src._index of src._file */

    RELEASE tar._file.
    END.  /* if not can-find... then do transaction */

  ELSE DO TRANSACTION:
    /* Copy tables with no indices defined.
*/
    /* Note _file fields: _cache, _crc, _db-lang, _fil-res1, _fil-res2,
*/
    /*                    _file-number, _last-change, _numfld, _numkcomp,
*/
    /*                    _numkey, _numkfld, and _template
*/
    /* are system reserved fields and cannot be updated.
*/

    CREATE tar._file.
    ASSIGN 
      tar._file._db-recid      = RECID(tar._db)
      tar._file._file-name     = src._file._file-name
      tar._file._desc          = src._file._desc
      tar._file._valexp        = src._file._valexp
      tar._file._valmsg        = src._file._valmsg
      tar._file._hidden        = src._file._hidden
      tar._file._frozen        = src._file._frozen
      tar._file._dump-name     = src._file._dump-name
      tar._file._can-dump      = src._file._can-dump
      tar._file._can-load      = src._file._can-load
      tar._file._file-label    = src._file._file-label
      tar._file._file-label-sa = src._file._file-label-sa
      tar._file._for-cnt1      = src._file._for-cnt1
      tar._file._for-cnt2      = src._file._for-cnt2
      tar._file._for-flag      = src._file._for-flag
      tar._file._for-format    = src._file._for-format
      tar._file._for-id        = src._file._for-id
      tar._file._for-info      = src._file._for-info
      tar._file._for-name      = src._file._for-name
      tar._file._for-number    = src._file._for-number
      tar._file._for-owner     = src._file._for-owner
      tar._file._for-size      = src._file._for-size
      tar._file._for-type      = src._file._for-type
      tar._file._valmsg-sa     = src._file._valmsg-sa
      tar._file._can-create    = src._file._can-create
      tar._file._can-delete    = src._file._can-delete
      tar._file._can-read      = src._file._can-read
      tar._file._can-write     = src._file._can-write
      tar._file._dft-pk        = src._file._dft-pk
      .

    DO Mi = 1 TO 8:
      ASSIGN
        tar._file._fil-misc1[Mi] = src._file._fil-misc1[Mi]
        tar._file._fil-misc2[Mi] = src._file._fil-misc2[Mi]
        .
      END.  /* do mi = 1 to 8 */

    ASSIGN Mfile-recid = recid(tar._file).

    /* Copy file triggers */

    FOR EACH src._file-trig OF src._file NO-LOCK:
      CREATE tar._file-trig.
      ASSIGN
        tar._file-trig._file-recid = RECID(tar._file)
        tar._file-trig._event      = src._file-trig._event
        tar._file-trig._override   = src._file-trig._override
        tar._file-trig._proc-name  = src._file-trig._proc-name
        tar._file-trig._trig-crc   = src._file-trig._trig-crc
        .
      END.  /* for each src._file-trig of src._file */

    FOR EACH src._field OF src._file NO-LOCK 
      BY src._field._field-rpos:  /* note sort by _field-rpos to fix crc */

      ASSIGN Mfld-num = Mfld-num + 1.

      /* Create dummy fields to preserve _file._numfld count */

      DO Mfld-num = Mfld-num TO src._field._field-rpos - 1:
        ASSIGN Mtmp-order = Mtmp-order + 1.
        CREATE tar._field.
        ASSIGN
          tar._field._file-recid  = RECID(tar._file)
          tar._field._field-name  = "xxxxxxxxxxxxx" +
STRING(Mtmp-order,"999999")
          tar._field._order       = 10000000 - Mtmp-order 
          tar._field._mandatory   = no
          tar._field._data-type   = "character" 
          tar._field._decimals    = ?
          tar._field._extent      = 0
          tar._field._col-label   = ?
          tar._field._fld-case    = no
          .
        END.  /* do mfld-num = mfld-num to src._field._field-rpos - 1 */
      /* Copy fields.
*/
      /* Note _field fields: _dtype, _field-rpos, _fld-res1, _fld-res2,
*/
      /*                     and _sys-field
*/
      /* are system reserved fields and cannot be updated.
*/


      CREATE tar._field.
      ASSIGN
        tar._field._file-recid    = RECID(tar._file)
        tar._field._field-name    = src._field._field-name
        tar._field._order         = src._field._order
        tar._field._mandatory     = src._field._mandatory
        tar._field._data-type     = src._field._data-type
        tar._field._format        = src._field._format
        tar._field._initial       = src._field._initial
        tar._field._label         = src._field._label
        tar._field._decimals      = src._field._decimals
        tar._field._extent        = src._field._extent
        tar._field._valexp        = src._field._valexp
        tar._field._valmsg        = src._field._valmsg
        tar._field._help          = src._field._help
        tar._field._desc          = src._field._desc
        tar._field._col-label     = src._field._col-label
        tar._field._fld-case      = src._field._fld-case
        tar._field._can-read      = src._field._can-read
        tar._field._can-write     = src._field._can-write
        tar._field._col-label-sa  = src._field._col-label-sa
        tar._field._fld-stdtype   = src._field._fld-stdtype
        tar._field._fld-stlen     = src._field._fld-stlen
        tar._field._fld-stoff     = src._field._fld-stoff
        tar._field._for-allocated = src._field._for-allocated
        tar._field._for-id        = src._field._for-id
        tar._field._for-itype     = src._field._for-itype
        tar._field._for-maxsize   = src._field._for-maxsize
        tar._field._for-name      = src._field._for-name
        tar._field._for-primary   = src._field._for-primary
        tar._field._for-retrieve  = src._field._for-retrieve
        tar._field._for-scale     = src._field._for-scale
        tar._field._for-separator = src._field._for-separator
        tar._field._for-spacing   = src._field._for-spacing
        tar._field._for-type      = src._field._for-type
        tar._field._for-xpos      = src._field._for-xpos
        tar._field._format-sa     = src._field._format-sa
        tar._field._help-sa       = src._field._help-sa
        tar._field._initial-sa    = src._field._initial-sa
        tar._field._label-sa      = src._field._label-sa
        tar._field._valmsg-sa     = src._field._valmsg-sa
        tar._field._view-as       = src._field._view-as
        .

      DO Mi = 1 TO 8:
        ASSIGN
          tar._field._fld-misc1[Mi] = src._field._fld-misc1[Mi]
          tar._field._fld-misc2[Mi] = src._field._fld-misc2[Mi]
          .
        END.  /* do mi = 1 to 8 */

      /* Copy field triggers
*/
      /* Note _field-trig fields: _field-rpos
*/
      /* are system reserved fields and cannot be updated.
*/

      FOR EACH src._field-trig OF src._field NO-LOCK:
        CREATE tar._field-trig.
        ASSIGN
          tar._field-trig._file-recid   = RECID(tar._file)
          tar._field-trig._field-recid  = RECID(tar._field)
          tar._field-trig._event        = src._field-trig._event
          tar._field-trig._override     = src._field-trig._override
          tar._field-trig._proc-name    = src._field-trig._proc-name
          tar._field-trig._trig-crc     = src._field-trig._trig-crc
          .
        END.  /* for each src._field-trig of src._field */

      END.  /* for each src._field of src._file */

    RELEASE tar._file.
    END.  /* if not can-find... else do transaction */

  DO TRANSACTION:
    FIND tar._file WHERE RECID(tar._file) = Mfile-recid NO-LOCK.
       
    FOR EACH tar._field OF tar._file
      WHERE tar._field._field-name BEGINS "xxxxxxxxxxxx"
      EXCLUSIVE-LOCK:
      DELETE tar._field.
      END.

    END.  /* do transaction */

  END.  /* for each src._file */

/* Copy database sequences
*/
/* Note _sequence fields: _cache, _crc, _db-lang, _fil-res1, _fil-res2,
*/
/*                        _file-number, _last-change, _numfld, _numkcomp,
*/
/*                        _numkey, _numkfld, and _template
*/
/* are system reserved fields and cannot be updated.
*/

FOR EACH src._sequence NO-LOCK:
  CREATE tar._sequence.
  ASSIGN
    tar._sequence._seq-name = src._sequence._seq-name
    tar._sequence._cycle-ok = src._sequence._cycle-ok
    tar._sequence._seq-min  = src._sequence._seq-min
    tar._sequence._seq-max  = src._sequence._seq-max
    tar._sequence._seq-incr = src._sequence._seq-incr
    tar._sequence._seq-init = src._sequence._seq-init
    tar._sequence._db-recid = RECID(tar._db)
    .
  DO Mi = 1 TO 8:
    ASSIGN
      tar._sequence._seq-misc[Mi] = src._sequence._seq-misc[Mi]
      .
    END.  /* do mi = 1 to 8 */
  END.  /* for each src._sequence */

/* end of schcopy.p */