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

Text File | 1997-06-12 | 50.2 KB | 1,679 lines

#---------------------------------------------------------------------------
#
# Copyright (c) 1994 by Westmount Technology B.V., Delft, The Netherlands.
#
# 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 Westmount Technology B.V.
#
#---------------------------------------------------------------------------
#
#    File        : @(#)gen_db_fnc.tcl    /main/titanic/6
#    Original date    : 15-12-1994
#    Description    : NewEra generator functions, database dependent
#
#---------------------------------------------------------------------------
#

require serial_utl.tcl
require ne_serial.tcl

proc db_class::gen_class_decl {class} {
    if [lempty [$class genNodeSet]] {
        add_hdr_inc_name DBObject
        set sect $ne_sections(h_class_nm_sect)
        $sect append "CLASS [$class getName] "
        $sect append "DERIVED FROM DBObject\n"
    } else {
        class::gen_class_decl $class
    }

}

proc db_qual_assoc_attrib::generate {attrib class} {
    gen_for_db_assoc $attrib $class
}

proc db_qual_assoc_attrib::any_set {attrib class prefix} {
    set type [[$attrib ooplType] getName]
    set name [$attrib getName]
    set cl_name [$class getName]
    set class_data [uncap $cl_name]Data
    set key [get_qualifier_name $attrib]
    set qual [$attrib qualifier]
    set q_type [generate_ixval [$qual ooplType] fwd]
    set sect [get_assoc_hdr_sect $attrib w]
    set access [get_access_mode [get_assoc_access $attrib] w]
    $sect append "${access}FUNCTION $prefix[cap $name]($key "
    $sect append "$q_type, new_$name $type) RETURNING INTEGER\n"
    set sect [get_assoc_src_sect $attrib w]
    $sect append "FUNCTION $cl_name::$prefix[cap $name]($key "
    $sect append "$q_type, new_$name $type) RETURNING INTEGER\n"
    $sect indent +
    set link [$attrib link]
    set opp_link [$attrib oppositeLink]
    set my_tab [$class table]
    set my_tab_nm [$my_tab getUniqueName]
    set dt_tab [$link detail]
    set dt_tab_nm [$dt_tab getUniqueName]
    set op_tab [$opp_link master]
    set op_tab_nm [$op_tab getUniqueName]
    set q_col [[$attrib qualifier] column]
    set param_nr 2
    expand_text $sect {
        VARIABLE stmt ixSQLStmt(getConnection())
        VARIABLE ~${op_tab_nm}_data ixRow =\
            new_~$name.~[uncap $type]Data

        CALL stmt.prepare("EXECUTE PROCEDURE pins_~${dt_tab_nm}(" ||
            "p_~[$q_col getUniqueName] = ?, " ||
            "~[gen_dyn_compare_cl $sect $link p_ "" \
                ", \" ||\n\""], " ||
            "~[gen_dyn_compare_cl $sect $opp_link p_ "" \
                ", \" ||\n\""])")
        CALL stmt.setParam(1, ~$key)
        ~[gen_setparam_cl $sect $link param_nr $class_data]
        ~[gen_setparam_cl $sect $opp_link param_nr ${op_tab_nm}_data]
        CALL stmt.execute()

        IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
            RETURN 0
        END IF
        RETURN -1
    }
    $sect indent -
    $sect append "END FUNCTION\n\n"
}

proc db_qual_assoc_attrib::one_set {attrib class} {
    db_qual_assoc_attrib::any_set $attrib $class "set"
}

proc db_qual_assoc_attrib::one_remove {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [$attrib getName]
    set cl_name [$class getName]
    set class_data [uncap $cl_name]Data
    set key [get_qualifier_name $attrib]
    set qual [$attrib qualifier]
    set q_type [generate_ixval [$qual ooplType] fwd]
    set sect [get_assoc_hdr_sect $attrib w]
    set access [get_access_mode [get_assoc_access $attrib] w]
    $sect append "${access}FUNCTION remove[cap $name]($key $q_type)\
            RETURNING INTEGER\n"
    set link [$attrib link]
    set my_tab_nm [[$class table] getUniqueName]
    set dt_tab_nm [[$link detail] getUniqueName]
    set q_col [$qual column]
    set sect [get_assoc_src_sect $attrib w]
    set param_nr 1
    expand_text $sect {
    FUNCTION ~$cl_name::remove~[cap $name](~$key ~$q_type)\
            RETURNING INTEGER
        VARIABLE stmt ixSQLStmt(getConnection())

        CALL stmt.prepare("EXECUTE PROCEDURE pdel_~${dt_tab_nm}(" ||
            "~[gen_dyn_compare_cl $sect $link p_ "" \
                ", \" ||\n\""], " ||
            "p_~$key = ?)")
        ~[gen_setparam_cl $sect $link param_nr $class_data]
        CALL stmt.setParam(~$param_nr, ~$key)
        CALL stmt.execute()

        IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
            RETURN 0
        END IF
        RETURN -1
    END FUNCTION

    }
}

proc db_qual_assoc_attrib::one_get {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [$attrib getName]
    set cl_name [$class getName]
    set class_data [uncap $cl_name]Data
    set key [get_qualifier_name $attrib]
    set qual [$attrib qualifier]
    set q_type [generate_ixval [$qual ooplType] fwd]
    set sect [get_assoc_hdr_sect $attrib r]
    set access [get_access_mode [get_assoc_access $attrib] r]
    $sect append "${access}FUNCTION get[cap $name]($key $q_type)\
            RETURNING $type\n"
    set link [$attrib link]
    set opp_link [$attrib oppositeLink]
    set my_tab_nm [[$class table] getUniqueName]
    set dt_tab_nm [[$link detail] getUniqueName]
    set q_col [$qual column]
    set sect [get_assoc_src_sect $attrib r]
    set param_nr 1
    expand_text $sect {
    FUNCTION ~$cl_name::get~[cap $name](~$key ~$q_type) RETURNING ~$type
        VARIABLE stmt ixSQLStmt(getConnection())
        VARIABLE ~${dt_tab_nm}_datai ixRow

        CALL stmt.prepare("SELECT ~[gen_col_listl $sect $opp_link] " ||
            "FROM ~$dt_tab_nm " ||
            "WHERE ~[gen_dyn_compare_cl $sect $link "" "" \
                " AND \" ||\n\""] AND " ||
                "~$key = ?")
        ~[gen_setparam_cl $sect $link param_nr $class_data]
        CALL stmt.setParam(~$param_nr, ~$key)

        CALL stmt.execute()
        LET ~${dt_tab_nm}_datai = stmt.fetch()
        IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
            RETURN NULL
        END IF
        RETURN ~$type::findInDBByType(~[gen_rowgetvalinc_l $sect \
                $opp_link ${dt_tab_nm}_datai "" ",\n"])
            CAST ~$type
    END FUNCTION

    }
}

proc db_qual_assoc_attrib::many_set {attrib class} {
    db_qual_assoc_attrib::any_set $attrib $class "add"
}

proc db_qual_assoc_attrib::many_remove {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [$attrib getName]
    set cl_name [$class getName]
    set class_data [uncap $cl_name]Data
    set key [get_qualifier_name $attrib]
    set qual [$attrib qualifier]
    set q_type [generate_ixval [$qual ooplType] fwd]
    set sect [get_assoc_hdr_sect $attrib w]
    set access [get_access_mode [get_assoc_access $attrib] w]
    $sect append "${access}FUNCTION remove[cap $name]($key $q_type,\
            toRemove $type) RETURNING INTEGER\n"
    set link [$attrib link]
    set opp_link [$attrib oppositeLink]
    set my_tab_nm [[$class table] getUniqueName]
    set dt_tab_nm [[$link detail] getUniqueName]
    set ot_tab_nm [[$opp_link master] getUniqueName]
    set q_col [$qual column]
    set sect [get_assoc_src_sect $attrib w]
    set param_nr 1
    expand_text $sect {
    FUNCTION ~$cl_name::remove~[cap $name](~$key ~$q_type, toRemove ~$type)\
            RETURNING INTEGER
        VARIABLE stmt ixSQLStmt(getConnection())
        VARIABLE ~${ot_tab_nm}_data ixRow =\
            toRemove.~[uncap $type]Data

        CALL stmt.prepare("EXECUTE PROCEDURE pdel_~${dt_tab_nm}(" ||
            "~[gen_dyn_compare_cl $sect $link "p_" \
                ", \" ||\n\""], " ||
            "~[gen_dyn_compare_cl $sect $opp_link "p_" \
                ", \" ||\n\""], " ||
            "p_~$key = ?)")
        ~[gen_setparam_cl $sect $link param_nr $class_data]
        ~[gen_setparam_cl $sect $opp_link param_nr ${ot_tab_nm}_data]
        CALL stmt.setParam(~$param_nr, ~$key)
        CALL stmt.execute()

        IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
            RETURN -1
        END IF
        RETURN 0
    END FUNCTION

    }
}

