/* crccmp2.p */
/* Copyright (C) 1999 Kean Maizels and Grant Maizels */

/* This program is an expanded version of  crccmp.p for use when you want to
   know why the crcs are different. I have used it for debugging crcdf.p
   but it could be used elsewhere.
   
   Errors are output to the physical name of the alias "dictdb2" with a ".err"
   extension. In the error messages the "new" database corresponds to the
   alias "dictdb2" while the "old" database corrisponds to the alias "dictdb".
*/

/* CRC checks are based on PKB 5527, 16166, and 11428
   which should be correct for progress version 7
   we also assume that the _seq-num affects CRCs - this is probably wrong,
   but conservitive.
*/

def stream err.
def var errfile as char no-undo.
def var i as integer no-undo.
def var j as integer no-undo.
def var ecnt as integer no-undo initial 0.

errfile = pdbname("dictdb2") + ".err".
output stream err to value(errfile).

for each dictdb._file no-lock where not dictdb._file._file-name begins "_"
  by dictdb._file._file-name:
  find dictdb2._file no-lock where
    dictdb2._file._file-name = dictdb._file._file-name
    no-error.
  if not available dictdb2._file then 
  do:
    ecnt = ecnt + 1.
    put stream err unformatted
      "Table: " dictdb._file._file-name " not in new database." skip (1).
  end.
  else if dictdb2._file._crc <> dictdb._file._crc then 
  do:
    ecnt = ecnt + 1.
    put stream err unformatted
      "Table: " dictdb._file._file-name " CRCs do not match. Old: "
      dictdb._file._crc " New: " dictdb2._file._crc "."
      skip.
    if dictdb._file._db-lang <> dictdb2._file._db-lang then
    put stream err unformatted
      "  DB Language do not match. Old: "
      dictdb._file._db-lang " New: " dictdb2._file._db-lang "."
      skip.
    for each dictdb._field of dictdb._file no-lock:
      find dictdb2._field of dictdb2._file no-lock
	where dictdb2._field._field-name = dictdb._field._field-name
	no-error.
      if not available dictdb2._field then
      do:
        put stream err unformatted
          "  Field: " dictdb._field._field-name " not in new database." skip.
        next.
      end.
      if dictdb._field._field-rpos <> dictdb2._field._field-rpos then
	put stream err unformatted
	  "  Field RPos does not match for " dictdb._field._field-name
	  " Old: " dictdb._field._field-rpos 
	  " New: " dictdb2._field._field-rpos "."
	  skip.
      if dictdb._field._data-type <> dictdb2._field._data-type then
	put stream err unformatted
	  "  Field Data Type does not match for " dictdb._field._field-name
	  " Old: " dictdb._field._data-type 
	  " New: " dictdb2._field._data-type "."
	  skip.
      if dictdb._field._sys-field <> dictdb2._field._sys-field then
	put stream err unformatted
	  "  Field Sys Field does not match for " dictdb._field._field-name
	  " Old: " dictdb._field._sys-field 
	  " New: " dictdb2._field._sys-field "."
	  skip.
      if dictdb._field._decimals <> dictdb2._field._decimals then
	put stream err unformatted
	  "  Field Decimals do not match for " dictdb._field._field-name
	  " Old: " dictdb._field._decimals 
	  " New: " dictdb2._field._decimals "."
	  skip.
      if dictdb._field._order <> dictdb2._field._order then
	put stream err unformatted
	  "  Field Order does not match for " dictdb._field._field-name
	  " Old: " dictdb._field._order 
	  " New: " dictdb2._field._order "."
	  skip.
      if dictdb._field._extent <> dictdb2._field._extent then
	put stream err unformatted
	  "  Field Extent does not match for " dictdb._field._field-name
	  " Old: " dictdb._field._extent 
	  " New: " dictdb2._field._extent "."
	  skip.
      if dictdb._field._fld-stdtype <> dictdb2._field._fld-stdtype then
	put stream err unformatted
	  "  Field StdType does not match for " dictdb._field._field-name
	  " Old: " dictdb._field._fld-stdtype 
	  " New: " dictdb2._field._fld-stdtype "."
	  skip.
      if dictdb._field._fld-stlen <> dictdb2._field._fld-stlen then
	put stream err unformatted
	  "  Field StLen does not match for " dictdb._field._field-name
	  " Old: " dictdb._field._fld-stlen 
	  " New: " dictdb2._field._fld-stlen "."
	  skip.
      if dictdb._field._fld-stoff <> dictdb2._field._fld-stoff then
	put stream err unformatted
	  "  Field StOff does not match for " dictdb._field._field-name
	  " Old: " dictdb._field._fld-stoff 
	  " New: " dictdb2._field._fld-stoff "."
	  skip.
      if dictdb._field._fld-case <> dictdb2._field._fld-case then
	put stream err unformatted
	  "  Field Case does not match for " dictdb._field._field-name
	  " Old: " dictdb._field._fld-case 
	  " New: " dictdb2._field._fld-case "."
	  skip.
    end.
    for each dictdb2._field of dictdb2._file no-lock:
      find dictdb._field of dictdb._file no-lock
	where dictdb._field._field-name = dictdb2._field._field-name
	no-error.
      if not available dictdb._field then
      do:
        put stream err unformatted
	  "  Field: " dictdb2._field._field-name " not in old database." skip.
      end.
    end.
    for each dictdb._index of dictdb._file no-lock:
      find dictdb2._index of dictdb2._file no-lock
	where dictdb2._index._index-name = dictdb._index._index-name
	no-error.
      if not available dictdb2._index then
      do:
        put stream err unformatted
	  "  Index: " dictdb._index._index-name " not in new database." skip.
      end.
      if dictdb._index._idx-num <> dictdb2._index._idx-num and
	dbversion("dictdb") begins "6" then 
	put stream err unformatted
	  "  Index Num does not match for " dictdb._index._index-name
	  " Old: " dictdb._index._idx-num 
	  " New: " dictdb2._index._idx-num "."
	  skip.
      if dictdb._index._unique <> dictdb2._index._unique then
	put stream err unformatted
	  "  Index Uniqueness does not match for " dictdb._index._index-name
	  " Old: " dictdb._index._unique 
	  " New: " dictdb2._index._unique "."
	  skip.
      if dictdb._index._num-comp <> dictdb2._index._num-comp then
	put stream err unformatted
	  "  Index Uniqueness does not match for " dictdb._index._index-name
	  " Old: " dictdb._index._num-comp 
	  " New: " dictdb2._index._num-comp "."
	  skip.
      for each dictdb._index-field no-lock of dictdb._index:
	find dictdb._field no-lock of dictdb._index-field.
	find dictdb2._index-field no-lock of dictdb2._index 
	  where dictdb2._index-field._index-seq = dictdb._index-field._index-seq
	    no-error.
	if not available dictdb2._index-field then
	do:
	  put stream err unformatted
	    "  Index-Field: " 
	    dictdb._field._field-name 
	    " Sequence: "
	    dictdb._index-field._index-seq
	    " not in new database." skip.
	   next.
	end.
	find dictdb2._field no-lock of dictdb2._index-field.
	if dictdb._field._field-name <> dictdb2._field._field-name then
	  put stream err unformatted
	    "  Index-Feild Field Name does not match for Sequence:"
	    dictdb._index-field._index-seq
	    " Old: " dictdb._field._field-name 
	    " New: " dictdb2._field._field-name "."
	    skip.
	if dictdb._index-field._ascending <> dictdb2._index-field._ascending 
	  then
	  put stream err unformatted
	    "  Index-Field Ascending does not match for Index: "
	    dictdb._index._index-name
	    " Field: "
	    dictdb._field._field-name
	    " Old: " dictdb._index-field._ascending 
	    " New: " dictdb2._index-field._ascending "."
	    skip.
	if dictdb._index-field._abbreviate <> dictdb2._index-field._abbreviate 
	  then
	  put stream err unformatted
	    "  Index-Field Ascending does not match for Index: "
	    dictdb._index._index-name
	    " Field: "
	    dictdb._field._field-name
	    " Old: " dictdb._index-field._abbreviate
	    " New: " dictdb2._index-field._abbreviate "."
	    skip.
	if dictdb._index-field._unsorted <> dictdb2._index-field._unsorted 
	  then
	  put stream err unformatted
	    "  Index-Field Ascending does not match for Index: "
	    dictdb._index._index-name
	    " Field: "
	    dictdb._field._field-name
	    " Old: " dictdb._index-field._unsorted 
	    " New: " dictdb2._index-field._unsorted "."
	    skip.
      end.
      for each dictdb2._index-field no-lock of dictdb2._index:
	find dictdb2._field no-lock of dictdb2._index-field.
	find dictdb._index-field no-lock of dictdb._index 
	  where dictdb._index-field._index-seq = dictdb2._index-field._index-seq
	    no-error.
	if not available dictdb._index-field then
	do:
	  put stream err unformatted
	    "  Index-Field: " 
	    dictdb2._field._field-name 
	    " Sequence: "
	    dictdb2._index-field._index-seq
	    " not in old database." skip.
	   next.
	end.
      end.
    end.
    for each dictdb2._index of dictdb2._file no-lock:
      find dictdb._index of dictdb._file no-lock
	where dictdb._index._index-name = dictdb2._index._index-name
	no-error.
      if not available dictdb._index then
      do:
        put stream err unformatted
	  "  Index: " dictdb2._index._index-name " not in old database." skip.
      end.
    end.
    put stream err unformatted skip(1).
  end.
