! Copyright (C) 1998,1999 Ray Ontko & Co.
! http://www.ontko.com
!
! This program is free software; you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 2 of the License, or
! (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! A copy of the GPL is available at the GNU web site:
!   http://www.gnu.org/
!   htpp://www.gnu.org/copyleft/gpl.html
!
!++
!
! Name
!
!   ora_doc.sqr
!
! Description
!
!   This program looks at the oracle meta-data and produces a report
!   describing the tables, columns, indexes, and constraints of the 
!   tables owned by the ORACLE user under which this program runs.
!   This program produces documentation for an Oracle schema.
!
!   The format is fairly large (the page is 132 columns by 66 rows)
!   and is meant to be printed or viewed as a landscape document.
!
! Parameters
!
!   table-list
!
!     a comma-separated list of table names, or NULL, indicating all
!     tables.
!
!--
!
! Author
!
!   Ray Ontko
!   Ray Ontko & Co
!   Richmond, Indiana
!
! Modification History
!
! Name                    Date        Comment
! ----------------------  ----------  ----------------------------------
! Lori Donnelly           04/27/1999  Changed name from as_built.sqr and
!                                     added logic for 'aks' routine and
!                                     logic for 'indexes' routine.
!
! Lori Donnelly           06/15/1999  Fixed formatting for various 
!                                     printer types
!
! Ray Ontko               06/17/1999  Added copyright notice and minor
!                                     formatting cleanups.
!
! Ray Ontko               06/24/1999  Added parameter for list of table
!                                     names.

#define TABLE_COMMENT_WIDTH 65
#define COLUMN_COMMENT_WIDTH 65

begin-setup

declare-layout default
   orientation=landscape
   top-margin = 0.25
   left-margin = 0.25
   line-width = 10.0
   page-depth = 7.5
   char-width = 4.8
   line-height = 8.0
end-declare

end-setup

!---------------------------------------------------------- begin-program
begin-program
alter-printer point-size=8 pitch=15
do main
end-program

!---------------------------------------------------------- begin-heading
begin-heading 3
print $title (1) Center
page-number (1,120) 'Page '
last-page () ' of ' '.'
date-time (2,120) 'MM/DD/YYYY'
end-heading

!------------------------------------------------------------------- main
begin-procedure main

input $tables 'Tables [ALL]'
if isblank($tables)
   move '' to $where_tables
else
   move 'where table_name in ' to $where_tables
   move '(' to $sep
end-if
!
! note: doesn't yet handle quoted ("") table names
! Also, it might be nice if we allowed reading of an include/exclude
! list from a file (using @?)
!
while length($tables) > 0
   let #pos = instr($tables,',',1)
   if #pos = 0
      move $tables to $table
      move '' to $tables 
   else
      let $table = substr( $tables , 1 , #pos - 1 )
      let $tables = substr( $tables , #pos + 1 , length($tables) - #pos )
   end-if
   concat $sep with $where_tables
   move ',' to $sep
   uppercase $table
   concat '''' with $where_tables
   concat $table with $where_tables
   concat '''' with $where_tables
end-while
concat ')' with $where_tables
show $where_tables

begin-select
user &user
from dual
end-select
let $title = &USER || ' Tables and Columns'

do tables
end-procedure ! main

!----------------------------------------------------------------- tables
begin-procedure tables

!   This procedure selects the user tables and for each calls routines
!   that find the table comments, primary keys (pk), unique constraints (aks),
!   foreign keys (fks) and indexes (indexes).

move 0 to #table_count

begin-select
table_name &table_name (1,1) bold
   next-listing skiplines=1
   do table_comment
   do columns
 ! next-listing
   do pk
   do aks
   do fks
   do indexes
   next-listing skiplines=1 need=5
   add 1 to #table_count
from user_tables
[$where_tables]
order by table_name
end-select
end-procedure ! tables

!---------------------------------------------------------------- columns
begin-procedure columns

!  This procedure sets the columns for each field and then selects
!  from the user_tab_columns table to get the tables, columns, etc.
!  to be printed on the report.

columns 3 35 45 61
begin-select
   use-column 1
column_name &column_name ()
   next-column
nullable &nullable () match 'Y' 0 4 'NULL' 'N' 0 0 'NOT NULL'
   next-column
data_type &data_type ()
data_length &data_length
data_precision &data_precision
data_scale &data_scale
   move &data_type to $data_type
   evaluate $data_type
   when = 'CHAR'
   when = 'VARCHAR'
   when = 'VARCHAR2'
      print '(' () 
      print &data_length () edit 8888
      print ')' ()
      break
   when = 'NUMBER'
      if not isnull( &data_scale )
         print '(' ()
         if isnull( &data_precision )
             print '38' ()
         else
            print &data_precision () edit 8888
         end-if
         if &data_scale <> 0
            print ',' ()
            print &data_scale () edit 8888
         end-if
         print ')' ()
      end-if
      break
   end-evaluate
   next-column
   do column_comment
   next-listing
from user_tab_columns
where table_name = &table_name
order by column_id
end-select
columns 1
next-listing
end-procedure ! columns

!---------------------------------------------------------- table_comment
begin-procedure table_comment
begin-select
comments &table_comments 
 if not isblank(&table_comments)
      print &table_comments (1,3,{TABLE_COMMENT_WIDTH}) wrap {TABLE_COMMENT_WIDTH} 100 on='<10><13>'
      next-listing skiplines=1
   end-if
from user_tab_comments
where table_name = &table_name
end-select
end-procedure ! table_comment

!--------------------------------------------------------- column_comment
begin-procedure column_comment
begin-select
comments &column_comments 
 if not isblank( &column_comments )
      print &column_comments (,,{COLUMN_COMMENT_WIDTH}) wrap {COLUMN_COMMENT_WIDTH} 200 on='<10><13>'
 end-if
from user_col_comments
where table_name = &table_name
and column_name = &column_name
end-select
end-procedure ! column_comment

!--------------------------------------------------------------------- pk
begin-procedure pk

!  This procedure finds any Primary keys for the selected table.

move 0 to #count
begin-select
ucc.constraint_name &pk_constraint_name
ucc.column_name &pk_column_name
   if #count = 0
      print 'Primary Key: ' (1,1)
      print &pk_constraint_name (,+1)
      print '(' (,+1)
   else
      print ',' (,+1)
   end-if
   print &pk_column_name (,+1)
   add 1 to #count
from user_cons_columns ucc
, user_constraints uc
where ucc.owner = uc.owner
and ucc.constraint_name =uc.constraint_name
and uc.constraint_type = 'P'
and uc.table_name = &table_name
order by ucc.position
end-select
if #count > 0
   print ')' (,+1)
   next-listing
end-if
end-procedure ! pk

!-------------------------------------------------------------------- aks
begin-procedure aks

! This procedure finds any unique constraints for the selected table.

begin-select
ucc.constraint_name &aks_constraint_name () on-break print=never
   level=1 before=before_ak after=after_ak
ucc.column_name &aks_column_name
   print $aks_sep (,+1)
   print &aks_column_name (,+1)
   move ',' to $aks_sep
from user_cons_columns ucc, user_constraints uc
where ucc.owner = uc.owner
and ucc.constraint_name = uc.constraint_name
and uc.constraint_type = 'U'
and uc.table_name = &table_name
order by ucc.constraint_name, ucc.position
end-select
end-procedure ! aks

!------------------------------------------------------------- before_ak
begin-procedure before_ak
print 'Unique Constraint: ' (1,1)
print &aks_constraint_name (,+1)
move '(' to $aks_sep
end-procedure ! before_ak

!-------------------------------------------------------------- after_ak
begin-procedure after_ak
print ')' (,+1)
next-listing
end-procedure ! after_ak

!-------------------------------------------------------------------- fks
begin-procedure fks

! This procedure finds any foreign keys for the selected table.

begin-select
ucc.constraint_name &fk_constraint_name () on-break print=never
   level=1 before=before_fk after=after_fk
ucc.column_name &fk_column_name
! uc.r_owner &fk_r_owner
! uc.r_constraint &fk_r_constraint_name
   print $fk_sep (,+1)
   print &fk_column_name (,+1)
   move ',' to $fk_sep
from user_cons_columns ucc
, user_constraints uc
where ucc.owner = uc.owner
and ucc.constraint_name =uc.constraint_name
and uc.constraint_type = 'R'
and uc.table_name = &table_name
order by ucc.constraint_name , ucc.position
end-select
end-procedure ! fks

!-------------------------------------------------------------- before_fk
begin-procedure before_fk
print 'Foreign Key: ' (1,1)
print &fk_constraint_name (,+1)
move '(' to $fk_sep
end-procedure ! before_fk

!--------------------------------------------------------------- after_fk
begin-procedure after_fk
print ')' (,+1)
next-listing
end-procedure ! after_fk

!---------------------------------------------------------------- indexes
begin-procedure indexes

! This procedure finds any indexes for the selected table.

begin-select
ui.index_name        &indexes_index_name () on-break print=never
  level=1 before=before_indexes after=after_indexes
ui.uniqueness        &indexes_uniqueness
uic.column_name      &indexes_column_name
   print $indexes_sep (,+1)
   print &indexes_index_name (,+1)
   move ',' to $indexes_sep
from user_indexes ui, user_ind_columns uic
where ui.index_name = uic.index_name
and ui.table_name = &table_name
order by ui.index_name, uic.column_position
end-select
end-procedure ! indexes

!--------------------------------------------------------- before_indexes
begin-procedure before_indexes
  print &indexes_uniqueness (1,1)
  print 'index: '           (,+1)
  print &indexes_index_name (,+1)
  move '(' to $indexes_sep
end-procedure ! before_indexes

!---------------------------------------------------------- after_indexes
begin-procedure after_indexes
  print ')' (,+1)
  next-listing
end-procedure ! after_indexes

! end program ora_doc.sqr