proc db_qual_assoc_attrib::many_get {attrib class} {
    set setpfx [set_prefix $attrib]
    set type [[$attrib ooplType] getName]
    set type_of_set [${setpfx}set_type_name [$attrib ooplType]]
    set name [$attrib getName]
    set name_of_set [${setpfx}set_name $name]
    set add_func [set ${setpfx}set::add]
    set class_nm [$class getName]
    set class_data [uncap $class_nm]Data
    set key [get_qualifier_name $attrib]
    set qual [$attrib qualifier]
    set q_type [generate_ixval [$qual ooplType] fwd]
    set func_name get[cap $name]Set
    set sect [get_assoc_hdr_sect $attrib r]
    set access [get_access_mode [get_assoc_access $attrib] r]
    $sect append "${access}FUNCTION ${func_name}($name_of_set $type_of_set, $key $q_type) RETURNING INTEGER\n"
    set link [$attrib link]
    set opp_link [$attrib oppositeLink]
    set my_tab_nm [[$class table] getUniqueName]
    set dt_tab_nm [[$link detail] getUniqueName]
    set q_col [$qual column]
    set sect [get_assoc_src_sect $attrib r]
    set param_nr 1
    expand_text $sect {
    FUNCTION ~$class_nm::~${func_name}(~$name_of_set ~$type_of_set,\
            ~$key ~$q_type) RETURNING INTEGER
        VARIABLE stmt ixSQLStmt(getConnection())
        VARIABLE ~${dt_tab_nm}_datai ixRow
        VARIABLE ~${type}Ref ~$type
        VARIABLE addOk INTEGER

        CALL stmt.prepare("SELECT ~[
                gen_col_listl $sect $opp_link] " ||
            "FROM ~$dt_tab_nm " ||
            "WHERE ~[gen_dyn_compare_cl $sect $link \
                "" "" " AND \" ||\n\""] AND " ||
            "~$key = ?")
        ~[gen_setparam_cl $sect $link param_nr $class_data]
        CALL stmt.setParam(~$param_nr, ~$key)
        CALL stmt.execute()

        LET ~${dt_tab_nm}_datai = stmt.fetch()
        WHILE stmt.getODBCErrorCode() == stmt.SQL_Success
            LET ~${type}Ref = ~$type::findInDBByType(~[
                gen_rowgetvalinc_l $sect $opp_link \
                    ${dt_tab_nm}_datai "" ",\n"])
                CAST ~$type
            IF ~${type}Ref IS NOT NULL THEN
                LET addOk = ~$name_of_set.~${add_func}(~${type}Ref)
            END IF
            LET ~${dt_tab_nm}_datai = stmt.fetch()
        END WHILE
        CALL stmt.free(stmt.SQL_Close)

        IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
            RETURN -1
        END IF
        RETURN 0
    END FUNCTION

    }
}

proc db_link_attrib::generate {attrib class} {
    set type [$attrib ooplType]
    add_src_inc $type
    add_forward $type
    db_link_attrib::[$attrib getMultiplicity]_generate $attrib $class
}

proc db_link_attrib::one_generate {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [$attrib getName]
    set cl_name [$class getName]
    set class_data [uncap $cl_name]Data
    set sect [get_assoc_hdr_sect $attrib r]
    set access [get_access_mode [get_assoc_access $attrib] r]
    set func_name get[cap "${type}Of[cap $name]"]
    $sect append "${access}FUNCTION ${func_name}() RETURNING $type\n\n"
    set link [$attrib link]
    set dt_tab [$link detail]
    set dt_tab_nm [$dt_tab getUniqueName]
    set my_tab_nm [[$class table] getUniqueName]
    set sect [get_assoc_src_sect $attrib r]
    set param_nr 1
    expand_text $sect {
        FUNCTION ~$cl_name::~${func_name}() RETURNING ~$type
            VARIABLE stmt ixSQLStmt(getConnection())
            VARIABLE ~${dt_tab_nm}_datai ixRow

            CALL stmt.prepare("SELECT ~[gen_col_list $sect $dt_tab\
                    KEYS] " ||
                "FROM ~$dt_tab_nm " ||
                "WHERE ~[gen_dyn_compare_cl $sect $link "" "" \
                    " AND \" ||\n\""]")
            ~[gen_setparam_cl $sect $link param_nr $class_data]
            CALL stmt.execute()

            LET ~${dt_tab_nm}_datai= stmt.fetch()
            IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
                RETURN NULL
            END IF

            RETURN ~$type::findInDBByType(~[gen_rowgetvalinc $sect \
                $dt_tab KEYS ${dt_tab_nm}_datai "" ",\n"])
                CAST ~$type
        END FUNCTION

    }
}

proc db_link_attrib::many_generate {attrib class} {
    set setpfx [set_prefix $attrib]
    set type [[$attrib ooplType] getName]
    set type_of_set [${setpfx}set_type_name [$attrib ooplType]]
    set name [$attrib getName]
    set func_name get[cap [${setpfx}set_name "${type}Of[cap $name]"]]
    set name_of_set [cap [${setpfx}set_name $name]]
    set add_func [set ${setpfx}set::add]
    set class_nm [$class getName]
    set class_data [uncap $class_nm]Data
    set sect [get_assoc_hdr_sect $attrib r]
    set access [get_access_mode [get_assoc_access $attrib] r]
    $sect append "${access}FUNCTION ${func_name}($name_of_set $type_of_set) RETURNING INTEGER\n"
    set tab_nm [[$class table] getUniqueName]
    set link [$attrib link]
    set dt_table [$link detail]
    set dt_tab_nm [$dt_table getUniqueName]
    set sect [get_assoc_src_sect $attrib r]
    set param_nr 1
    expand_text $sect {
    FUNCTION ~$class_nm::~${func_name}(~$name_of_set ~$type_of_set)\
            RETURNING INTEGER
        VARIABLE stmt ixSQLStmt(getConnection())
        VARIABLE ~${dt_tab_nm}_datai ixRow
        VARIABLE ~${type}Ref ~$type
        VARIABLE addOk INTEGER

        CALL stmt.prepare("SELECT ~[
                gen_col_list $sect $dt_table KEYS] " ||
            "FROM ~$dt_tab_nm " ||
            "WHERE ~[gen_dyn_compare_cl $sect $link \
                "" "" " AND \" ||\n\""]")
        ~[gen_setparam_cl $sect $link param_nr $class_data]
        CALL stmt.execute()

        LET ~${dt_tab_nm}_datai = stmt.fetch()
        WHILE stmt.getODBCErrorCode() == stmt.SQL_Success
            LET ~${type}Ref = ~$type::findInDBByType(~[ \
                gen_rowgetvalinc $sect $dt_table KEYS \
                ${dt_tab_nm}_datai "" ",\n"])
                CAST ~$type
            IF ~${type}Ref IS NOT NULL THEN
                LET addOk = ~$name_of_set.~${add_func}(~${type}Ref)
            END IF
            LET ~${dt_tab_nm}_datai = stmt.fetch()
        END WHILE
        CALL stmt.free(stmt.SQL_Close)

        IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
            RETURN -1
        END IF
        RETURN 0
    END FUNCTION

    }
}

