!*******************************************************************************
!  Program:     ALTAUDIT.SQR
!*******************************************************************************
!
!  Programmer:  David L Price (Ideatec, Inc.)
!               www.ideatec.us
!  Email:       david@ideatec.com
!  Phone:       (510) 853-4070
!
!*******************************************************************************
!
!  This program is the original work of David L. Price of Ideatec, Inc.
!  All Rights Reserved.
!
!*******************************************************************************
!
!  In addition to running the SYSAUDIT and DDDAUDIT SQR, PeopleSoft clients
!  should run the Alter Audit.  Unforutnatly, in the past, this has been a
!  manual and long process.  And, even then, the results were not presented
!  in a clean format.  This has led me to develop the SQR-Based Alter Audit.
!  This program will compare the PeopleSoft Record Definitions for Tables
!  (RECTYPE = 0) and compare them to the ORACLE definition for the record.
!  Any differences will be reported.
!
!*******************************************************************************
!                   Known Issues
!
!  None.... but it is still early
!
!*******************************************************************************
!                   SQR Modification Log
!
!    DATE      DESCRIPTION
! ==========   ===================================================
! 01-02-2002   Created for PeopleSoft 8 using ORACLE.
!
! 01/14/2004  (SQR 6806) String2Em: String to Decimal Object Conversion Error.
!
!*******************************************************************************

#define TRUE  1
#define FALSE 0

#define ColR     108
#define LANGUAGE_REPORT 'ENG'
#define LAST_UPDATED    'January 14, 2004'

!*******************************************************************************
begin-setup
!*******************************************************************************