end.

for each dictdb2._file no-lock where not dictdb._file._file-name begins "_"
  by dictdb2._file._file-name:
  find dictdb._file no-lock where
    dictdb._file._file-name = dictdb2._file._file-name
    no-error.
  if not available dictdb._file then 
  do:
    ecnt = ecnt + 1.
    put stream err unformatted
      "Table: " dictdb._file._file-name " not in old database." skip (1).
  end.
end.

find dictdb._file no-lock
  where dictdb._file._file-name = "_sequence"
  no-error.
find dictdb2._file no-lock
  where dictdb2._file._file-name = "_sequence"
  no-error.
if dictdb._file._crc <> dictdb._file._crc then
do:
  ecnt = ecnt + 1.
  put stream err unformatted
    "Sequence  CRCs do not match. Old: "
    dictdb._file._crc " New: " dictdb2._file._crc "."
    skip.
  for each dictdb._sequence no-lock:
    find dictdb2._sequence no-lock
      where dictdb2._sequence._seq-name = dictdb._sequence._seq-name no-error.
    if not available dictdb2._sequence then
    do:
    put stream err unformatted
      "Sequence: " dictdb._sequence._seq-name " not in new database." skip (1).
    end.
    if dictdb._sequence._seq-num <> dictdb2._sequence._seq-num then
      put stream err unformatted
	"  Sequence Increment does not match for " dictdb._sequence._seq-name
	" Old: " dictdb._sequence._seq-num 
	" New: " dictdb2._sequence._seq-num 
	" this may not be an error."
	skip.
    if dictdb._sequence._seq-incr <> dictdb2._sequence._seq-incr then
      put stream err unformatted
	"  Sequence Increment does not match for " dictdb._sequence._seq-name
	" Old: " dictdb._sequence._seq-incr 
	" New: " dictdb2._sequence._seq-incr "."
	skip.
    if dictdb._sequence._seq-min <> dictdb2._sequence._seq-min then
      put stream err unformatted
	"  Sequence Increment does not match for " dictdb._sequence._seq-name
	" Old: " dictdb._sequence._seq-min 
	" New: " dictdb2._sequence._seq-min "."
	skip.
    if dictdb._sequence._seq-max <> dictdb2._sequence._seq-max then
      put stream err unformatted
	"  Sequence Increment does not match for " dictdb._sequence._seq-name
	" Old: " dictdb._sequence._seq-max 
	" New: " dictdb2._sequence._seq-max "."
	skip.
    if dictdb._sequence._cycle-ok <> dictdb2._sequence._cycle-ok then
      put stream err unformatted
	"  Sequence Increment does not match for " dictdb._sequence._seq-name
	" Old: " dictdb._sequence._cycle-ok 
	" New: " dictdb2._sequence._cycle-ok "."
	skip.
  end.
  for each dictdb2._sequence no-lock:
    find dictdb._sequence no-lock
      where dictdb._sequence._seq-name = dictdb2._sequence._seq-name no-error.
    if not available dictdb._sequence then
    do:
    put stream err unformatted
      "Sequnce: " dictdb2._sequence._seq-name " not in new database." skip (1).
    end.
  end.
end.

if ecnt <> 0 then
do:
  message ecnt "errors. see file" errfile "for details.".
end.