proc db_qual_link_attrib::generate {attrib class} {
    # Only "get" is implemented for link attribs: the link is
    # maintained through the link class itself
    set type [$attrib ooplType]
    add_forward $type
    add_src_inc $type
    db_qual_link_attrib::[$attrib getMultiplicity]_generate $attrib $class
}

proc db_qual_link_attrib::one_generate {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [$attrib getName]
    set func_name get[cap "${type}Of[cap $name]"]
    set cl_name [$class getName]
    set class_data [uncap $cl_name]Data
    set key [get_qualifier_name $attrib]
    set qual [$attrib qualifier]
    set q_type [generate_ixval [$qual ooplType] fwd]
    set sect [get_assoc_hdr_sect $attrib r]
    set access [get_access_mode [get_assoc_access $attrib] r]
    $sect append "${access}FUNCTION ${func_name}($key $q_type) RETURNING $type\n"
    set link [$attrib link]
    set sect [get_assoc_src_sect $attrib r]
    expand_text $sect {
    FUNCTION ~$cl_name::~${func_name}(~$key ~$q_type) RETURNING ~$type
        RETURN ~$type::findInDBByType(~[
                gen_rowgetval_l $sect $link $class_data], ~$key)
            CAST ~$type
    END FUNCTION

    }
}

proc db_qual_link_attrib::many_generate {attrib class} {
    set setpfx [set_prefix $attrib]
    set type [[$attrib ooplType] getName]
    set type_of_set [${setpfx}set_type_name [$attrib ooplType]]
    set name [$attrib getName]
    set name_of_set [${setpfx}set_name $name]
    set add_func [set ${setpfx}set::add]
    set class_nm [$class getName]
    set class_data [uncap $class_nm]Data
    set key [get_qualifier_name $attrib]
    set qual [$attrib qualifier]
    set q_type [generate_ixval [$qual ooplType] fwd]
    set func_name get[cap "${type}Of[cap $name]"]Set
    set sect [get_assoc_hdr_sect $attrib r]
    set access [get_access_mode [get_assoc_access $attrib] r]
    $sect append "${access}FUNCTION ${func_name}($name_of_set $type_of_set, $key $q_type) RETURNING INTEGER\n"
    set link [$attrib link]
    set opp_link [$attrib oppositeLink]
    set my_tab_nm [[$class table] getUniqueName]
    set dt_tab [$link detail]
    set dt_tab_nm [$dt_tab getUniqueName]
    set q_col [$qual column]
    set sect [get_assoc_src_sect $attrib r]
    set param_nr 1
    expand_text $sect {
    FUNCTION ~$class_nm::~${func_name}(~$name_of_set ~$type_of_set,\
            ~$key ~$q_type) RETURNING INTEGER
        VARIABLE stmt ixSQLStmt(getConnection())
        VARIABLE ~${dt_tab_nm}_datai ixRow
        VARIABLE ~${type}Ref ~$type
        VARIABLE addOk INTEGER

        CALL stmt.prepare("SELECT ~[
                gen_col_list $sect $dt_tab KEYS] " ||
            "FROM ~$dt_tab_nm " ||
            "WHERE ~[gen_dyn_compare_cl $sect $link \
                "" "" " AND \" ||\n\""] AND " ||
                "~$key = ?")
        ~[gen_setparam_cl $sect $link param_nr $class_data]
        CALL stmt.setParam(~$param_nr, ~$key)
        CALL stmt.execute()

        LET ~${dt_tab_nm}_datai = stmt.fetch()
        WHILE stmt.getODBCErrorCode() == stmt.SQL_Success
            LET ~${type}Ref = ~$type::findInDBByType(~[ \
                gen_rowgetvalinc $sect $dt_tab KEYS \
                ${dt_tab_nm}_datai "" ",\n"])
                CAST ~$type
            IF ~${type}Ref IS NOT NULL THEN
                LET addOk = ~$name_of_set.~${add_func}(~${type}Ref)
            END IF
            LET ~${dt_tab_nm}_datai = stmt.fetch()
        END WHILE
        CALL stmt.free(stmt.SQL_Close)

        IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
            RETURN -1
        END IF
        RETURN 0
    END FUNCTION

    }
}

proc db_rv_link_attrib::generate {attrib class} {
    set type [[$attrib ooplType] getName]
    add_src_inc [$attrib ooplType]
    add_forward [$attrib ooplType]
    set name [$attrib getName]
    set cl_name [$class getName]
    set class_data [uncap $cl_name]Data
    set sect $ne_sections(h_pub_func_sect)
    $sect append "PUBLIC FUNCTION get[cap $name]() RETURNING $type\n\n"
    set link [$attrib link]
    set sect $ne_sections(c_impl_no_regen_sect)
    expand_text $sect {
        FUNCTION ~$cl_name::get~[cap $name]() RETURNING ~$type
            RETURN ~$type::findInDBByType(~[
                gen_rowgetval_l $sect $link $class_data])
                CAST ~$type
        END FUNCTION

    }
}

proc db_rv_link_attrib::gen_initializer {attrib init decl_s body_s class} {
    set name [$init getName]
    set type [$attrib ooplType]
    set class_data [uncap [$class getName]]Data
    gen_assign_cl $body_s [$attrib link] $class_data ""\
        $name.[uncap [$type getName]]Data ""
}

proc db_link_class::generate {class} {
    db_class::generate $class
}

proc db_class::generate {class} {
    add_hdr_sys_inc_name ixrow
    add_src_sys_inc_name ixstmt

    class::generate $class
}


# for db classes db_constructor::generate generates a function called init
# i.s.o. a real constructor;
#
proc db_constructor::generate {ctor class} {
    global exists_ctor
    set exists_ctor 1
    if [is_eq_db_ctor $ctor $class] {
        # it wil be generated later
        global db_ctor_is_unique
        set db_ctor_is_unique 1
        return
    }
    # we have a double 'ctor' !
    set class_nm [$class getName]
        set class_data [uncap $class_nm]Data
    set sect $ne_sections(h_pub_func_sect)
    $sect append "FUNCTION init[cap $class_nm]"
    set with_default 1
    set with_types 1
    gen_db_ctor_params $class $sect $with_default $with_types
    $sect append " RETURNING INTEGER\n"
    set sect $ne_sections(c_impl_no_regen_sect)
    $sect append "FUNCTION $class_nm::init[cap $class_nm]"
    set with_default 0
    gen_db_ctor_params $class $sect $with_default $with_types
    $sect append " RETURNING INTEGER\n"
    $sect indent +
    $sect append "VARIABLE retVal ixValue\n\n"
    set table [$class table]
    gen_assign_null $sect $table NULL_AND_NO_INIT $class_data
    set TYPE_ID_NM_col_nr [get_column_nr [lindex \
        [get_col_list $table TYPE] 0]]
    $sect append "LET retVal =\
        $class_data.setVal(getClassName(), $TYPE_ID_NM_col_nr)\n"
    foreach init [$ctor initializerSet] {
        generate $init $sect $sect $sect $class
    }
    $sect append "\nRETURN 0\n"
    $sect indent -
    $sect append "END FUNCTION\n\n"

    set with_default 1
    set with_types 1
    expand_text $ne_sections(h_pub_func_sect) {
        SHARED FUNCTION NEW~${class_nm}~[gen_db_ctor_params \
        $class $current_section $with_default $with_types \
        ] RETURNING ~${class_nm}
    }
    expand_text $ne_sections(c_impl_no_regen_sect) {
        FUNCTION ~${class_nm}::NEW~${class_nm}~[
            gen_db_ctor_params $class $current_section \
            $with_default $with_types]\
            RETURNING ~${class_nm}
            VARIABLE tmp ~${class_nm} = NEW ~${class_nm}()

            IF tmp.init~[cap $class_nm]~[gen_db_ctor_params \
                $class $current_section 0 0] < 0 THEN
                RETURN NULL
            END IF
            RETURN tmp
        END FUNCTION

    }
}

