PC World 1998 October/PCWorld_1998-10_cd.bin/software/prehled/komix/DATA.Z/geninsproc.tcl

Text File | 1996-06-05 | 6KB | 174 lines

#--------------------------------------------------------------------------
#
# Copyright (c) 1992-1996 by Cadre Technologies, Inc.
#
# This software is furnished under a license and may be used only in
# accordance with the terms of such license and with the inclusion of
# the above copyright notice. This software or any other copies thereof
# may not be provided or otherwise made available to any other person.
# No title to and ownership of the software is hereby transferred.
#
# The information in this software is subject to change without notice
# and should not be construed as a commitment by Cadre Technologies, Inc.
#
#---------------------------------------------------------------------------
#
#        File           : @(#)geninsproc.tcl    2.1 (2.1)
#        Original date  : 18-8-1992
#        Description    : Tcl script for generating insert procedures
#
#---------------------------------------------------------------------------
#
# @(#)geninsproc.tcl    2.1 (2.1)\t19 Apr 1996 Copyright 1992-1996 Cadre Technologies, Inc
#
#---------------------------------------------------------------------------


# Generate the procedure body for an insert procedure
#
proc gen_insert_proc { current_section currtab } {

    global empty_imports_procs
    global empty_exports_procs
    if { [ get empty_imports_procs(ins,$currtab) 0] &&
         [ get empty_exports_procs(ins,$currtab) 0] } {
        return
    }

    set tab_name      [ $currtab getUniqueName]
    $current_section pushIndent
    expand_text $current_section {
        CREATE PROCEDURE pins_~$tab_name
        (
            ~[ gen_simple_data_decl_4gl $current_section $currtab "ALL"\
               "new" " ,\n" ]
        )
        ~[ gen_as_declare $current_section ]
        BEGIN
            ~[ gen_ins_block $current_section $currtab ]
            RETURN 1;
        END
        \\p\\g

    }
    $current_section popIndent
}

# Generate procedure block for a insert procedure
#
proc gen_ins_block { current_section currtab } {

    set tab_name [ $currtab getUniqueName]
    $current_section pushIndent
    if { ![ get empty_imports_procs(ins,$currtab) 0]} {
        expand_text $current_section {
            /* RI: CHECK RI FOR MASTERS
             * Check referential integrity after an INSERT INTO
             * table '~$tab_name'
             */
        }
        gen_imp_ins $current_section $currtab
    }
    if { ![ get empty_exports_procs(ins,$currtab) 0]} {
        expand_text $current_section {
            /* RI: CHECK RI FOR DETAILS
             * Check referential integrity after an insert into
             * table '~$tab_name'
             */
        }
        gen_exp_ins $current_section $currtab
    }
    $current_section popIndent
}

# Generate for all import links the code to check the RI
#
proc gen_imp_ins { current_section currtab } {

    $current_section pushIndent
    foreach link [ $currtab importSet] {
         set rule_type [ $link getInsType]
         if { $rule_type == "none" } {
             continue;
         }
         set riproc [ get import_rules(ins,$rule_type)]
         if { $riproc != "" } {
             ins_$riproc $current_section $currtab $link
         } else {
             m4_error $E_NO_TCL_INS_RULE $rule_type [ $currtab getUniqueName]
         }
    }
    $current_section popIndent
}

# Generate for all export links the code to check the RI
#
proc gen_exp_ins { current_section currtab } {

    $current_section pushIndent
    foreach link [ $currtab exportSet] {
         set rule_type [ $link getInsType]
         if { $rule_type == "none" } {
             continue;
         }
         set riproc [ get export_rules(ins,$rule_type)]
         if { $riproc != "" } {
             ins_$riproc $current_section $currtab $link
         } else {
         m4_error $E_NO_TCL_INS_RULE $rule_type [$currtab getUniqueName]
         }
    }
    $current_section popIndent
}

# Reject on not exist exported key in detail
#
proc ins_rej_not_exist_d { current_section currtab link } {

    set detail        [ $link detail]
    set detail_name   [ $detail getUniqueName]
    set columns       [ $link columnSet]
    set tab_name      [ $currtab getUniqueName]

    gen_exist_in_detail_link $current_section $currtab $detail $link ":new"
    gen_error_ins_rej_not_exist_in_detail $current_section $tab_name
}

# Reject on not exist foreign key in master table
#
proc ins_rej_not_exist_m { current_section currtab link } {

    set tab_name      [ $currtab getUniqueName]
    set master        [ $link master]
    set master_name   [ $master getUniqueName]
    #set columns       [ $link columnSet]
    #set detail_type   [ $link getDelType]

    gen_exist_in_master_link $current_section $currtab $master $link ":new"
    gen_error_ins_rej_not_exist_in_master $current_section $tab_name $master_name
}

# Cascade  insert into the master table
#
proc ins_ins_in_master { current_section currtab link } {

    set tab_name      [ $currtab getUniqueName]
    set master        [ $link master]
    set master_name   [ $master getUniqueName]
    set columns       [ $link columnSet]
    #set detail_type   [ $link getDelType]

    $current_section pushIndent
    expand_text $current_section {
        ~[ gen_exist_in_master_link $current_section $currtab $master $link ":new" ]
        IF counter = 0 THEN
            /* The tuple does not exist in the master table ~$master_name
             */
            msg = 'Inserting tuple in master table "~$master_name"';
            MESSAGE :msg;
            ~[ gen_ins_in_master $current_section $master $columns ]
        ENDIF;
    }
    $current_section popIndent
}