home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / genupdproc.tcl < prev    next >
Encoding:
Text File  |  1996-06-05  |  7.4 KB  |  241 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           : @(#)genupdproc.tcl    2.1 (2.1)
  17. #        Original date  : 18-8-1992
  18. #        Description    : Tcl script for generating update procedures
  19. #
  20. #---------------------------------------------------------------------------
  21. #
  22. # @(#)genupdproc.tcl    2.1 (2.1)\t19 Apr 1996 Copyright 1992-1996 Cadre Technologies, Inc.
  23. #
  24. #---------------------------------------------------------------------------
  25.  
  26.  
  27.  
  28.  
  29. # Generate the procedure body for an update procedure
  30. #
  31. proc gen_update_proc { current_section currtab } {
  32.  
  33.     global empty_imports_procs
  34.     global empty_exports_procs
  35.     if { [ get empty_imports_procs(upd,$currtab) 0] &&
  36.          [ get empty_exports_procs(upd,$currtab) 0] } {
  37.         return
  38.     }
  39.  
  40.     set    tab_name    [ $currtab getUniqueName]
  41.     set    imports     [ $currtab importSet]
  42.     set    exports     [ $currtab exportSet]
  43.  
  44.     $current_section pushIndent
  45.     expand_text $current_section {
  46.         CREATE PROCEDURE pupd_~$tab_name
  47.         (
  48.             ~[ gen_simple_data_decl_4gl $current_section $currtab "KEYS"\
  49.                "old" " ,\n" ] ,
  50.             ~[ $current_section pushIndent
  51.                gen_simple_data_decl_4gl $current_section $currtab "KEYS"\
  52.                "new" " ,\n"
  53.                gen_upd_decl_imp_fields $current_section $currtab
  54.                $current_section popIndent]
  55.         )
  56.         AS DECLARE
  57.             msg       varchar(127) NOT NULL;
  58.             counter   integer;
  59.         BEGIN
  60.             ~[ gen_chk_upd_key $current_section $currtab ]
  61.             ~[ gen_upd_imp $current_section $currtab $imports ]
  62.             RETURN 1;
  63.         END
  64.         \\p\\g
  65.         
  66.     }
  67.     $current_section popIndent
  68. }
  69.  
  70.  
  71. # Generate for foreign keys the code to check the RI
  72. #
  73. proc gen_upd_imp { current_section currtab imports } {
  74.  
  75.     $current_section pushIndent
  76.     foreach link $imports {
  77.         if { [ $link getUpdType] == "none" } {
  78.             continue;
  79.         }
  80.         gen_if_updated $current_section $currtab $link
  81.     }
  82.     $current_section popIndent
  83. }
  84.  
  85.  
  86. # Check if the key is updated
  87. #
  88. proc gen_chk_upd_key { current_section currtab }  {
  89.  
  90.     set columns [ get_col_list $currtab "KEYS" ]
  91.     set tab_name [$currtab getUniqueName]
  92.     $current_section pushIndent
  93.     expand_text $current_section {
  94.         /*
  95.          * CHECK: UPDATE OF THE KEYS
  96.          */
  97.         IF NOT( ~[ gen_comparec $current_section $columns \
  98.                      "old" "" "new" "" " AND\n" ]) THEN
  99.             msg = 'Update of key attributes of table ~$tab_name is not allowed';
  100.             RAISE ERROR 99012 :msg;
  101.             RETURN 0;
  102.         ENDIF; }
  103.     $current_section popIndent
  104. }
  105.  
  106.  
  107. # Generate code to check if the new values of a foreign key
  108. # (can be more than one column!) are the same as the old
  109. # ones, if not, check the RI
  110. #
  111. proc gen_if_updated { current_section currtab link }  {
  112.  
  113.     if { [$link getImportType] == "key"} {
  114.        return;
  115.     }
  116.     set    columns         [ $link columnSet]
  117.     set    master          [ $link master]
  118.     set    master_name     [ $master getUniqueName]
  119.     set    tab_name        [ $currtab getUniqueName]
  120.  
  121.     $current_section pushIndent
  122.     expand_text $current_section {
  123.         /*
  124.          * CHECK: FOREIGN KEY
  125.          *
  126.          * Check if the foreign key from table '~$master_name'
  127.          * is updated, if so, check the RI
  128.          */
  129.         IF NOT( ~[ gen_comparec $current_section $columns \
  130.                      "old" "" "new" "" " AND\n" ]) THEN
  131.             ~[ $current_section pushIndent
  132.                gen_ri_upd_m $current_section $currtab $link
  133.                $current_section popIndent
  134.              ]
  135.         ENDIF;
  136.     }
  137.     $current_section popIndent
  138. }
  139.  
  140.  
  141. # Generate the SQL code to check for a link (can be more than one column)
  142. # the RI between the current table and the master table
  143. #
  144. proc gen_ri_upd_m { current_section currtab link } {
  145.  
  146.     set master        [ $link master]
  147.     set rule_type     [ $link getUpdType]
  148.     set tab_name      [ $currtab getUniqueName]
  149.  
  150.     if { [get empty_imports_procs(upd,$currtab) 0]} {
  151.         return
  152.     }
  153.     $current_section pushIndent
  154.     expand_text $current_section {
  155.         /*
  156.          * RI: CHECK RI FOR MASTER
  157.          *
  158.          * Check the referential integrity after an update of
  159.          * table '~$tab_name'
  160.          *
  161.          */
  162.         ~[ set riproc [ get import_rules(upd,$rule_type)]
  163.            if { $riproc != "" } {
  164.                upd_$riproc $current_section $currtab $master $link
  165.            } else {
  166.            m4_error $E_NO_TCL_UPD_RULE $rule_type [$currtab getUniqueName]
  167.            } ]
  168.     }
  169.     $current_section popIndent
  170. }
  171.  
  172.  
  173. # Generate the declaration for the imported fields
  174. # for the CREATE RULE AFTER UPDATE statement if there are any
  175. #
  176. proc gen_upd_decl_imp_fields { current_section currtab } {
  177.     set i_columns ""
  178.     set i_columns [ get_col_list $currtab "IMPFIELDS" ];
  179.     if { ![lempty $i_columns] } {
  180.         $current_section append " ,\n"
  181.         expand_text $current_section {
  182.             ~[ gen_simple_data_decl_4glc $current_section $i_columns\
  183.                "old" " ,\n"] ,
  184.             ~[ gen_simple_data_decl_4glc $current_section $i_columns\
  185.                "new" " ,\n"] }
  186.     }
  187. }
  188.  
  189.  
  190. # Nullify the exported key in the detail table
  191. #
  192. proc upd_nullify_detail { current_section currtab detail link } {
  193.  
  194.     gen_nullify_in_detail $current_section $currtab $detail $link
  195. }
  196.  
  197.  
  198. # Reject on not exist foreign key in master table
  199. #
  200. proc upd_rej_not_exist { current_section currtab master link } {
  201.  
  202.     set tab_name    [ $currtab getUniqueName]
  203.     set mas_name    [ $master getUniqueName]
  204.     set columns     [ $link columnSet]
  205.     set detail      [ $link detail]
  206.  
  207.     gen_exist_in_master_link $current_section $detail $master $link ":new"
  208.     gen_error_upd_rej_not_exist $current_section $tab_name $mas_name
  209. }
  210.  
  211.  
  212. # Casade insert into master table, this will only work
  213. # if the non keys of the master are nullable!!
  214. #
  215. proc upd_ins_in_master { current_section currtab master link } {
  216.  
  217.     set columns [ $link columnSet]
  218.     gen_ins_in_master $current_section $master $columns
  219. }
  220.  
  221.  
  222. # Update the exported key in the detail table
  223. #
  224. proc upd_upd_in_detail { current_section currtab detail link } {
  225.  
  226.     upd_in_detail $current_section $detail $link
  227. }
  228.  
  229.  
  230. # Reject the update if the exported key exist in the detail table
  231. #
  232. proc upd_rej_exist { current_section currtab detail link } {
  233.  
  234.     set detail_name [ $detail getUniqueName]
  235.  
  236.     $current_section pushIndent
  237.     gen_exist_in_detail_link $current_section $currtab $detail $link ":old"
  238.     gen_error_upd_rej_exist $current_section $detail_name 
  239.     $current_section popIndent
  240. }
  241.