# used by db_constructor::generate
#
proc gen_db_ctor_params {class sect with_default with_types} {
    if $with_default {
        set decl fwd
    } else {
        set decl inc
    }

    $sect append "("
    set first 1
    set is_db 1
    foreach param [$class creationParamSet] {
        parameter::generate $param $sect first $decl $is_db $with_types
        set default [get_default_value $param]
        if {$with_default && $default != ""} {
            $sect append " : $default"
        }
    }
    $sect append ")"
}


proc db_class_before {class} {
    set class_nm [$class getName]
    $ne_sections(h_priv_data_sect) append "SHARED PRIVATE VARIABLE\
        [uncap $class_nm]RowSchema ixRow\n"
    $ne_sections(c_static_sect) append "VARIABLE\
        ${class_nm}::[uncap $class_nm]RowSchema ixRow = NULL\n"
    $ne_sections(c_static_sect) append \
        "CONSTANT ${class_nm}Str = \"$class_nm\"\n"
}

proc db_class_after {class} {
    set class_nm [$class getName]
    set uclass_nm [uncap $class_nm]
    set class_data ${uclass_nm}Data
    global db_ctor_is_unique
    global exists_ctor
    if {! $exists_ctor} {
        set db_ctor_is_unique 1
        set exists_ctor 1
    }
    if [lempty [$class genNodeSet]] {
        db_class::gen_for_base $class
    }
    db_class::gen_for_derived $class

    set table [$class table]
    set tab_nm [$table getUniqueName]
    expand_text $ne_sections(h_pub_data_sect) {
        PUBLIC VARIABLE ~$class_data ixRow
    }
    if $db_ctor_is_unique {
        set bykeys ""
    } else {
        set bykeys "ByKeys"
    }
    expand_text $ne_sections(h_ctor_sect) {
        FUNCTION ~${class_nm}()
    }
    set sect $ne_sections(h_pub_func_sect)
    expand_text $sect {
        SHARED FUNCTION NEW~${class_nm}~${bykeys}(~[gen_param_decl_ne \
            $sect $table KEYS_NO_TYPE fwd]) RETURNING ~${class_nm}
    }
    set genByRow 0
    if {$genByRow} {
        expand_text $sect {
            SHARED FUNCTION NEW~${class_nm}ByRow(initRow ixRow)\
                RETURNING ~${class_nm}
        }
    }

    set sect $ne_sections(h_pub_func_sect)
    expand_text $sect {
        FUNCTION init~[cap $class_nm]~${bykeys}(~[gen_param_decl_ne \
            $sect $table KEYS_NO_TYPE fwd]) RETURNING INTEGER
    }
    if {$genByRow} {
        expand_text $sect {
            FUNCTION init~[cap $class_nm]ByRow(initRow ixRow)\
                RETURNING INTEGER
        }
    }

    set sect $ne_sections(h_pub_func_sect)
    expand_text $sect {
        PUBLIC FUNCTION insertInDB() RETURNING INTEGER
        PUBLIC FUNCTION readFromDB() RETURNING INTEGER
        PUBLIC FUNCTION deleteFromDB() RETURNING INTEGER
        PUBLIC FUNCTION updateInDB() RETURNING INTEGER

    }

    regen_unset ${class_nm} "()"
    set sect $ne_sections(c_ctor_init_sect)
    $sect append "FUNCTION $class_nm::${class_nm}()\n"
    set sect $ne_sections(c_ctor_body_sect)
    expand_text $sect {
        VARIABLE stmt ixSQLStmt

        LET className = NEW ixString(~${class_nm}Str)
        IF ~${uclass_nm}RowSchema IS NULL THEN
            LET stmt = NEW ixSQLStmt(getConnection())
            CALL stmt.prepare("~[padString "SELECT " \
                [gen_col_list_str $table ALL] \
                " " "\" || \""]" ||
                "FROM ~$tab_nm")
            LET ~${uclass_nm}RowSchema = stmt.allocateRow()
        END IF
        LET ~$class_data = COPY ~${uclass_nm}RowSchema

    }
    set sect $ne_sections(c_impl_no_regen_sect)
    expand_text $sect {
        FUNCTION ~${class_nm}::NEW~${class_nm}~${bykeys}(~[gen_param_decl_ne $sect $table KEYS_NO_TYPE inc]) RETURNING ~${class_nm}
            VARIABLE tmp ~${class_nm} = NEW ~${class_nm}()

            IF tmp.init~[cap $class_nm]~${bykeys}(~[gen_col_list \
                $sect $table KEYS_NO_TYPE]) < 0 THEN
                RETURN NULL
            END IF
            RETURN tmp
        END FUNCTION

    }
    if {$genByRow} {
        expand_text $sect {
        FUNCTION ~${class_nm}::NEW~${class_nm}ByRow(initRow ixRow) RETURNING ~${class_nm}
            VARIABLE tmp ~${class_nm} = NEW ~${class_nm}()
            VARIABLE copyRow ixRow = COPY initRow
            LET copyRow.isCountLocked = FALSE

            IF tmp.init~[cap $class_nm]ByRow(copyRow) < 0 THEN
                RETURN NULL
            END IF
            RETURN tmp
        END FUNCTION

        }
    }

    set TYPE_ID_NM_col_nr [get_column_nr [lindex [get_col_list $table TYPE] 0]]

    expand_text $sect {
        FUNCTION ~$class_nm::init~[cap $class_nm]~${bykeys}(~[\
            gen_param_decl_ne $sect $table KEYS_NO_TYPE inc])\
            RETURNING INTEGER
            VARIABLE retVal ixValue

            IF ~$class_data IS NULL THEN
                RETURN -1
            END IF
            ~[db_class::init_bases_bykeys $sect $class $bykeys]
            ~[gen_assign_null $sect $table NONKEYS $class_data]
            LET retVal = ~$class_data.setVal(getClassName(),\
                ~$TYPE_ID_NM_col_nr)
            ~[gen_assign $sect $table KEYS_NO_TYPE $class_data]
            RETURN 0
        END FUNCTION

    }
    if {$genByRow} {
        expand_text $sect {
        FUNCTION ~$class_nm::init~[cap $class_nm]ByRow(initRow ixRow)\
            RETURNING INTEGER
            VARIABLE retVal ixObject

            IF ~$class_data IS NULL THEN
                RETURN -1
            END IF
            ~[db_class::init_bases_byrow $sect $class]
            ~[gen_assign_initrow $sect $table KEYS_FIELDS \
                $class_data initRow]
            RETURN 0
        END FUNCTION

        }
    }
    set serial_nr [get_serial_column_nr $table]
    if {$serial_nr != 0} {
        expand_text $sect {
            FUNCTION ~$class_nm::insertInDB() RETURNING INTEGER
                VARIABLE stmt ixSQLStmt(getConnection())
                VARIABLE theSerial ixInteger

            ~[    call_for_all_bases $class $sect insertInDB
            ]
                CALL stmt.prepare("INSERT INTO ~$tab_nm " ||
                    "VALUES (~[gen_dyn_place_holders $sect\
                        $table ALL])")
                CALL stmt.setParams(~$class_data)
                CALL stmt.execute()

                LET theSerial =\
                    ~$class_data.getVal(~$serial_nr)\
                    CAST ixInteger
                IF theSerial.value == 0 THEN
                    LET theSerial.value = SQLCA.SQLERRD[2]
                END IF
                RETURN processSqlStatus(stmt)
            END FUNCTION

        }
    } else {
        expand_text $sect {
            FUNCTION ~$class_nm::insertInDB() RETURNING INTEGER
                VARIABLE stmt ixSQLStmt(getConnection())

            ~[    call_for_all_bases $class $sect insertInDB
            ]~[    call_for_all_bases_set_serial $class $sect
            ]
                CALL stmt.prepare("EXECUTE PROCEDURE\
                    pins_~${tab_nm}(~[gen_dyn_place_holders\
                        $sect $table ALL])")
                CALL stmt.setParams(~$class_data)
                CALL stmt.execute()
                RETURN processSqlStatus(stmt)
            END FUNCTION

        }
    }
    set param_nr 1
    expand_text $sect {
        FUNCTION ~$class_nm::readFromDB() RETURNING INTEGER
            VARIABLE stmt ixSQLStmt(getConnection())

            CALL stmt.prepare("~[padString "SELECT " \
                [gen_col_list_str $table ALL] \
                " " "\" || \""]" ||
                "FROM ~$tab_nm " ||
                "WHERE ~[gen_dyn_compare $sect $table KEYS \
                    "" "" " AND \" ||\n\""]")
            ~[gen_setparamc $sect $table param_nr KEYS $class_data]
            CALL stmt.execute()
            CALL stmt.fetchInto(~$class_data)
            IF processSqlStatus(stmt) < 0 THEN
                RETURN -1
            END IF~[
            call_for_all_bases $class $sect readFromDB]
            RETURN 0
        END FUNCTION

    }
    set param_nr 1
    expand_text $sect {
        FUNCTION ~$class_nm::deleteFromDB() RETURNING INTEGER
            VARIABLE stmt ixSQLStmt(getConnection())

            CALL stmt.prepare("EXECUTE PROCEDURE pdel_~${tab_nm}(~[\
                gen_dyn_place_holders $sect $table KEYS])")
            ~[gen_setparamc $sect $table param_nr KEYS $class_data]
            CALL stmt.execute()
            IF processSqlStatus(stmt) < 0 THEN
                RETURN -1
            END IF~[
            call_for_all_bases $class $sect deleteFromDB]
            RETURN 0
        END FUNCTION

    }
    if {![lempty [get_col_list $table NONKEYFIELDS]]} {
        set param_nr 1
        expand_text $sect {
            FUNCTION ~$class_nm::updateInDB() RETURNING INTEGER
                VARIABLE stmt ixSQLStmt(getConnection())

                CALL stmt.prepare("UPDATE ~$tab_nm " ||
                    "SET ~[gen_dyn_compare $sect $table \
                    NONKEYFIELDS "" "" ", \" ||\n\""] " ||
                    "WHERE ~[gen_dyn_compare $sect $table \
                    KEYS "" "" " AND \" ||\n\""]")
                ~[gen_setparamc $sect $table param_nr \
                    "NONKEYFIELDS KEYS" $class_data]
                CALL stmt.execute()
                IF processSqlStatus(stmt) < 0 THEN
                    RETURN -1
                END IF~[
                call_for_all_bases $class $sect updateInDB]
                RETURN 0
            END FUNCTION
        }
    } else {
        expand_text $sect {
            FUNCTION ~$class_nm::updateInDB() RETURNING INTEGER
                ~[call_for_all_bases $class $sect updateInDB]
                RETURN 0
            END FUNCTION
        }
    }

}

