home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1998 October
/
PCWorld_1998-10_cd.bin
/
software
/
prehled
/
komix
/
DATA.Z
/
gen_db_fnc.tcl
< prev
next >
Wrap
Text File
|
1997-06-12
|
51KB
|
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
}