home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / gendelproc.tcl < prev    next >
Encoding:
Text File  |  1996-06-05  |  6.5 KB  |  215 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1992-1996 by Cadre Technologies, Inc.
  4. #
  5. # This software is furnished under a license and may be used only in
  6. # accordance with the terms of such license and with the inclusion of
  7. # the above copyright notice. This software or any other copies thereof
  8. # may not be provided or otherwise made available to any other person.
  9. # No title to and ownership of the software is hereby transferred.
  10. #
  11. # The information in this software is subject to change without notice
  12. # and should not be construed as a commitment by Cadre Technologies, Inc.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #        File           : @(#)gendelproc.tcl    2.1 (2.1)
  17. #        Original date  : 18-8-1992
  18. #        Description    : Tcl script for generating delete database
  19. #                         procedures
  20. #
  21. #---------------------------------------------------------------------------
  22. #
  23. # @(#)gendelproc.tcl    2.1 (2.1)\t19 Apr 1996 Copyright 1992-1996 Cadre Technologies, Inc.
  24. #
  25. #---------------------------------------------------------------------------
  26.  
  27.  
  28. # Generate the procedure body for a delete procedure
  29. #
  30. proc gen_delete_proc { current_section currtab } {
  31.  
  32.     global empty_imports_procs
  33.     global empty_exports_procs
  34.     if { [ get empty_imports_procs(del,$currtab) 0] &&
  35.          [ get empty_exports_procs(del,$currtab) 0] } {
  36.         return
  37.     }
  38.  
  39.     $current_section pushIndent
  40.     expand_text $current_section {
  41.         CREATE PROCEDURE pdel_~[ $currtab getUniqueName]
  42.         (
  43.             ~[ gen_simple_data_decl_4gl $current_section $currtab\
  44.                "KEYS_IMPFIELDS" "old" " ,\n" ]
  45.         )
  46.         ~[ gen_as_declare $current_section ]
  47.         BEGIN
  48.             ~[ gen_del_block $current_section $currtab ]
  49.             RETURN 1;
  50.         END
  51.         \\p\\g
  52.  
  53.     }
  54.     $current_section popIndent
  55. }
  56.  
  57.  
  58. #
  59. #
  60. proc gen_del_block { current_section currtab } {
  61.  
  62.     set tab_name [ $currtab getUniqueName]
  63.     $current_section pushIndent
  64.     if { ![ get empty_exports_procs(del,$currtab) 0]} {
  65.         set exports [ $currtab exportSet]
  66.         expand_text $current_section {
  67.             /*
  68.              * RI: CHECK RI FOR DETAILS
  69.              *
  70.              * Check referential integrity after a delete
  71.              * from table '~$tab_name'
  72.              */ 
  73.         }
  74.         gen_ri_del_exports $current_section $currtab $exports
  75.     }
  76.     if { ![ get empty_imports_procs(del,$currtab) 0]} {
  77.         set imports [ $currtab importSet]
  78.         expand_text $current_section {
  79.             /*
  80.              * RI: CHECK RI FOR MASTERS
  81.              *
  82.              * Check referential integrity after a delete
  83.              * from table '~$tab_name'
  84.              */ 
  85.         }
  86.         gen_ri_del_imports $current_section $currtab $imports
  87.     }
  88.     $current_section popIndent
  89. }
  90.  
  91.  
  92. # Walk through the list of exports and check the RI
  93. # i.e. visit all detail tables
  94. #
  95. proc gen_ri_del_exports { current_section currtab links } {
  96.  
  97.     global export_rules
  98.     $current_section pushIndent
  99.     foreach link $links {
  100.         set detail        [ $link detail]
  101.         set detail_name   [ $detail getUniqueName]
  102.         set rule_type     [ $link getDelType]
  103.  
  104.         if { $rule_type == "none" } then {
  105.             continue
  106.         }
  107.         set riproc [ get export_rules(del,$rule_type)]
  108.         if { $riproc != "" } then {
  109.             del_$riproc $current_section $currtab $detail $link
  110.         } else {
  111.             m4_error $E_NO_TCL_DEL_RULE $rule_type [ $currtab getUniqueName]
  112.         }
  113.         if { $rule_type == "rej_last" } {
  114.             del_rej_last $current_section $currtab $detail $link
  115.         }
  116.     }
  117.     $current_section popIndent
  118. }
  119.  
  120.  
  121. # Walk through the list of imports and depending on the
  122. # rule type check if no referential integrity is violated
  123. # i.e. visit some master tables
  124. #
  125. proc gen_ri_del_imports { current_section currtab  links } {
  126.  
  127.     global import_rules
  128.     $current_section pushIndent
  129.     foreach link $links {
  130.         set master        [ $link master]
  131.         set master_name   [ $master getUniqueName]
  132.         set rule_type     [ $link getDelType]
  133.         set tab_role      "master"
  134.  
  135.         if { $rule_type == "none" } then {
  136.             continue;
  137.         }
  138.         set riproc [ get import_rules(del,$rule_type)]
  139.         if { $riproc != "" } then {
  140.             del_$riproc $current_section $currtab $master $link
  141.         } else {
  142.             m4_error $E_NO_TCL_DEL_RULE $rule_type [ $currtab getUniqueName]
  143.         }
  144.     }
  145.     $current_section popIndent
  146. }
  147.  
  148.  
  149. # Nullify the exported key in the detail table
  150. #
  151. proc del_nullify_detail { current_section currtab detail link } {
  152.  
  153.     gen_nullify_in_detail $current_section $currtab $detail $link
  154. }
  155.  
  156.  
  157. # Reject on exist foreign key in other table
  158. #
  159. proc del_rej_exist { current_section currtab other link } {
  160.  
  161.     set other_name [ $other getUniqueName]
  162.     gen_exist_in_detail_link $current_section $currtab $other $link ":old"
  163.     gen_error_del_rej $current_section [$currtab getUniqueName] $other_name
  164. }
  165.  
  166.  
  167. # Casade delete for foreign key in master
  168. #
  169. proc del_del_in_master { current_section currtab master link } {
  170.  
  171.     set columns [ $link columnSet] 
  172.     del_in_master $current_section $columns $master
  173. }
  174.  
  175.  
  176. # Casade delete for the exported key in detail
  177. #
  178. proc del_del_in_detail {current_section currtab detail link } {
  179.  
  180.     if { [ $link getLinkType] == "export" } {
  181.         set link [ $link friendLink]
  182.     }
  183.  
  184.     set columns [ $link columnSet] 
  185.     del_in_detail $current_section $columns $detail
  186. }
  187.  
  188.  
  189. # If there is just one row in the master table with a
  190. # reference to the deleted tuple, reject the delete
  191. #
  192. proc del_rej_last_in_master { current_section currtab master link } {
  193.  
  194.     set tab_name [ $currtab getUniqueName]
  195.     gen_exist_in_master_link $current_section $currtab $master $link ":old"
  196.     gen_error_del_rej_last $current_section $tab_name
  197. }
  198.  
  199.  
  200. # Reject the delete if the last tuple of the current
  201. # table was deleted
  202. #
  203. proc del_rej_last { current_section currtab other link } {
  204.  
  205.     set tab_name [ $currtab getUniqueName]
  206.     $current_section pushIndent
  207.     expand_text $current_section {
  208.         /*
  209.          * RI : REJECT LAST
  210.          */
  211.         ~[ gen_exist_last $current_section $currtab $link ":old" ]
  212.         ~[ gen_error_del_rej_last $current_section $tab_name ] }
  213.     $current_section popIndent
  214. }
  215.