proc db_class::init_bases_bykeys {sect class bykeys} {
    $sect pushIndent
    set table [$class table]
    foreach gen_node [$class genNodeSet] {
        set super_name [$gen_node getSuperClassName]
        set superClass [$gen_node superClass]
        if ![$superClass isPersistent] {
            continue
        }
        set super_table [$superClass table]
        expand_text $sect {
            IF init~[cap $super_name]~${bykeys}(~[
                gen_col_list $sect $table IMPKEYS_NO_TYPE \
                    "" "" ", " "" $super_table]) < 0 THEN
                RETURN -1
            END IF
        }
    }
    $sect popIndent
}

proc db_class::init_bases_byrow {sect class} {
        $sect pushIndent
        set table [$class table]
        foreach gen_node [$class genNodeSet] {
        set super_name [$gen_node getSuperClassName]
        set superClass [$gen_node superClass]
        if ![$superClass isPersistent] {
            continue
        }
        set super_table [$superClass table]
        expand_text $sect {
            IF init~[cap $super_name]ByRow(initRow) < 0 THEN
                RETURN -1
            END IF
        }
    }
    $sect popIndent
}

proc db_class::gen_for_base {class} {
    set class_nm [$class getName]
    set table [$class table]
    set setpfx ""
    set type_of_set [${setpfx}set_type_name $class]
    set name_of_set [uncap [${setpfx}set_name $class_nm]]
    set add_func [set ${setpfx}set::add]
    expand_text $ne_sections(h_pub_func_sect) {
        SHARED FUNCTION findInDBByType(~[gen_param_decl_ne $current_section \
            $table KEYS fwd]) RETURNING ~$class_nm
        SHARED FUNCTION findInDB(~[gen_param_decl_ne $current_section \
            $table KEYS_NO_TYPE fwd]) RETURNING ~$class_nm
        SHARED FUNCTION searchInDB(~$name_of_set ~$type_of_set,\
            whereClause ixString : NULL) RETURNING INTEGER
    }
    set sect $ne_sections(c_impl_no_regen_sect)
    expand_text $sect {
        FUNCTION ~$class_nm::searchInDB(~$name_of_set ~$type_of_set,\
            whereClause ixString) RETURNING INTEGER
            VARIABLE stmt ixSQLStmt(DBObject::getConnection())
            VARIABLE ~${class_nm}Ref ~$class_nm
            VARIABLE prepareStr ixString("")
            VARIABLE db_data ixRow
            VARIABLE addOk INTEGER

            CALL prepareStr.concat(NEW ixString("SELECT ~[
                gen_col_list $sect $table KEYS] FROM ~[
                $table getUniqueName]"))
            IF whereClause IS NOT NULL THEN
                IF whereClause.getLength() > 0 THEN
                    CALL prepareStr.concat(NEW ixString(" WHERE "))
                    CALL prepareStr.concat(whereClause)
                END IF
            END IF

            CALL stmt.prepare(prepareStr.getValueStr())
            IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
                RETURN -1
            END IF
            CALL stmt.execute()
            IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
                RETURN -1
            END IF

            LET db_data = stmt.fetch()
            WHILE stmt.getODBCErrorCode() == stmt.SQL_Success
                LET ~${class_nm}Ref = findInDBByType(~[ \
                    gen_rowgetvalinc \
                    $sect $table KEYS db_data "" ",\n"])
                IF ~${class_nm}Ref IS NOT NULL THEN
                    LET addOk = ~$name_of_set.~${add_func}(~${class_nm}Ref)
                END IF
                LET db_data = stmt.fetch()
            END WHILE
            CALL stmt.free(stmt.SQL_Close)

            IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
                RETURN -1
            END IF
            RETURN 0
        END FUNCTION

        FUNCTION ~$class_nm::findInDBByType(~[gen_param_decl_ne \
                $sect $table KEYS inc]) RETURNING ~$class_nm
            VARIABLE instantiator ~${class_nm}Instantiator
            VARIABLE actualInstantiator ixString

            IF ~$TYPE_ID_NM IS NULL THEN
                RETURN NULL
            END IF
            LET actualInstantiator = COPY ~$TYPE_ID_NM
            CALL actualInstantiator.concat(NEW\
                ixString("Instantiator"))
            LET instantiator = NEW ~${class_nm}Instantiator() AS\
                actualInstantiator.getValueStr()
            RETURN instantiator.instantiate(~[ \
                gen_col_list $sect $table KEYS_NO_TYPE])
        END FUNCTION

    }
    db_class::gen_generic_find $class $table
}

proc db_class::gen_generic_find {class table} {
    set class_nm [$class getName]
    set sect $ne_sections(c_impl_no_regen_sect)
    if {[lempty [$class specNodeSet]] && ([$class get_obj_type] != "db_link_class")} {
        # Simple case: no sub classes
        expand_text $sect  {
            FUNCTION ~$class_nm::findInDB(~[gen_param_decl_ne \
                $sect $table KEYS_NO_TYPE inc]) RETURNING ~$class_nm
                VARIABLE ~$TYPE_ID_NM ixString =\
                    NEW ixString("~$class_nm")
                RETURN findInDBByType(~[
                    gen_col_list $sect $table KEYS])
            END FUNCTION

        }
        return
    }
    # Sub (or link) classes exist. Look up the class type in the database
    expand_text $sect {
        FUNCTION ~$class_nm::findInDB(~[gen_param_decl_ne $sect \
            $table KEYS_NO_TYPE inc]) RETURNING ~$class_nm
            ~[gen_col_list $sect $table KEYS_TYPE "VARIABLE " " ixString" "" "\n"]
            VARIABLE ~${TYPE_ID_NM}Row ixRow
            VARIABLE stmt ixSQLStmt(DBObject::getConnection())

                        CALL stmt.prepare("SELECT ~[gen_col_list $sect $table KEYS_TYPE] " ||
                                "FROM ~[$table getUniqueName] " ||
                                "WHERE ~[gen_dyn_compare $sect $table \
                    KEYS_NO_TYPE "" "" " AND \" ||\n\""]")
                        ~[gen_setparamc_name $sect $table KEYS_NO_TYPE]
                        CALL stmt.execute()
                        LET ~${TYPE_ID_NM}Row = stmt.fetch()

            IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
                RETURN NULL
            END IF

            ~[set colnr 0
              $sect pushIndent
              foreach column [get_col_list $table KEYS_TYPE] {
                incr colnr
                $sect append "LET [$column getUniqueName] = ${TYPE_ID_NM}Row.getVal($colnr) CAST ixString\n"
              }
              $sect popIndent]
            RETURN findInDBByType(~[gen_col_list $sect $table KEYS])
        END FUNCTION

    }
}

proc db_class::gen_for_derived {class} {
    set class_nm [$class getName]
    set root_nm [[get_root_class $class] getName]
    set table [$class table]
    set sect $ne_sections(h_help_class_sect)
    if {$class_nm != $root_nm} {
        expand_text $sect {

        CLASS ~${class_nm}Instantiator DERIVED FROM\
                ~${root_nm}Instantiator
            FUNCTION instantiate(~[gen_param_decl_ne $sect \
                $table KEYS_NO_TYPE fwd]) RETURNING ~$root_nm
        END CLASS

        }
    } else {
        expand_text $sect {

        FORWARD ~$root_nm
        CLASS ~${class_nm}Instantiator
            FUNCTION instantiate(~[gen_param_decl_ne $sect \
                $table KEYS_NO_TYPE fwd]) RETURNING ~$root_nm
        END CLASS

        }
    }
    set sect $ne_sections(c_impl_no_regen_sect)
    expand_text $sect {
        FUNCTION ~${class_nm}Instantiator::instantiate(~[ \
            gen_param_decl_ne $sect $table KEYS_NO_TYPE inc])\
                RETURNING ~$root_nm
            RETURN ~$class_nm::instantiate(~[gen_col_list \
                $sect $table KEYS_NO_TYPE])
        END FUNCTION

    }
    set sect $ne_sections(h_pub_func_sect)
    expand_text $sect {
        SHARED FUNCTION instantiate(~[gen_param_decl_ne $sect \
            $table KEYS_NO_TYPE fwd]) RETURNING ~$root_nm
    }
    set sect $ne_sections(c_impl_no_regen_sect)
    global db_ctor_is_unique
    if $db_ctor_is_unique {
        set bykeys ""
    } else {
        set bykeys "ByKeys"
    }
    expand_text $sect {
        FUNCTION ~$class_nm::instantiate(~[gen_param_decl_ne $sect \
            $table KEYS_NO_TYPE inc]) RETURNING ~$root_nm
            VARIABLE tmp ~$class_nm = NEW~${class_nm}~${bykeys}(~[
                gen_col_list $sect $table KEYS_NO_TYPE])

            IF tmp IS NULL THEN
                RETURN NULL
            END IF
            IF tmp.readFromDB() < 0 THEN
                RETURN NULL
            END IF
            RETURN tmp
        END FUNCTION

    }
}

proc db_data_attrib_initial_value {attrib} {
    set sect $ne_sections(c_ctor_body_iv_sect)
    set attr_nm [$attrib getName]
    set iv [$attrib getPropertyValue initial_value]
    if {$iv == ""} {
        return
    }
    $sect append "CALL set[cap $attr_nm]($iv)\n"
}

proc db_data_attrib::generate {attrib class} {
    set attr_nm [$attrib getName]
    if {$attr_nm == $TYPE_ID_NM} {
        return
    }
    set col [$attrib column]
    set col_nr [get_column_nr $col]
    set class_nm [$class getName]
    set class_data [uncap $class_nm]Data
    set is_field [expr {[$col getColumnType] == "field"}]
        set obj_type [[$attrib ooplType] get_obj_type]
    set t_par [generate [$attrib ooplType] fwd]
    if {$t_par == "TEXT" || $t_par == "BYTE"} {
        set bytetext 1
    } else {
        set bytetext 0
    }
    set ixval [map_fgl2ixval ${t_par}]
    set sect [get_attrib_hdr_sect $attrib r]
    # put db_data_attrib free text
    # before the access funcs
    feature::gen_description $attrib $sect
    add_hdr_sys_inc_name [ixval2hdr $ixval]
    $sect append "FUNCTION get[cap $attr_nm]() RETURNING ${t_par}\n"
    $sect append "FUNCTION get[cap $attr_nm]Val()\
        RETURNING $ixval\n"

    set sect [get_attrib_hdr_sect $attrib w]
    if $is_field {
        if !$bytetext {
            $sect append \
            "FUNCTION set[cap $attr_nm](new[cap $attr_nm] ${t_par})\
                RETURNING VOID\n"
        }
        $sect append \
            "FUNCTION set[cap $attr_nm]Val(new[\
                cap $attr_nm] $ixval) RETURNING VOID\n"
    }
    set sect [get_attrib_src_sect $attrib r]
    expand_text $sect {
        FUNCTION ~$class_nm::get~[cap $attr_nm]() RETURNING ~${t_par}
            VARIABLE val ~$ixval = ~$class_data.getVal(~${col_nr})\
                CAST ~$ixval
            RETURN ~[getixvalvalue $ixval val]
        END FUNCTION

    }
    expand_text $sect {
        FUNCTION ~$class_nm::get~[cap $attr_nm]Val() RETURNING ~$ixval
            RETURN ~$class_data.getVal(~${col_nr}) CAST ~$ixval
        END FUNCTION

    }
    db_data_attrib_initial_value $attrib
    if {!$is_field} {
        return
    }
    set sect [get_attrib_src_sect $attrib w]
    if !$bytetext {
        expand_text $sect {
        FUNCTION ~$class_nm::set~[cap $attr_nm](new~[\
                cap $attr_nm] ~${t_par}) RETURNING VOID
            VARIABLE val ~$ixval = ~$class_data.getVal(~${col_nr})\
                CAST ~$ixval
            ~[setixvalvalue $ixval val new[cap $attr_nm]]
        END FUNCTION

        }
    }
    expand_text $sect {
        FUNCTION ~$class_nm::set~[cap $attr_nm]Val(new~[\
                cap $attr_nm] ~$ixval) RETURNING VOID
            VARIABLE oldVal ixValue =\
            ~$class_data.setVal(new~[cap $attr_nm], ~${col_nr})
        END FUNCTION

    }
}

proc db_assoc_attrib::generate {attrib class} {
    gen_for_db_assoc $attrib $class
}

proc db_assoc_attrib::one_set {attrib class} {
    set opp [$attrib opposite]
    if {$opp != "" && [$opp get_obj_type] == "db_qual_assoc_attrib"} {
        # Can't supply the key for a qualified assoc
        return
    }
    if {$opp != "" && [$opp isMandatory] &&
            [$opp getMultiplicity] == "one"} {
        return
    }
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set cl_name [$class getName]
    set sect [get_assoc_hdr_sect $attrib w]
    set access [get_access_mode [get_assoc_access $attrib] w]
    $sect append "${access}FUNCTION set${name}(new$name $type)\
            RETURNING INTEGER\n"
    set sect [get_assoc_src_sect $attrib w]
    $sect append "FUNCTION $cl_name::set${name}(new$name $type)\
            RETURNING INTEGER\n"
    set link [$attrib link]
    set table [$link detail]
    set tab_nm [$table getUniqueName]
    $sect indent +
    if {$table == [$class table]} {
        set master_data [uncap $cl_name]Data
        set detail_data [uncap $type]_data
    } else {
        set master_data [uncap $type]_data
        set detail_data [uncap $cl_name]Data
    }
    set param_nr 1
    expand_text $sect {
        VARIABLE stmt ixSQLStmt(getConnection())
        VARIABLE ~[uncap $type]_data ixRow = new~$name.~[uncap $type]Data

        CALL stmt.prepare("UPDATE ~$tab_nm " ||
            "SET ~[gen_dyn_compare_cl $sect $link] " ||
            "WHERE ~[gen_dyn_compare $sect $table \
                KEYS "" "" " AND \" ||\n\""]")
        ~[gen_setparam_cl $sect $link param_nr $detail_data
        ]~[gen_setparamc $sect $table param_nr KEYS $master_data ]
        CALL stmt.execute()
        IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
            RETURN -1
        END IF
        RETURN 0
    }
    $sect indent -
    $sect append "END FUNCTION\n\n"
}

proc db_assoc_attrib::one_remove {attrib class} {
    if [$attrib isMandatory] {
        return
    }
    set opp [$attrib opposite]
    if {$opp != "" && [$opp get_obj_type] == "db_qual_assoc_attrib"} {
        return
    }
    if {$opp != "" && [$opp isMandatory] &&
            [$opp getMultiplicity] == "one"} {
        return
    }
    set name [cap [$attrib getName]]
    set cl_name [$class getName]
    set class_data [uncap $cl_name]Data
    set sect [get_assoc_hdr_sect $attrib w]
    set access [get_access_mode [get_assoc_access $attrib] w]
    $sect append "${access}FUNCTION remove${name}()\
        RETURNING INTEGER\n"
    set sect [get_assoc_src_sect $attrib w]
    $sect append "FUNCTION $cl_name::remove${name}()\
        RETURNING INTEGER\n"
    $sect indent +
    set link [$attrib link]
    set table [$link detail]
    expand_text $sect {
        VARIABLE stmt ixSQLStmt(getConnection())

        CALL stmt.prepare("UPDATE ~[$table getUniqueName] " ||
            "SET ~[gen_col_listl $sect $link "" " = NULL"] " ||
            "WHERE }
    set param_nr 1
    if {$table == [$class table]} {
        gen_dyn_compare $sect $table KEYS "" "" " AND \" ||\n\""
        $sect append "\")\n"
        gen_setparamc $sect $table param_nr KEYS $class_data
    } else {
        gen_dyn_compare_cl $sect $link "" "" " AND \" ||\n\""
        $sect append "\")\n"
        gen_setparam_cl $sect $link param_nr $class_data
    }
    expand_text $sect {
        CALL stmt.execute()
        IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
            RETURN -1
        END IF
        RETURN 0
    }
    $sect indent -
    $sect append "END FUNCTION\n\n"
}

proc db_assoc_attrib::one_get {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set cl_name [$class getName]
    set class_data [uncap $cl_name]Data
    set sect $ne_sections(h_pub_func_sect)
    $sect append "PUBLIC FUNCTION get${name}() RETURNING $type\n"
    set sect $ne_sections(c_impl_no_regen_sect)
    $sect append "FUNCTION $cl_name::get${name}() RETURNING $type\n"
    $sect indent +
    set link [$attrib link]
    set opp_link [$attrib oppositeLink]
    set table [$link detail]
    set tab_nm [$table getUniqueName]
    set my_row_nm [[$class table] getUniqueName]Row
    set param_nr 1
    if {$link != $opp_link} {
        # opposite side of qual assoc
        expand_text $sect {
            VARIABLE stmt ixSQLStmt(getConnection())
            VARIABLE ~${tab_nm}_datai ixRow

            CALL stmt.prepare("SELECT ~[gen_col_listl $sect\
                $opp_link] " ||
                "FROM ~$tab_nm " ||
                "WHERE ~[gen_dyn_compare_cl $sect $link "" "" \
                    " AND \" ||\n\""]")
            ~[gen_setparam_cl $sect $link param_nr $class_data]

            CALL stmt.execute()
                        LET ~${tab_nm}_datai = stmt.fetch()
            IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
                RETURN NULL
            END IF
            RETURN ~$type::findInDBByType(~[gen_rowgetvalinc_l \
                $sect $opp_link ${tab_nm}_datai "" ",\n"])
                CAST ~$type
        }
        $sect indent -
        $sect append "END FUNCTION\n\n"
        return
    }
    if {$table == [$class table]} {
        expand_text $sect {
            VARIABLE val ixValue

            ~[gen_null_check $sect $link $class_data NULL]
            RETURN ~$type::findInDBByType(~[gen_rowgetval_l $sect \
                    $link $class_data "" ",\n"])
                CAST ~$type
        }
    } else {
        expand_text $sect {
            VARIABLE stmt ixSQLStmt(getConnection())
            VARIABLE ~${tab_nm}_datai ixRow
            VARIABLE val ixValue

            CALL stmt.prepare("SELECT ~[
                gen_col_list $sect $table KEYS] " ||
                "FROM ~$tab_nm " ||
                "WHERE ~[gen_dyn_compare_cl $sect $link "" "" \
                    " AND \" ||\n\""]")
            ~[gen_setparam_cl $sect $link param_nr $class_data]

            CALL stmt.execute()
            LET ~${tab_nm}_datai = stmt.fetch()
            IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
                RETURN NULL
            END IF
            ~[gen_null_check $sect $table ${tab_nm}_datai NULL]
            RETURN ~$type::findInDBByType(~[gen_rowgetvalinc $sect \
                    $table KEYS ${tab_nm}_datai "" ",\n"])
                CAST ~$type
        }
    }
    $sect indent -
    $sect append "END FUNCTION\n\n"
}

proc db_assoc_attrib::many_set {attrib class} {
    if {[set opp [$attrib opposite]] != "" &&
        [$opp get_obj_type] == "db_qual_assoc_attrib"} {
        # Can't supply the key for a qualified assoc
        return
    }
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set cl_name [$class getName]
    set class_data [uncap $cl_name]Data
    set sect [get_assoc_hdr_sect $attrib w]
    set access [get_access_mode [get_assoc_access $attrib] w]
    $sect append "${access}FUNCTION add${name}(new$name $type)\
            RETURNING INTEGER\n"
    set my_tab [$class table]
    set my_tab_nm [$my_tab getUniqueName]
    set link [$attrib link]
    set opp_link [$attrib oppositeLink]
    set dt_tab [$link detail]
    set dt_tab_nm [$dt_tab getUniqueName]
    set sect [get_assoc_src_sect $attrib w]
    set param_nr 1
    if {$link == $opp_link} {
        expand_text $sect {
        FUNCTION ~$cl_name::add~${name}(new~$name ~$type)\
                RETURNING INTEGER
            VARIABLE stmt ixSQLStmt(getConnection())
            VARIABLE ~${dt_tab_nm}_data ixRow =\
                new~$name.~[uncap $type]Data

            CALL stmt.prepare("UPDATE ~$dt_tab_nm " ||
                "SET ~[gen_dyn_compare_cl $sect $link] " ||
                "WHERE ~[gen_dyn_compare $sect $dt_tab KEYS \
                    "" "" " AND \" ||\n\""]")
            ~[gen_setparam_cl $sect $link param_nr $class_data]
            ~[gen_setparamc $sect $dt_tab param_nr KEYS ${dt_tab_nm}_data]
            CALL stmt.execute()

            IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
                RETURN -1
            END IF
            RETURN 0
        END FUNCTION

        }
    } else {
        set op_tab [$opp_link master]
        set op_tab_nm [$op_tab getUniqueName]
        expand_text $sect {
        FUNCTION ~$cl_name::add~${name}(new~$name ~$type)\
                RETURNING INTEGER
            VARIABLE stmt ixSQLStmt(getConnection())
            VARIABLE ~${op_tab_nm}_data ixRow =\
                new~$name.~[uncap $type]Data

            CALL stmt.prepare("EXECUTE PROCEDURE \
                    pins_~${dt_tab_nm}(" ||
                "~[gen_dyn_compare_cl $sect $link p_ "" \
                    ", \" ||\n\""], " ||
                "~[gen_dyn_compare_cl $sect $opp_link p_ "" \
                    ", \" ||\n\""])")
            ~[gen_setparam_cl $sect $link param_nr $class_data]
            ~[gen_setparam_cl $sect $opp_link param_nr \
                ${op_tab_nm}_data]
            CALL stmt.execute()

            IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
                RETURN -1
            END IF
            RETURN 0
        END FUNCTION

        }
    }
}