printer-init <27>E<27>(0N<27>&l0O<27>&l8D<27>&l88F<27>(s16.66H<27>&a9L
page-size 79 125

end-setup

!*******************************************************************************
begin-heading 5
!*******************************************************************************

print '          '      (1,1)        center

print 'Report ID:  '    (+1,1)
print $ReportID         ()
uppercase $ReportTitle
print $ReportTitle      ()           center
let #RptCol = {ColR} - 2
page-number             (0,#RptCol)  'Page No.  '

print 'DBName:     '    (+1,1)
print &Database_Name    ()
print 'Run Date '       (0,#RptCol)
print &ReportDate       ()

print 'Run Time '       (+1,#RptCol)
print &ReportTime       ()

print 'Record              Field               PeopleSoft Type       Comments' (+1,1)
print '------------------  ------------------  --------------------  -----------------------------' (+1,1)

end-heading

!*******************************************************************************
begin-program
!*******************************************************************************

move 'ALTAUDIT'                         to $ReportID
move 'PeopleSoft SQR-Based Alter Audit' to $ReportTitle

do Program-Init
do Get-Parameters

date-time () MM/DD/YYYY  &ReportDate
date-time () HH:MI       &ReportTime
show ' '
show 'Started:  ' &ReportDate ' ' &ReportTime

do Get-Total-Record-Count
do Analyze-PS-Tables

show ' '
date-time () MM/DD/YYYY  &ReportDate2
date-time () HH:MI       &ReportTime2
show 'Finished: ' &ReportDate2 ' ' &ReportTime2

end-program

!*******************************************************************************
begin-procedure Program-Init
!*******************************************************************************

show '------------------------------------------------------------------------'
show $ReportTitle
show {LAST_UPDATED}
show 'by David L. Price (david@IdeatecInc.com)'
show '------------------------------------------------------------------------'

! Get Database Name
begin-select loops=1
DBNAME &Database_Name
from ps.psdbowner
end-select

show 'Running on ' &Database_Name
show ' '

! Initialize Arrays
let #PSCount = 0
create-array name=PSRecField size=255
   field=FieldName:char
   field=FieldType:char
   field=Length:char
   field=DecPos:char
   field=RawBinary:char

let #ORACount = 0
create-array name=ORARecField size=255
   field=COLUMN_NAME:char
   field=DATA_TYPE:char
   field=DATA_LENGTH:char
   field=DATA_PRECISION:char
   field=DATA_SCALE:char
   field=Found:char='N'

end-procedure

!*******************************************************************************
begin-procedure Analyze-PS-Tables
!*******************************************************************************

let #RecCount = 0

begin-select
RD.RECNAME
nvl(rtrim(RD.SQLTABLENAME), 'PS_' || RD.RECNAME) &RD.SQLTABLENAME

   add 1 to #RecCount
   let #Rec_Left = &TOTAL_RECORD_COUNT - #RecCount
   if mod(#Rec_Left,1000) = 0
      show #Rec_Left edit 999999 noline
      show ' records remaining'
   end-if

   clear-array name=PSRecField
   let #PSCount = 0

   clear-array name=ORARecField
   let #ORACount = 0

   do Lookup-ORA-Fields
   if #ORATableExists
      do Lookup-PS-Fields
      do Validate-Fields
      do Check-For-ORA-Fields-Not-In-PS
   else
      ! ==  Use DDDAudit to report on missing tables ==
   end-if

from PSRECDEFN RD
where RD.RECTYPE = 0
[$WhereClause]
end-select

end-procedure

!*******************************************************************************
begin-procedure Lookup-ORA-Fields
!*******************************************************************************

let #ORATableExists = {FALSE}

begin-select
DTC.COLUMN_NAME
DTC.DATA_TYPE
nvl(DTC.DATA_LENGTH,'') &DTC.DATA_LENGTH
nvl(DTC.DATA_PRECISION,'') &DTC.DATA_PRECISION
nvl(DTC.DATA_SCALE,'') &DTC.DATA_SCALE
DTC.NULLABLE

   let #ORATableExists = {TRUE}
   add 1 to #ORACount
   let ORARecField.COLUMN_NAME(#ORACount)    = &DTC.COLUMN_NAME
   let ORARecField.DATA_TYPE(#ORACount)      = &DTC.DATA_TYPE
   let ORARecField.DATA_LENGTH(#ORACount)    = ltrim(edit(&DTC.DATA_LENGTH,'99999nu'),' ')
   let ORARecField.DATA_PRECISION(#ORACount) = ltrim(edit(&DTC.DATA_PRECISION,'99999nu'),' ')
   let ORARecField.DATA_SCALE(#ORACount)     = ltrim(edit(&DTC.DATA_SCALE,'99999nu'),' ')

from DBA_TABLES       dt,
     DBA_TAB_COLUMNS  dtc
where DT.OWNER       = 'SYSADM'
and   DT.TABLE_NAME  = &RD.SQLTABLENAME
and   DTC.OWNER      = DT.OWNER
and   DTC.TABLE_NAME = DT.TABLE_NAME
end-select

end-procedure

!*******************************************************************************
begin-procedure Lookup-PS-Fields
!*******************************************************************************

begin-select
RF.FIELDNAME
DB.FIELDTYPE
decode(DB.FORMAT,7,'Y','N') &RawBinary
DB.LENGTH
DB.DECIMALPOS
RF.SUBRECORD

   if &RF.SUBRECORD = 'N'
      add 1 to #PSCount
      let PSRecField.FieldName(#PSCount) = &RF.FIELDNAME
      let PSRecField.FieldType(#PSCount) = ltrim(edit(&DB.FIELDTYPE,'99999nu'),' ')
      let PSRecField.Length(#PSCount)    = ltrim(edit(&DB.LENGTH,'99999nu'),' ')
      let PSRecField.DecPos(#PSCount)    = ltrim(edit(&DB.DECIMALPOS,'99999nu'),' ')
      let PSRecField.RawBinary(#PSCount) = &RawBinary
   else
      do Lookup-Subrecord
   end-if

from PSDBFIELD  DB,
     PSRECFIELD RF
where RF.RECNAME       = &RD.RECNAME
and   DB.FIELDNAME (+) = RF.FIELDNAME
end-select

end-procedure

!*******************************************************************************
begin-procedure Lookup-Subrecord
!*******************************************************************************

begin-select
RF2.FIELDNAME
DB2.FIELDTYPE
decode(DB2.FORMAT,7,'Y','N') &RawBinary2
DB2.LENGTH
DB2.DECIMALPOS
RF2.SUBRECORD

   if &RF2.SUBRECORD = 'N'
      add 1 to #PSCount
      let PSRecField.FieldName(#PSCount) = &RF2.FIELDNAME
      let PSRecField.FieldType(#PSCount) = ltrim(edit(&DB2.FIELDTYPE,'99999nu'),' ')
      let PSRecField.Length(#PSCount)    = ltrim(edit(&DB2.LENGTH,'99999nu'),' ')
      let PSRecField.DecPos(#PSCount)    = ltrim(edit(&DB2.DECIMALPOS,'99999nu'),' ')
      let PSRecField.RawBinary(#PSCount) = &RawBinary2
   else
      do Lookup-Subrecord2
   end-if

from PSDBFIELD  DB2,
     PSRECFIELD RF2
where RF2.RECNAME       = &RF.FIELDNAME
and   DB2.FIELDNAME (+) = RF2.FIELDNAME
end-select

end-procedure

!*******************************************************************************
begin-procedure Lookup-Subrecord2
!*******************************************************************************

begin-select
RF3.FIELDNAME
DB3.FIELDTYPE
decode(DB3.FORMAT,7,'Y','N') &RawBinary3
DB3.LENGTH
DB3.DECIMALPOS
RF3.SUBRECORD

   if &RF3.SUBRECORD = 'N'
      add 1 to #PSCount
      let PSRecField.FieldName(#PSCount) = &RF3.FIELDNAME
      let PSRecField.FieldType(#PSCount) = ltrim(edit(&DB3.FIELDTYPE,'99999nu'),' ')
      let PSRecField.Length(#PSCount)    = ltrim(edit(&DB3.LENGTH,'99999nu'),' ')
      let PSRecField.DecPos(#PSCount)    = ltrim(edit(&DB3.DECIMALPOS,'99999nu'),' ')
      let PSRecField.RawBinary(#PSCount) = &RawBinary3
   else
      show '********* ERROR **********'
      show 'Subrecord has a subrecord with a subrecord (good grief)....'
      show 'Record.............. ' &RD.RECNAME
      show 'Subrecord.............. ' &RF.FIELDNAME
      show 'Sub-Subrecord.............. ' &RF2.FIELDNAME
      stop quiet
   end-if

from PSDBFIELD  DB3,
     PSRECFIELD RF3
where RF3.RECNAME       = &RF2.FIELDNAME
and   DB3.FIELDNAME (+) = RF3.FIELDNAME
end-select

end-procedure

!*******************************************************************************
begin-procedure Validate-Fields
!*******************************************************************************

let #i = 1
while #i <= #PSCount
   let $PS_FieldName = PSRecField.FieldName(#i)
   let $PS_FieldType = PSRecField.FieldType(#i)
   let $PS_Length    = PSRecField.Length (#i)
   let $PS_DecPos    = PSRecField.DecPos(#i)
   let $PS_RawBinary = PSRecField.RawBinary(#i)

   do Get-Oracle-Field-Information
   if #ORAFieldFound
      do Set-PeopleSoft-Comparable-Fields
      do Compare-Field-Attributes
      if not #FieldsSame
         do Generate-Field-Label
         next-listing no-advance need=3
         do Print-RecName
         print $PS_Fieldname       (0,21)
         print $FldType            (0,41)
         print 'ora:'              (0,63)
         print $ORA_TYPE           (0,68)
         print 's/b:'              (+1,63)
         print $Cmp_Type           (0,68)
      end-if
   else
      do Set-PeopleSoft-Comparable-Fields
      do Generate-ORA-Type ($CmpDataType, $CmpLength, $CmpPrecision, $CmpScale, $Cmp_Type)
      do Generate-Field-Label
      next-listing no-advance need=3
      do Print-RecName
      print $PS_Fieldname          (0,21)
      print $FldType               (0,41)
      print '** Not in ORACLE **'  (0,63)
      print 's/b:'                 (+1,63)
      print $Cmp_Type              (0,68)
   end-if
   add 1 to #i
end-while

end-procedure

!*******************************************************************************
begin-procedure Get-Oracle-Field-Information
!*******************************************************************************

let #ORAFieldFound = {FALSE}

let #j = 1
while #j <= #ORACount and not #ORAFieldFound
   let $ORA_COLUMN_NAME = ORARecField.COLUMN_NAME(#j)
   if $ORA_COLUMN_NAME = $PS_Fieldname
      let #ORAFieldFound = {TRUE}
      let ORARecField.Found(#j) = 'Y'
      let $ORA_DATA_TYPE        = ORARecField.DATA_TYPE(#j)
      let $ORA_DATA_LENGTH      = ORARecField.DATA_LENGTH(#j)
      let $ORA_DATA_PRECISION   = ORARecFIeld.DATA_PRECISION(#j)
      let $ORA_DATA_SCALE       = ORARecField.DATA_SCALE(#j)
   end-if
   add 1 to #j
end-while

end-procedure

!*******************************************************************************
begin-procedure Set-PeopleSoft-Comparable-Fields
!*******************************************************************************
! Translate PeopleSoft field definition into ORACLE field definition

let $CmpDataType  = ''
let $CmpLength    = ''
let $CmpPrecision = ''
let $CmpScale     = ''

evaluate $PS_FieldType
   when = '0'   ! Character
   when = '9'   ! Image Reference
      let $CmpDataType = 'VARCHAR2'
      let $CmpLength   = $PS_Length
      break
   when = '1'   ! Long
      if to_number($PS_Length) > 0 and to_number($PS_Length) < 4000
         let $CmpDataType = 'VARCHAR2'
         let $CmpLength   = $PS_Length
      else
         if $PS_RawBinary = 'Y'
            let $CmpDataType = 'LONG RAW'
         else
            let $CmpDataType = 'LONG'
         end-if
         let $CmpLength   = '0'
      end-if
      break
   when = '2'   ! Number
   when = '3'   ! Signed Number
      let $CmpDataType = 'NUMBER'
      let $CmpLength   = '22'
      let $CmpScale    = $PS_DecPos
      if $PS_RawBinary = 'N'
         if $PS_FieldType = '3'
            let #SignLenAdj = 1
         else
            let #SignLenAdj = 0
         end-if
         if to_number($PS_DecPos) > 0
            let $CmpPrecision = ltrim(edit(to_number($PS_Length) - 1 - #SignLenAdj,'999'),' ')
         else
            if (to_number($PS_Length) - #SignLenAdj) >= 10
               let $CmpPrecision = ltrim(edit(to_number($PS_Length) - #SignLenAdj,'999'),' ')
            end-if
         end-if
      end-if
      break
   when = '4'    ! Date
   when = '5'    ! Time
   when = '6'    ! DateTime
      let $CmpDataType = 'DATE'
      let $CmpLength   = '7'
      break
   when = '8'
      let $CmpDataType = 'LONG RAW'
      let $CmpLength   = '0'
      break
end-evaluate

end-procedure

!*******************************************************************************
begin-procedure Compare-Field-Attributes
!*******************************************************************************

let #FieldsSame = {TRUE}

do Generate-ORA-Type ($ORA_Data_Type, $ORA_Data_Length, $ORA_Data_Precision, $ORA_Data_Scale, $ORA_type)
do Generate-ORA-Type ($CmpDataType, $CmpLength, $CmpPrecision, $CmpScale, $Cmp_Type)

if $ORA_Type <> $Cmp_Type
   let #FieldsSame = {FALSE}
end-if

end-procedure

!*******************************************************************************
begin-procedure Generate-Field-Label
!*******************************************************************************
! (len) &DB.LENGTH (decpos) &DB.DECIMALPOS (bin)  &RawBinary

evaluate $PS_FieldType
   when = '0'
      let $FldType = 'Char(' || $PS_Length || ')'
      break
   when = '1'
      let $FldType = 'Long'
      if to_number($PS_Length) > 0
         let $FldType = $FldType || '(' || $PS_Length || ')'
      end-if
      break
   when = '2'
      let $FldType = 'Number(' || $PS_Length
      if to_number($PS_DecPos) > 0
         let $FldType = $FldType || ',' || $PS_DecPos
      end-if
      let $FldType = $FldType || ')'
      break
   when = '3'
      let $FldType = 'Signed(' || $PS_Length
      if to_number($PS_DecPos) > 0
         let $FldType = $FldType || ',' || $PS_DecPos
      end-if
      let $FldType = $FldType || ')'
      break
   when = '4'
      let $FldType = 'Date'
      break
   when = '5'
      let $FldType = 'Time'
      break
   when = '6'
      let $FldType = 'DateTime'
      break
   when = '8'
      let $FldType = 'Image'
      break
   when = '9'
      let $FldType = 'ImageRef'
      break
   when-other
      let $FldType = 'Unknown'
      break
end-evaluate

if $PS_RawBinary = 'Y'
   let $FldType = $FldTYpe || ' RawBinary'
end-if

end-procedure

!*******************************************************************************
begin-procedure Check-For-ORA-Fields-Not-In-PS
!*******************************************************************************

let #i = 1
while #i <= #ORACount
   let $Field_Found_In_ORA = ORARecField.Found(#i)
   if $Field_Found_In_ORA <> 'Y'
      let $ColOut               = ORARecField.COLUMN_NAME(#i)
      let $ORA_DATA_TYPE        = ORARecField.DATA_TYPE(#i)
      let $ORA_DATA_LENGTH      = ORARecField.DATA_LENGTH(#i)
      let $ORA_DATA_PRECISION   = ORARecFIeld.DATA_PRECISION(#i)
      let $ORA_DATA_SCALE       = ORARecField.DATA_SCALE(#i)
      do Generate-ORA-Type ($ORA_Data_Type, $ORA_Data_Length, $ORA_Data_Precision, $ORA_Data_Scale, $ORA_type)

      next-listing no-advance need=3
      do Print-RecName
      print $ColOut                        (0,21)
      print 'n/a'                          (0,41)
      print 'ora:'                         (0,63)
      print $ORA_TYPE                      (0,68)
      print '** In ORACLE, Not in PS **'   (+1,63)
   end-if
   add 1 to #i
end-while

end-procedure

!*******************************************************************************
begin-procedure Print-RecName
!*******************************************************************************

print '-' (0,21,70) fill

if $old_rec <> &RD.SQLTABLENAME
   print '-' (0,1,24) fill
end-if

print &RD.SQLTABLENAME (+1,1) on-break print=change/top-page

let $old_rec = &RD.SQLTABLENAME

end-procedure

!*******************************************************************************
begin-procedure Generate-ORA-Type ($Data_Type, $Data_Length, $Data_Precision, $Data_Scale, :$out)
!*******************************************************************************

let $out = $Data_Type

evaluate $Data_Type
   when = 'DATE'
   when = 'LONG'
      break
   when = 'NUMBER'
      if isblank($Data_Precision)
         let $out = $out || '(38)'
      else
         let $out = $out || '(' || $Data_Precision
         if not isblank($Data_Scale)
            let $out = $out || ',' || $Data_Scale
         end-if
         let $out = $out || ')'
      end-if
      break
   when-other
      let $out = $out || '(' || $Data_Length || ')'
      break
end-evaluate

end-procedure

!*******************************************************************************
begin-procedure Get-Parameters
!*******************************************************************************

let $WhereClause = ''

The_Beginning:

input $TableMask 'Enter Table(s) (''?'' for insturctions)'
if isblank($TableMask)
   show ' '
   show 'No entry.  Ending Program.'
   stop quiet
end-if

let $TestChar = substr($TableMask,1,1)
evaluate $TestChar
when = '@'
   do Process-FileList
   break
when = '?'
   do Show-Instructions
   goto The_Beginning
   break
when-other
   uppercase $TableMask
   if $TableMask <> 'ALL'
      let $WhereClause = 'and RD.RECNAME like ''' || $TableMask || ''''
   end-if
   break
end-evaluate

show ' '
show 'Processing....'
show ' '

end-procedure

!*******************************************************************************
begin-procedure Show-Instructions
!*******************************************************************************

show ' '
show '================================================================================'
show 'INSTRUCTION: Tables names can be entered in any one of the four following ways:'
show ' '
show '(1) You can enter ''ALL'' to check every table in the database.'
show ' '
show '(2) You can type in the ''@'' character, followed by the filename of an ASCII'
show 'file containing a list of the tables to be checked.  This file should have one'
show 'table per line.  The number of tables the file can contain is unknown at this'
show 'time.  If you get some strange errors, try removing some tables and running the'
show 'program again.  If you find the limit, let me know.'
show ' '
show '(3) Enter a table name containing wildcards (%).  For example, entering ''JOB%'''
show 'will check any table that starts with JOB; such as JOB, JOBCODE_TBL, etc.  '
show ' '
show '(4) Enter a single table name.'
show ' '
show 'NOTE: Regardless of the method you choose, do not enter the ''PS_'' portion of '
show 'the table name.  The program will add this on automatically.  A blank line will'
show 'stop the program without checking any tables.'
show '================================================================================'
show ' '

end-procedure

!*******************************************************************************
begin-procedure Process-FileList
!*******************************************************************************

let $TableMask = ltrim($TableMask, '@')

open $TableMask as 1
   for-reading
   record=300
   status=#Open_Error

if #Open_Error
   show ' '
   show 'Unable to find filename.  Ending program.'
   show ' '
   stop quiet
end-if

let $WhereClause = 'and RD.RECNAME in ('

read 1 into $InLine:300
while not #end-file
   let $InLine = upper(rtrim(ltrim($InLine, ' '), ' '))
   if not isblank($InLine)
      let $WhereClause = $WhereClause || '''' || $InLine || ''','
   end-if
   read 1 into $InLine:3000
end-while

let $WhereClause = rtrim($WhereClause,',') || ')'

end-procedure

!*******************************************************************************
begin-procedure Get-Total-Record-Count
!*******************************************************************************

begin-select
count(*) &TOTAL_RECORD_COUNT
from PSRECDEFN RD
where RD.RECTYPE = 0
[$WhereClause]
end-select

show ' '
show &TOTAL_RECORD_COUNT edit 999999 noline
show ' records remaining'

end-procedure