!******************************************************************************
! Program Name: UTIL.SQR                                                       !
! Purpose:      Utilities for SQR to format text, etc.                         !
! Description:                                                                 !
! Notes: Beautification does not work well with tabs                           !
!        Also can mess up selects when database columns are in "If" clause     !
! Programmer:  Chanan Morrison                                                 !
! Date:        SEP-95                                                          !
! Changes Log:                                                                 !
! ---------------------------------------------------------------------------- !
! DATE  | PROGRAMMER | DESC                                                    !
! ---------------------------------------------------------------------------- !
! OCT 97| Chanan     | Added Trace and Step-through programs                   !
! DEC 97| Chanan     | Made "Begin-" "End-" beautification more general;       !
!       |            | not change case of procedure parameter list.            !
! DEC 98| Chanan     | Replaced Oracle "replace" function with SQR "translate" !
! AUG 99| Chanan     | Added time for trace program shows     
!       |            |                                                         !
!******************************************************************************

Begin-Report
   let #indent  = 3
   Do MAIN
End-Report

Begin-Procedure MAIN
while 1
    show clear-screen (3,10) bold reverse 'SQR UTILITIES MENU ver 1.2 '
    show normal  (4,10)    'All rights reserved 1998'
    show         (5,10)    '========================'
    show         (7,10)    '1. Beautify SQR program '
    show         (8,10)    '2. Statistical Analysis of SQR '
    show         (9,10)    '3. Tables Accessed and Type of Access'
    show        (10,10)    '4. Create SQR Trace program    '
    show        (11,10)    '5. Create Step-through SQR     '
    show        (12,10)    '6. Create file of SQLs for Performance Analysis'
    show        (13,10)    '7. Exit '
    show reverse
    
    input $type 'Type Option number or "X" to exit'
    show normal
    let $type = upper($type)
    if $type = 'X' or $type = '7'
       	show normal
       	break
    end-if
    
    Evaluate $type
    when = '1'
       Do OPEN_FILE
       if $ok = 'Y'
          Do PRETTY
          close 1
       end-if
    when = '2'
       Do OPEN_FILE
       if $ok = 'Y'
          Do GET_STATS
          close 1
       end-if
    when = '3'
       Do OPEN_FILE
       if $ok = 'Y'
          Do FIND_TABLES
          close 1
       end-if
    when = '4'
    when = '5'
       Do OPEN_FILE
       if $ok = 'Y'
          Do TRACE_SQR
          close 1
       end-if
    when = '6'
       Do OPEN_FILE
       if $ok = 'Y'
          Do PERFORMANCE_FILE
          close 1
       end-if
    End-Evaluate
End-While
End-Procedure

!-----------------------------------------------------------------
!-----------------------------------------------------------------
Begin-Procedure OPEN_FILE
show (17,10) ' Enter name of SQR program '
input $filename ' '
open  $filename as 1 for-reading record=200 status=#filestatus
if #filestatus != 0
    show  (17,10) clear-line 'Could not find input file.' beep
    input $dummy noprompt
    let $ok = 'N'
 else
    let $ok = 'Y'
End-If
End-Procedure

!-----------------------------------------------------------------
! PRETTIFY THE SQR:
! 1. Fix all Begin/End key-words
! 2. All procedure names in upper case
! 3. All table names in upper case
! 4. Indentation of IF statements
!-----------------------------------------------------------------
Begin-Procedure PRETTY
let #if_ctr = 0
let $select_sw = ''
let $sql_sw = ''
open  'new.sqr' as 2 for-writing record=200 status=#filestatus