proc db_assoc_attrib::many_remove {attrib class} {
    if {[set opp [$attrib opposite]] != "" &&
        [$opp get_obj_type] == "db_qual_assoc_attrib"} {
        return
    }
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set sect [get_assoc_hdr_sect $attrib w]
    set access [get_access_mode [get_assoc_access $attrib] w]
    $sect append "${access}FUNCTION remove${name}(old${name} $type)\
            RETURNING INTEGER\n"
    set cl_name [$class getName]
    set class_data [uncap $cl_name]Data
    set my_tab_nm [[$class table] getUniqueName]
    set link [$attrib link]
    set opp_link [$attrib oppositeLink]
    set dt_tab [$link detail]
    set dt_tab_nm [$dt_tab getUniqueName]
    set sect [get_assoc_src_sect $attrib w]
    set param_nr 1
    if {$link == $opp_link} {
        expand_text $sect {
        FUNCTION ~$cl_name::remove~${name}(old~${name} ~$type)\
                RETURNING INTEGER
            VARIABLE stmt ixSQLStmt(getConnection())
            VARIABLE ~${dt_tab_nm}_data ixRow =\
                old~${name}.~[uncap $type]Data

            CALL stmt.prepare("UPDATE ~$dt_tab_nm " ||
                "SET ~[gen_col_listl $sect $link ""\
                    " = NULL"] " ||
                "WHERE ~[gen_dyn_compare $sect $dt_tab KEYS \
                    "" "" " AND \" ||\n\""]")
            ~[gen_setparamc $sect $dt_tab param_nr KEYS \
                ${dt_tab_nm}_data]
            CALL stmt.execute()

            IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
                RETURN -1
            END IF
            RETURN 0
        END FUNCTION

        }
    } else {
        set op_tab_nm [[$opp_link master] getUniqueName]
        expand_text $sect {
        FUNCTION ~$cl_name::remove~${name}(old~${name} ~$type)\
                RETURNING INTEGER
            VARIABLE stmt ixSQLStmt(getConnection())
            VARIABLE ~${op_tab_nm}_data ixRow =\
                old~${name}.~[uncap $type]Data

            CALL stmt.prepare("EXECUTE PROCEDURE \
                    pdel_~${dt_tab_nm}(" ||
                "~[gen_dyn_compare_cl $sect $link p_ "" \
                    ", \" ||\n\""], " ||
                "~[gen_dyn_compare_cl $sect $opp_link p_ "" \
                    ", \" ||\n\""])")
            ~[gen_setparam_cl $sect $link param_nr $class_data]
            ~[gen_setparam_cl $sect $opp_link param_nr \
                ${op_tab_nm}_data]
            CALL stmt.execute()

            IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
                RETURN -1
            END IF
            RETURN 0
        END FUNCTION

        }
    }
}

