! sqrsh (sqr shell)
! Copyright (C) 1997 Ray Ontko & Company
!
! 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.
!
! You should have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software
! Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!++
!
! fk
!
! generates a file containing code to check integrity
! for all disabled foreign key constraints for a user
!
!--
!
! Author
!
! Ray Ontko
! Ray Ontko & Company
! Richmond, In 47375
!
!
! Modification History
!
! Name             Date       Comment
! ---------------- ---------- ----------------------------------------
! Ray Ontko        1997/06/01 Added this header
!

!
! To do
!
! restructure to use fixup_files
!

!--------------------------------------------------------------------- fk
begin-procedure fk
input $fn 'Output file'
#if {SQR-DATABASE}=ORACLE
   do fk_main
#else
   show 'sqrsh: "fk" is only available for ORACLE at the present time'
#endif
end-procedure ! fk

!---------------------------------------------------------------- fk_main
begin-procedure fk_main
open $fn as 2 for-writing record={SQRSH_LINE_MAX}:vary
write 2 from 'begin-program'
write 2 from '   do main'
write 2 from 'end-program'
write 2 from ''
write 2 from 'begin-procedure main'
write 2 from ''
begin-select
owner &owner
constraint_name &constraint_name
table_name &table_name
r_owner &r_owner
r_constraint_name &r_constraint_name
   do orphans( &owner , &constraint_name , &table_name , &r_owner , &r_constraint_name )
from user_constraints
where constraint_type = 'R'
and status = 'DISABLED'
end-select
write 2 from 'end-procedure main'
close 2
end-procedure ! fk_main

!---------------------------------------------------------------- orphans
begin-procedure orphans( $owner , $constraint_name , $table_name , $r_owner , $r_constraint_name )
! select { child table pk columns }
! from { child table }
! where not exists ( select 'x' from
! parent table where child table columns = parent table columns )

write 2 from 'print ''' $table_name ''' (1,1)'
write 2 from 'next-listing'

write 2 from 'begin-select'

move '' to $pk_name
begin-select
constraint_name &pk_name
table_name &pk_table
   move &pk_name to $pk_name
   move &pk_table to $pk_table
   exit-select
from all_constraints
where
    owner = $owner
and table_name = $table_name
and constraint_type = 'P'
end-select

write 2 from '   position (1,1)'
begin-select
column_name &pk_col
   add 1 to #_col
   move #_col to $col '09999'
   write 2 from &pk_col ' &c_' $col ' (,+1)'
from all_cons_columns
where owner = $owner
and constraint_name = $pk_name
order by position
end-select

begin-select
column_name &fk_col
   add 1 to #_col
   move #_col to $col '09999'
   write 2 from &fk_col ' &c_' $col ' (,+1)'
from all_cons_columns
where owner = $owner
and constraint_name = $constraint_name
order by position
end-select

write 2 from '   next-listing'
write 2 from 'from ' $table_name ' c'
write 2 from 'where not exists ( select ''x'' '
move 1 to #first
move 'where ' to $and
begin-select
p.table_name &p_table
p.column_name &p_col
c.column_name &c_col
   if #first
      write 2 from 'from ' &p_table ' p'
   end-if
   write 2 from $and 'p.' &p_col ' = c.' &c_col
   move 'and ' to $and
   move 0 to #first
from
  all_cons_columns p
, all_cons_columns c
where
    p.owner = $r_owner
and p.constraint_name = $r_constraint_name
and c.owner = $owner
and c.constraint_name = $constraint_name
and p.position = c.position
end-select
write 2 from ')'
write 2 from 'end-select'
write 2 from ''

end-procedure ! orphans