While 1
    read 1 into $record:200
    if #end-file
       break
    end-if
    !---------- Fix the Begins ...
    !do TAKE_OUT_TAB
    let $REC = upper($record)
    let $start = substr($REC,1,6)
    if $start = 'BEGIN-'
       let $record = 'Begin-' || substr($REC,7,1) || substr($record,8,200)
    end-if
    if instr($REC,'BEGIN-PROCEDURE',0) = 1
       let #parm_start = instr($REC,'(',0)
       if #parm_start ! it has a parameter list
          let $record = 'Begin-Procedure'|| 
                      upper(substr($record,16,#parm_start - 16)) || 
                      substr($record,#parm_start,200)
       else
          let $record = 'Begin-Procedure'|| upper(substr($record,16,200))
       end-if
    end-if
    if instr($REC,'BEGIN-SELECT',0) = 1
       let $record = 'Begin-Select'|| substr($record,13,200)
       let $select_sw = 'Y'
    end-if
    if instr($REC,'BEGIN-SQL',0) = 1
       let $record = 'Begin-Sql'|| substr($record,10,200)
       let $sql_sw = 'Y'
    end-if
    if  instr($REC,'EVALUATE',0) = 1
       let $record = 'Evaluate'|| substr($record,09,200)
    end-if
    !---------- Fix Ends ...
    let $start = substr($REC,1,4)
    if $start = 'END-'
       let $record = 'End-' || substr($REC,5,1) || substr($record,6,200)
    end-if
    if  instr($REC,'END-SELECT',0) = 1
       let $record = 'End-Select'|| substr($record,11,200)
       let $select_sw = 'N'
    end-if
    if  instr($REC,'END-SQL',0) = 1
       let $record = 'End-Sql'|| substr($record,08,200)
       let $sql_sw = 'N'
    end-if
    !----- Fix Do ...
    if  instr(ltrim($REC,' '),'DO ',0) = 1
       let #start = instr($REC,'DO ',0) - 1
       Do GET_PAD(#START,$PAD)
       let #parm_start = instr($REC,'(',0)
       if #parm_start ! it has a parameter list
          let $record = $pad || 'Do ' ||
              upper(substr($record,#start + 4,#parm_start - #start - 4)) ||
              substr($record,#parm_start,200)
       else
          let $record= $pad || 'Do '|| upper(substr($record,#start + 4,200))
       end-if
    end-if
    !----- Fix Table names ...
    if instr($REC,'FROM ',0) = 1 and $select_sw = 'Y'
       let #end = instr($REC,' WHERE ',5)
       if #end = 0
          let $record = 'From ' || upper(substr($record,6,200))
       else
          let $record2 = 'From ' || upper(substr($record,6,#end - 6))
          write 2 from $record2
          let $record = substr($record,#end + 1,200)
       end-if
    end-if
    if instr($REC,'UPDATE ',0) = 1 and $sql_sw = 'Y'
       let #end = instr($REC,' SET ',8)
       if #end = 0
          let $record = 'Update ' || upper(substr($record,8,200))
       else
          let $record2 = 'Update ' || upper(substr($record,8,#end - 8))
          write 2 from $record2
          let $record = '        ' || substr($record,#end + 1,200)
       end-if
    end-if
    !----- Fix IF ...
    if instr(ltrim($REC,' '),'END-IF',0) = 1
       or  instr(ltrim($REC,' '),'END-WHILE',0) = 1
       or  instr(ltrim($REC,' '),'END-EVALUATE',0) = 1
       subtract 1 from #if_ctr
       let #length = #length - #indent
       Do GET_PAD(#LENGTH,$IF_PAD)
    end-if
    if #if_ctr > 0
       if  instr(ltrim($REC,' '),'ELSE',0) = 1
          or  instr(ltrim($REC,' '),'WHEN ',0) = 1
          or  instr(ltrim($REC,' '),'WHEN-OTHER',0) = 1
          let #length = #length - #indent
          Do GET_PAD(#LENGTH,$IF_PAD)
          let $record = $if_pad || ltrim($record,' ')
          let #length = #length + #indent
          Do GET_PAD(#LENGTH,$IF_PAD)
       else
          let $record = $if_pad || ltrim($record,' ')
       end-if
    end-if
    if  instr(ltrim($REC,' '),'IF ',0) = 1
       or  instr(ltrim($REC,' '),'WHILE ',0) = 1
       or  instr(ltrim($REC,' '),'EVALUATE ',0) = 1
       add 1 to #if_ctr
       if #if_ctr = 1
          let #length = instr($REC,'IF ',0)
          if #length = 0
             let #length = instr($REC,'WHILE ',0)
          end-if
          if #length = 0
             let #length = instr($REC,'EVALUATE ',0)
          end-if
       end-if
       let #length = #length + #indent
       Do GET_PAD(#LENGTH,$IF_PAD)
    end-if
    !------------------
    write 2 from $record
End-While

close 2

show (22,5) 'The new version is called "new.sqr". Press any key to continue.'
input $dummy noprompt
End-Procedure

!-----------------------------------------------------------------
! PRINT STATISTICS ON NUMBER OF LINES, PROCEDURES, ETC, IN PROGRAM
!-----------------------------------------------------------------
Begin-Procedure GET_STATS
move 0 to #line_ctr
move 0 to #proc_ctr
move 0 to #sele_ctr
move 0 to #sql__ctr

While 1
    read 1 into $record:200
    if #end-file
       break
    end-if
    let $REC = upper($record)
    add 1 to #line_ctr
    
    if instr($REC,'BEGIN-PROCEDURE',0) = 1
       add 1 to #proc_ctr
    end-if
    if instr($REC,'BEGIN-SELECT',0) = 1
       add 1 to #sele_ctr
    end-if
    if instr($REC,'BEGIN-SQL',0) = 1
       add 1 to #sql__ctr
    end-if
End-While

move #line_ctr to $lines 99,999
move #proc_ctr to $proc  9,999
move #sele_ctr to $sele  9,999
move #sql__ctr to $sql_  9,999
show (16,1) '------------------------------------------------------------------'
show (17,10) clear-line reverse 'Program Name: ' $filename
show (19,1) normal 'Lines = ' $lines '. Procedures =' $proc '. Selects = ' $sele '. SQL statments = ' $sql_
show (22,5) ' Press any key to continue.'
input $dummy noprompt
End-Procedure

Begin-Procedure GET_PAD(#len,:$pad)
let #i = 0
let $pad = ''
while #i < #len
    let $pad = $pad || ' '
    add 1 to #i
End-While
End-Procedure

Begin-Procedure TAKE_OUT_TAB
let #x = 1
while #x > 0
    let #x = instr($record,'	',0)
    if #x = 1
       let $record = '   ' || substr($record,2,199)
    end-if
    if #x > 1
       let $record = substr($record,1,#x - 1)||'   '||
                     substr($record,#x + 1,200 - #x - 1)
    end-if
End-While
End-Procedure

!-----------------------------------------------------------------
!-----------------------------------------------------------------
Begin-Procedure FIND_TABLES
let $hdr =  'Database Access in Program ' || $filename
print $hdr (1,20)
print '-'  (2,20,40) fill
While 1
    read 1 into $record:200
    if #end-file
       break
    end-if
    let $REC = upper($record)
    
    if $select_sw = 'Y' and instr($REC,'FROM ',0) = 1
       print 'Select: ' (+1,1)
       print $record (,+1)
    end-if
    
    if $sql_sw = 'Y'
       if instr($REC,'INSERT ',0) = 1
          or instr($REC,'UPDATE ',0) = 1
          or instr($REC,'DELETE ',0) = 1
          print $record (+1,1)
       end-if
    end-if
    
    if instr($REC,'END-SQL',0) = 1
       let $sql_sw = 'N'
    end-if
    if instr($REC,'BEGIN-SQL',0) = 1
       let $sql_sw = 'Y'
    end-if
    if instr($REC,'END-SELECT',0) = 1
       let $select_sw = 'N'
    end-if
    if instr($REC,'BEGIN-SELECT',0) = 1
       let $select_sw = 'Y'
    end-if
End-While
End-Procedure

!-----------------------------------------------------------------
! CREATE A FILE OF ALL DB QUERIES (TO CHECK PERFORMANCE)
!-----------------------------------------------------------------
Begin-Procedure PERFORMANCE_FILE
While 1
    read 1 into $record:200
    if #end-file
       break
    end-if
    let $REC = upper($record)
    
    ! END OF QUERY
    if instr($REC,'END-SELECT',0) = 1
       print '/' (+1,1)
       let $select_sw = 'N'
    end-if
    if instr($REC,'END-SQL',0) = 1
       let $sql_sw = 'N'
    end-if
    
    if $select_sw = 'P' and instr($REC,'!!',0) != 1
       let $record1 = translate(translate($record,'$','&'),'#','&')
       print $record1 (+1,1)
    end-if
    
    if $select_sw = 'Y' and instr($REC,'FROM ',0) = 1
       let $record1 = translate(translate($record,'$','&'),'#','&')
       print 'Select 1 ' (+1,1)
       print $record1 (,+1)
       let $select_sw = 'P'
    end-if
    
    ! BEGINNING OF QUERY
    if instr($REC,'BEGIN-SQL',0) = 1
       let $sql_sw = 'Y'
    end-if
    if instr($REC,'BEGIN-SELECT',0) = 1
       let $select_sw = 'Y'
    end-if
End-While
End-Procedure

!-----------------------------------------------------------------
! Make a new version of the SQR which prints a line after each "begin-procedure"
!-----------------------------------------------------------------
Begin-Procedure TRACE_SQR
open  'new.sqr' as 2 for-writing record=200 status=#filestatus

While 1
    read 1 into $record:200
    if #end-file
       break
    end-if
    let $REC = upper($record)
    write 2 from $record
    if instr($REC,'BEGIN-PROCEDURE',0) = 1
       let $line = 'date-time () HH:MI:SS &time00'
       write 2 from $line  
       let $record = 'show ''In Procedure "'|| upper(substr($record,17,200)) || '" time='' &time00'
       write 2 from $record
       if $type = '5'
          let $record = 'input $1________________2 ''Press ENTER to continue'' '
          write 2 from $record
       end-if
    end-if
End-While

close 2

if $type = '5'
    show (22,5) 'The Step-Thru program is called "new.sqr". Press any key to continue.'
 else
    show (22,5) 'The Trace program is called "new.sqr". Press any key to continue.'
End-If
input $dummy noprompt
End-Procedure