# "template" for get function of the one side of a one-many assoc
#
global db_assoc_attrib_one_many_get
set db_assoc_attrib_one_many_get {
    FUNCTION ~$class_nm::get~${name_of_set}(~${name_of_set} ~$type_of_set)\
            RETURNING INTEGER
        VARIABLE stmt ixSQLStmt(getConnection())
        VARIABLE ~${dt_tab_nm}_datai ixRow
        VARIABLE ~${type}Ref ~$type
        VARIABLE addOk INTEGER

        CALL stmt.prepare("SELECT ~[
                gen_col_list $sect $dt_table KEYS] " ||
            "FROM ~$dt_tab_nm " ||
              "WHERE ~[gen_dyn_compare_cl $sect $link \
                "" "" " AND \" ||\n\""]")
        ~[gen_setparam_cl $sect $link param_nr $class_data]
        CALL stmt.execute()

        LET ~${dt_tab_nm}_datai = stmt.fetch()
        WHILE stmt.getODBCErrorCode() == stmt.SQL_Success
            LET ~${type}Ref = ~$type::findInDBByType(~[
                    gen_rowgetvalinc $sect $dt_table KEYS \
                    ${dt_tab_nm}_datai "" ",\n"])
                CAST ~$type
            IF ~${type}Ref IS NOT NULL THEN
                LET addOk = ~$name_of_set.~${add_func}(~${type}Ref)
            END IF
            LET ~${dt_tab_nm}_datai = stmt.fetch()
        END WHILE
        CALL stmt.free(stmt.SQL_Close)

        IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
            RETURN -1
        END IF
        RETURN 0
    END FUNCTION

}

# "template" for get function of a many-many assoc
#
global db_assoc_attrib_many_many_get
set db_assoc_attrib_many_many_get {
    FUNCTION ~$class_nm::get~${name_of_set}(~${name_of_set} ~$type_of_set)\
            RETURNING INTEGER
        VARIABLE stmt ixSQLStmt(getConnection())
        VARIABLE ~${dt_tab_nm}_datai ixRow
        VARIABLE ~${type}Ref ~$type
        VARIABLE addOk INTEGER

        CALL stmt.prepare("SELECT ~[
                gen_col_listl $sect $opp_link] " ||
            "FROM ~$dt_tab_nm " ||
            "WHERE ~[gen_dyn_compare_cl $sect $link \
                "" "" " AND \" ||\n\""]")
        ~[gen_setparam_cl $sect $link param_nr $class_data]
        CALL stmt.execute()

        LET ~${dt_tab_nm}_datai = stmt.fetch()
        WHILE stmt.getODBCErrorCode() == stmt.SQL_Success
            LET ~${type}Ref = ~$type::findInDBByType(~[
                    gen_rowgetvalinc_l $sect $opp_link \
                    ${dt_tab_nm}_datai "" ",\n"])
                CAST ~$type
            IF ~${type}Ref IS NOT NULL THEN
                LET addOk = ~$name_of_set.~${add_func}(~${type}Ref)
            END IF
            LET ~${dt_tab_nm}_datai = stmt.fetch()
        END WHILE
        CALL stmt.free(stmt.SQL_Close)

        IF stmt.getODBCErrorCode() != stmt.SQL_Success THEN
            RETURN -1
        END IF
        RETURN 0
    END FUNCTION
}

proc db_assoc_attrib::many_get {attrib class} {
    set setpfx [set_prefix $attrib]
    set type [[$attrib ooplType] getName]
    set type_of_set [${setpfx}set_type_name [$attrib ooplType]]
    set name [$attrib getName]
    set name_of_set [cap [${setpfx}set_name $name]]
    set add_func [set ${setpfx}set::add]
    set class_nm [$class getName]
    set class_data [uncap $class_nm]Data
    set sect $ne_sections(h_pub_func_sect)
    $sect append "PUBLIC FUNCTION get${name_of_set}(${name_of_set} $type_of_set) RETURNING INTEGER\n"
    set tab_nm [[$class table] getUniqueName]
    set link [$attrib link]
    set opp_link [$attrib oppositeLink]
    set dt_table [$link detail]
    set dt_tab_nm [$dt_table getUniqueName]
    set sect $ne_sections(c_impl_no_regen_sect)
    set param_nr 1
    if {$link == $opp_link} {
        expand_text $sect $db_assoc_attrib_one_many_get
    } else {
        expand_text $sect $db_assoc_attrib_many_many_get
    }
}

proc db_assoc_attrib::gen_initializer {attrib init decl_s body_s class} {
    set name [$init getName]
    set type_nm [[$attrib ooplType] getName]
    set class_data [uncap [$class getName]]Data
    gen_assign_cl $body_s [$attrib link] $class_data ""\
        $name.[uncap $type_nm]Data ""
}

proc db_link_class::gen_class_decl {class} {
    db_class::gen_class_decl $class
}