.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 2000-2005 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VAK12$
.tt 2 $$$
.TT 3 $ThomasA$AK_Domain$$$$2000-08-29$
***********************************************************
.nf
 
 .nf

    ========== licence begin  GPL
    Copyright (c) 2000-2005 SAP AG

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
.fo

 
.fo
.nf
.sp
MODULE  : AK_Domain
=========
.sp
Purpose : Implementation of CREATE and DROP DOMAIN.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              a12create_dbproc (VAR acv : tak_all_command_glob;
                    start_node    : integer;
                    VAR dbproc_id : tgg00_Surrogate);
 
        PROCEDURE
              a12_call_semantic  (VAR acv : tak_all_command_glob);
 
        PROCEDURE
              a12CreateFileInfoRecord (
                    VAR acv               : tak_all_command_glob;
                    VAR dbproc_id         : tgg00_Surrogate;
                    VAR libraryPathBuffer : tak_method_filename;
                    VAR MD5_footprint     : tsp00_C32);
 
        PROCEDURE
              a12drop_domain (VAR acv : tak_all_command_glob;
                    domain_ref : tak_sysbufferaddress);
 
        FUNCTION
              a12dbfunc_exist (VAR acv : tak_all_command_glob;
                    VAR owner       : tsp00_KnlIdentifier;
                    VAR dbfunc_name : tsp00_KnlIdentifier;
                    dstate          : tak_directory_state;
                    VAR method_buf  : tak_sysbufferaddress) : boolean;
 
        FUNCTION
              a12dbproc_exist (VAR acv : tak_all_command_glob;
                    VAR owner      : tsp00_KnlIdentifier;
                    VAR dbproc     : tsp00_KnlIdentifier;
                    dstate         : tak_directory_state;
                    VAR method_buf : tak_sysbufferaddress) : boolean;
 
        PROCEDURE
              a12describe_param  (VAR acv : tak_all_command_glob;
                    method_buf   : tak_sysbufferaddress;
                    param_no     : integer;
                    VAR colinf   : tak00_scolinf);
 
        FUNCTION
              a12exist_type (VAR acv : tak_all_command_glob;
                    VAR tree_node : integer;
                    VAR owner     : tsp00_KnlIdentifier;
                    VAR type_name : tsp00_KnlIdentifier;
                    VAR type_buf  : tak_sysbufferaddress) : boolean;
 
        PROCEDURE
              a12FindParameter(VAR acv : tak_all_command_glob;
                    VAR ownerid : tgg00_Surrogate;
                    VAR dbproc  : tsp00_KnlIdentifier;
                    paramNo     : integer;
                    VAR pInfo   : tak_param_info_ptr);
 
        FUNCTION
              a12EvalDataLength (VAR acv : tak_all_command_glob;
                    p : tak_sysbufferaddress) : integer;
 
        PROCEDURE
              a12get_domain (VAR acv : tak_all_command_glob;
                    VAR owner       : tsp00_KnlIdentifier;
                    VAR domain_name : tsp00_KnlIdentifier;
                    ti              : integer;
                    VAR domain_ref  : tak_sysbufferaddress;
                    VAR domain_def  : tak_sysbufferaddress);
 
        PROCEDURE
              a12InitParamInfoRec (VAR acv : tak_all_command_glob;
                    VAR funcId : tgg00_Surrogate;
                    paramCnt   : integer;
                    VAR p      : tak_sysbufferaddress);
 
        PROCEDURE
              a12LoadFileInfo (
                    VAR acv               : tak_all_command_glob;
                    VAR dbproc_id         : tgg00_Surrogate;
                    VAR pFileName         : tsp00_Addr;
                    VAR MD5_footprint     : tsp00_C32);
 
        FUNCTION
              a12method_exist (VAR acv : tak_all_command_glob;
                    VAR type_id     : tgg00_Surrogate;
                    VAR method_name : tsp00_KnlIdentifier;
                    dstate          : tak_directory_state;
                    VAR method_buf  : tak_sysbufferaddress) : boolean;
 
        PROCEDURE
              a12NewMethod (VAR acv : tak_all_command_glob;
                    VAR OwnerId     : tgg00_Surrogate;
                    VAR DBFuncName  : tsp00_KnlIdentifier;
                    VAR MethodName  : tsp00_KnlIdentifier;
                    ErrorPos        : tsp00_Int4;
                    VAR IsReplace   : boolean;
                    MethodType      : tsp00_DbObjectType;
                    ProgId          : tsp00_C64;
                    VAR language    : tsp00_KnlIdentifier;
                    VAR methodbuf   : tak_sysbufferaddress);
 
        PROCEDURE
              a12output_parameter (VAR acv : tak_all_command_glob;
                    method_buf     : tak_sysbufferaddress;
                    VAR inout_idx  : integer;
                    VAR colinf     : tak00_scolinf);
 
        PROCEDURE
              a12read_domain_ref (VAR acv : tak_all_command_glob;
                    VAR owner_id    : tgg00_Surrogate;
                    VAR domain_name : tsp00_KnlIdentifier;
                    VAR domain_ref  : tak_sysbufferaddress);
 
        PROCEDURE
              a12reference (VAR acv : tak_all_command_glob;
                    VAR dbproc_surrogate : tgg00_Surrogate;
                    VAR owner            : tsp00_KnlIdentifier;
                    VAR dbproc_name      : tsp00_KnlIdentifier);
 
        PROCEDURE
              a12StoreParamInfo (VAR acv : tak_all_command_glob;
                    p              : tak_sysbufferaddress;
                    VAR param_info : tak00_scolinf);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              AK_Table  : VAK11;
 
        PROCEDURE
              a11condition (VAR acv : tak_all_command_glob;
                    VAR a11v          : tak_a11_glob;
                    constraint_id     : integer;
                    end_pos           : tsp00_Int4);
 
        PROCEDURE
              a11drop_table  (VAR acv : tak_all_command_glob;
                    VAR tableid   : tgg00_Surrogate;
                    tablkind      : tgg00_TableKind;
                    succ_filevers : boolean);
 
        PROCEDURE
              a11end_create_table (VAR acv : tak_all_command_glob;
                    VAR a11v : tak_a11_glob);
 
        PROCEDURE
              a11one_column_def  (VAR acv : tak_all_command_glob;
                    VAR a11v : tak_a11_glob);
 
        PROCEDURE
              a11put_date_time (VAR date : tsp00_Int4;
                    VAR time : tsp00_Int4);
 
        PROCEDURE
              a11init_baserecord (VAR acv : tak_all_command_glob;
                    VAR a11v     : tak_a11_glob);
 
        PROCEDURE
              a11glob_init (VAR acv : tak_all_command_glob;
                    VAR a11v : tak_a11_glob);
 
      ------------------------------ 
 
        FROM
              Systeminfo_cache  : VAK10;
 
        PROCEDURE
              a10_add_repl_sysinfo (VAR acv : tak_all_command_glob;
                    VAR syspoint : tak_sysbufferaddress;
                    add_sysinfo  : boolean;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10_cache_delete (VAR acv : tak_all_command_glob;
                    is_rollback : boolean);
 
        PROCEDURE
              a10_del_tab_sysinfo  (VAR acv : tak_all_command_glob;
                    VAR tableid : tgg00_Surrogate;
                    VAR qual    : tak_del_tab_qual;
                    temp_table  : boolean;
                    VAR b_err   : tgg00_BasisError);
 
        PROCEDURE
              a10_fix_len_get_sysinfo (VAR acv : tak_all_command_glob;
                    VAR syskey   : tgg00_SysInfoKey;
                    dstate       : tak_directory_state;
                    required_len : integer;
                    plus         : integer;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10key_del  (VAR acv : tak_all_command_glob;
                    VAR syspoint : tak_sysbufferaddress);
 
        PROCEDURE
              a10mblock_into_cache (VAR acv : tak_all_command_glob;
                    VAR syskey   : tgg00_SysInfoKey;
                    VAR mblock   : tgg00_MessBlock;
                    dstate       : tak_directory_state;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10new (VAR acv : tak_all_command_glob;
                    obj_size : tsp00_Int4;
                    VAR p    : tak_param_info_ptr);
 
        PROCEDURE
              a10next_sysinfo (VAR acv : tak_all_command_glob;
                    VAR syskey   : tgg00_SysInfoKey;
                    stop_prefix  : integer;
                    dstate       : tak_directory_state;
                    rec_kind     : tsp00_C2;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10_nil_get_sysinfo (VAR acv : tak_all_command_glob;
                    VAR syskey   : tgg00_SysInfoKey;
                    dstate       : tak_directory_state;
                    syslen       : tsp00_Int2;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10add_sysinfo (VAR acv : tak_all_command_glob;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10del_sysinfo (VAR acv : tak_all_command_glob;
                    VAR syskey   : tgg00_SysInfoKey;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10get_sysinfo (VAR acv : tak_all_command_glob;
                    VAR syskey   : tgg00_SysInfoKey;
                    dstate       : tak_directory_state;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10rel_sysinfo (syspointer : tak_sysbufferaddress);
 
        PROCEDURE
              a10repl_sysinfo (VAR acv : tak_all_command_glob;
                    VAR syspoint : tak_sysbufferaddress;
                    VAR b_err    : tgg00_BasisError);
 
        PROCEDURE
              a10_version (VAR acv : tak_all_command_glob;
                    VAR base_rec   : tak_baserecord;
                    m_type         : tgg00_MessType;
                    view_scan      : boolean);
 
      ------------------------------ 
 
        FROM
              AK_universal_semantic_tools : VAK06;
 
        PROCEDURE
              a06determine_username (VAR acv : tak_all_command_glob;
                    VAR userid    : tgg00_Surrogate;
                    VAR user_name : tsp00_KnlIdentifier);
 
        PROCEDURE
              a06det_user_id (VAR acv : tak_all_command_glob;
                    VAR authname : tsp00_KnlIdentifier;
                    VAR authid   : tgg00_Surrogate);
 
        PROCEDURE
              a06get_username (VAR acv : tak_all_command_glob;
                    VAR tree_index : integer;
                    VAR username   : tsp00_KnlIdentifier);
 
        PROCEDURE
              a06inc_linkage (VAR linkage : tsp00_C2);
 
        PROCEDURE
              a06_systable_get (VAR acv : tak_all_command_glob;
                    dstate        : tak_directory_state;
                    VAR tableid   : tgg00_Surrogate;
                    VAR base_ptr  : tak_sysbufferaddress;
                    get_all       : boolean;
                    VAR ok        : boolean);
 
      ------------------------------ 
 
        FROM
              AK_Identifier_Handling : VAK061;
 
        PROCEDURE
              a061assign_colname (value : tsp00_C18;
                    VAR colname : tsp00_KnlIdentifier);
 
        PROCEDURE
              a061app_columnname (VAR acv : tak_all_command_glob;
                    VAR base_rec          : tak_baserecord;
                    VAR column            : tsp00_KnlIdentifier;
                    VAR index             : integer);
 
        PROCEDURE
              a061colinfo_to_var (VAR src : tak00_columninfo;
                    VAR dst : tak00_columninfo);
 
        FUNCTION
              a061identifier_len (VAR id : tsp00_KnlIdentifier) : integer;
 
      ------------------------------ 
 
        FROM
              AK_semantic_scanner_tools : VAK05;
 
        PROCEDURE
              a05identifier_get (VAR acv : tak_all_command_glob;
                    tree_index  : integer;
                    obj_len     : integer;
                    VAR moveobj : tsp00_KnlIdentifier);
 
        PROCEDURE
              a05_li_constant_get (VAR acv : tak_all_command_glob;
                    ni               : integer;
                    VAR colinfo      : tak00_columninfo;
                    orig_len         : integer;
                    mv_dest          : integer;
                    VAR dest         : tak_default_value; (* PTS 1108428 *)
                    destpos          : integer;
                    VAR actlen       : integer);
 
        PROCEDURE
              a05_string_literal_get (VAR acv : tak_all_command_glob;
                    tree_index  : integer;
                    datatyp     : tsp00_DataType;
                    obj_len     : integer;
                    VAR moveobj : tsp00_MoveObj);
 
        PROCEDURE
              a05surrogate_get (VAR acv : tak_all_command_glob;
                    VAR surrogate  : tgg00_Surrogate);
 
      ------------------------------ 
 
        FROM
              Scanner : VAK01;
 
        VAR
              a01char_size         : integer;
              a01defaultkey        : tgg00_SysInfoKey;
              a01_il_b_identifier  : tsp00_KnlIdentifier;
              a01_i_temp           : tsp00_KnlIdentifier;
 
      ------------------------------ 
 
        FROM
              AK_View_semantic : VAK16;
 
        PROCEDURE
              a16put_usage_def  (VAR acv : tak_all_command_glob;
                    VAR put_tableid    : tgg00_Surrogate;
                    VAR using_tableid  : tgg00_Surrogate;
                    using_tablekind    : tgg00_TableKind);
 
      ------------------------------ 
 
        FROM
              AK_Stored_Procedure_DDL : VAK261;
 
        PROCEDURE
              a261drop_procedure (VAR acv : tak_all_command_glob;
                    VAR procbuf  : tak_sysbufferaddress;
                    VAR owner_id : tgg00_Surrogate);
 
      ------------------------------ 
 
        FROM
              AK_Trigger : VAK262;
 
        PROCEDURE
              a262Call (VAR acv : tak_all_command_glob;
                    p      : tak_sysbufferaddress;
                    data_p : tsp00_MoveObjPtr);
 
        PROCEDURE
              a262compile (VAR acv : tak_all_command_glob;
                    tree_index : integer);
 
      ------------------------------ 
 
        FROM
              Stream_Handle_Functions : VAK263;
 
        FUNCTION
              ak263EvalHandleLength (ColCount : tsp00_Int4) : tsp00_Int4;
 
      ------------------------------ 
 
        FROM
              AK_data_dictionary : VAK38;
 
        PROCEDURE
              a38domain_drop (VAR acv : tak_all_command_glob;
                    VAR owner      : tsp00_KnlIdentifier;
                    VAR domainname : tsp00_KnlIdentifier);
 
      ------------------------------ 
 
        FROM
              AK_Connect : VAK51;
 
        PROCEDURE
              a51build_userkey (VAR user_name : tsp00_KnlIdentifier;
                    VAR userkey : tgg00_SysInfoKey);
 
      ------------------------------ 
 
        FROM
              AK_Lock_Commit_Rollback : VAK52;
 
        PROCEDURE
              a52_ex_commit_rollback (VAR acv : tak_all_command_glob;
                    m_type         : tgg00_MessType;
                    n_rel          : boolean;
                    normal_release : boolean);
 
      ------------------------------ 
 
        FROM
              GG_edit_routines : VGG17;
 
        PROCEDURE
              g17int4to_line (int : tsp00_Int4;
                    with_zero : boolean;
                    int_len   : integer;
                    ln_pos    : integer;
                    VAR ln    : tsp00_C40);
 
      ------------------------------ 
 
        FROM
              AK_error_handling : VAK07;
 
        PROCEDURE
              a07ak_system_error (
                    VAR acv  : tak_all_command_glob;
                    modul_no : integer;
                    id       : integer);
 
        PROCEDURE
              a07_b_put_error (VAR acv : tak_all_command_glob;
                    b_err : tgg00_BasisError;
                    err_code : tsp00_Int4);
 
        PROCEDURE
              a07_const_b_put_error (VAR acv : tak_all_command_glob;
                    b_err      : tgg00_BasisError;
                    err_code   : tsp00_Int4;
                    param_addr : tsp00_MoveObjPtr;
                    const_len  : integer);
 
        PROCEDURE
              a07_kw_put_error (VAR acv : tak_all_command_glob;
                    b_err    : tgg00_BasisError;
                    err_code : tsp00_Int4;
                    kw       : integer);
 
        PROCEDURE
              a07_nb_put_error (VAR acv : tak_all_command_glob;
                    b_err    : tgg00_BasisError;
                    err_code : tsp00_Int4;
                    VAR n    : tsp00_KnlIdentifier);
 
        PROCEDURE
              a07_uni_error (VAR acv : tak_all_command_glob;
                    uni_err  : tsp8_uni_error;
                    err_code : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              AK_dialog_tools : VAK260;
 
        PROCEDURE
              a260hresult_error (hresult : tsp00_Int4;
                    VAR dbproc_name : tsp00_KnlIdentifier;
                    VAR errtext     : tsp00_C64;
                    VAR e           : tgg00_BasisError);
 
        FUNCTION
              a260IsInternalDBProc (VAR MethodRec : tak_methodrecord) : boolean;
 
        FUNCTION
              a260max_output_params : integer;
 
        FUNCTION
              a260max_params : integer;
 
        FUNCTION
              a260sql_in_dbproc (VAR acv : tak_all_command_glob;
                    VAR clsid          : tsp00_C16;
                    VAR packageId      : tgg00_Surrogate) : boolean;
 
      ------------------------------ 
 
        FROM
              RTE_kernel : VEN101;
 
        PROCEDURE
              vdcom_paraminfo ( VAR param_info : tsp_dcom_paraminfo_parms );
 
        PROCEDURE
              vdcom_invalidate (VAR cip : tsp_dcom_co_create_instance_parms);
 
      ------------------------------ 
 
        FROM
              Packet_handling : VSP26;
 
        PROCEDURE
              s26find_part (VAR segm : tsp1_segment;
                    part_kind        : tsp1_part_kind;
                    VAR part_ptr     : tsp1_part_ptr);
 
      ------------------------------ 
 
        FROM
              Configuration_Parameter : VGG01;
 
        VAR
              g01glob           : tgg00_KernelGlobals;
              g01unicode        : boolean;
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalFill (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    obj_upb     : tsp00_Int4;
                    obj         : tsp00_MoveObjPtr;
                    obj_pos     : tsp00_Int4;
                    length      : tsp00_Int4;
                    fillchar    : char;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              SAPDB_PascalMove (
                    mod_id   : tsp00_C6;
                    mod_num  : tsp00_Int4;
                    src_upb  : tsp00_Int4;
                    dest_upb : tsp00_Int4;
                    src      : tsp00_MoveObjPtr;
                    src_pos  : tsp00_Int4;
                    dest     : tsp00_MoveObjPtr;
                    dest_pos : tsp00_Int4;
                    length   : tsp00_Int4;
                    VAR err  : tgg00_BasisError);
 
        PROCEDURE
              g10mv (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              GET-Conversions : VSP40;
 
        PROCEDURE
              s40glint (
                    VAR buf  : tsp00_MoveObj;
                    pos      : tsp00_Int4;
                    len      : integer;
                    VAR dest : tsp00_Int4;
                    VAR res  : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              PUT-Conversions : VSP41;
 
        PROCEDURE
              s41plint (
                    VAR buf : tsp00_MoveObj;
                    pos     : tsp00_Int4;
                    len     : integer;
                    frac    : integer;
                    source  : tsp00_Int4;
                    VAR res : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-80 : VSP80;
 
        PROCEDURE
              s80uni_trans
                    (src_ptr        : tsp00_MoveObjPtr;
                    src_len         : tsp00_Int4;
                    src_codeset     : tsp00_Int2;
                    dest_ptr        : tsp00_MoveObjPtr;
                    VAR dest_len    : tsp00_Int4;
                    dest_codeset    : tsp00_Int2;
                    trans_options   : tsp8_uni_opt_set;
                    VAR rc          : tsp8_uni_error;
                    VAR err_char_no : tsp00_Int4);
&       ifdef trace
 
      ------------------------------ 
 
        FROM
              Test_Procedures  : VTA01;
 
        PROCEDURE
              t01int4 (debug : tgg00_Debug;
                    nam      : tsp00_Sname;
                    int      : tsp00_Int4);
 
        PROCEDURE
              t01moveobj (layer : tgg00_Debug;
                    VAR buf  : tsp00_MoveObj;
                    startpos : tsp00_Int4;
                    endpos   : tsp00_Int4);
&       endif
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              a05identifier_get;
 
              tsp00_MoveObj  tsp00_KnlIdentifier
 
        PROCEDURE
              a05_li_constant_get;
 
              tsp00_MoveObj tak_default_value (* PTS 1108428 *)
 
        PROCEDURE
              a10new;
 
              tak_sysbufferaddress tak_param_info_ptr
 
        PROCEDURE
              g17int4to_line;
 
              tsp00_Line tsp00_C40;
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : ThomasA
.sp
.cp 3
Created : 1985-01-25
.sp
.cp 3
.sp
.cp 3
Release :      Date : 2000-08-29
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
PROCEDURE  A12_CALL_SEMANTIC:
.sp
The procedure serves as a distributor for the commands
create and drop domain.
Domains may be created and deleted only by the Superdba and DBAs.
The key of
the catalog record of the domain is created already in a1sysk.
Depending on the syntax tree,
.nf
.sp
       create_domain (acv, a11v)   or
       drop_domain   (acv, a11v)   is called.
.fo
.sp 4
PROCEDURE  CREATE_DOMAIN:
.sp
The procedure ensures the construction of the catalog information of a
domain. This information comprises
.sp
1. a catalog record of type tdomainrecord containing the description
of the domain.
.sp
2. an associated catalog record of type tvaluesrecord
if range and/or default have been specified.
.sp 4
.cp 6
PROCEDURE  DROP_DOMAIN :
.sp
The procedure deletes the description of a domain from the
catalog information. This comprises the catalog record of
type tdomainrecord and, if applicable, a
record of type tvaluesrecord.
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
CONST
      cak12_param_io_length = 7;
      c_with_commit         = true;
      c_is_rollback         = true;
 
 
(*------------------------------*) 
 
PROCEDURE
      a12create_dbproc (VAR acv : tak_all_command_glob;
            start_node    : integer;
            VAR dbproc_id : tgg00_Surrogate);
 
VAR
      a11v       : tak_a11_glob;
 
BEGIN
&ifdef trace
t01int4 (ak_sem, 'start_node  ', start_node);
&endif
a11glob_init (acv, a11v);
a11v.a1ti := acv.a_ap_tree^[start_node].n_lo_level;
ak12create_dbproc (acv, a11v, start_node,
      acv.a_ap_tree^[start_node].n_pos,
      acv.a_ap_tree^[start_node].n_length,
      dbproc_id)
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12CreateFileInfoRecord (
            VAR acv               : tak_all_command_glob;
            VAR dbproc_id         : tgg00_Surrogate;
            VAR libraryPathBuffer : tak_method_filename;
            VAR MD5_footprint     : tsp00_C32);
 
VAR
      e         : tgg00_BasisError;
      pFileInfo : tak_sysbufferaddress;
      syskey    : tgg00_SysInfoKey;
 
BEGIN
syskey           := a01defaultkey;
syskey.stableid  := dbproc_id;
syskey.sentrytyp := cak_emethodfileinfo;
a10_nil_get_sysinfo (acv, syskey, d_release,
      sizeof (tak_method_fileinforecord), pFileInfo, e);
IF  e = e_ok
THEN
    WITH pFileInfo^.smethodfileinfo DO
        BEGIN
        mef_segmentid      := cgg_zero_c2;
        mef_filler         := cgg_zero_c2;
        mef_md5_footprint  := MD5_footprint;
        mef_filename       := libraryPathBuffer;
        a10add_sysinfo (acv, pFileInfo, e);
        END;
    (*ENDWITH*) 
(*ENDIF*) 
IF  e <> e_ok
THEN
    a07_b_put_error (acv, e, 1);
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12LoadFileInfo (
            VAR acv               : tak_all_command_glob;
            VAR dbproc_id         : tgg00_Surrogate;
            VAR pFileName         : tsp00_Addr;
            VAR MD5_footprint     : tsp00_C32);
 
VAR
      e         : tgg00_BasisError;
      pFileInfo : tak_sysbufferaddress;
      syskey    : tgg00_SysInfoKey;
 
BEGIN
syskey           := a01defaultkey;
syskey.stableid  := dbproc_id;
syskey.sentrytyp := cak_emethodfileinfo;
a10get_sysinfo (acv, syskey, d_release, pFileInfo, e);
IF  e = e_ok
THEN
    BEGIN
    pFileName     := @pFileInfo^.smethodfileinfo.mef_filename;
    MD5_footprint := pFileInfo^.smethodfileinfo.mef_md5_footprint;
    END
ELSE
    pFileName := NIL;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12_call_semantic  (VAR acv : tak_all_command_glob);
 
VAR
      start_node : integer;
      dummy_id   : tgg00_Surrogate;
      a11v       : tak_a11_glob;
 
BEGIN
start_node := acv.a_ap_tree^[0].n_lo_level;
WITH acv , a11v   DO
    IF  (a_current_user_kind = usysdba) OR
        (a_current_user_kind = udba)    OR
        ((a_current_user_kind = uprivate)
        AND
        ( a_ap_tree^[start_node].n_subproc = cak_x_create_dbproc))
    THEN
        BEGIN
        a10_cache_delete (acv, NOT c_is_rollback);
        a11glob_init     (acv, a11v);
        a1ti       := a_ap_tree^[start_node].n_lo_level;
        CASE a_ap_tree^[start_node].n_subproc OF
            cak_x_create_dbproc :
                ak12create_dbproc (acv, a11v, start_node,
                      a_ap_tree^[start_node].n_pos,
                      a_ap_tree^[start_node].n_length, dummy_id);
            cak_x_create_package :
                ak12create_package (acv, a11v, start_node,
                      a_ap_tree^[start_node].n_pos,
                      a_ap_tree^[start_node].n_length);
            cak_x_create_domain :
                ak12create_domain (acv, a11v);
            cak_x_drop_package :
                ak12drop_package (acv, a1ti);
            cak_x_drop_domain :
                ak12drop_domain  (acv, a11v);
            cak_x_create_type :
                ak12create_type (acv, a11v);
            END;
        (*ENDCASE*) 
        IF  a_returncode <> 0
        THEN
            a_part_rollback := true;
        (*ENDIF*) 
        END
    ELSE
        a07_kw_put_error (acv, e_missing_privilege, 1, cak_i_dba)
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      a12package_exist (VAR acv : tak_all_command_glob;
            VAR owner      : tsp00_KnlIdentifier;
            VAR dbproc     : tsp00_KnlIdentifier;
            VAR method_buf : tak_sysbufferaddress) : boolean;
 
VAR
      owner_id : tgg00_Surrogate;
 
BEGIN
a12package_exist := false;
a06det_user_id (acv, owner, owner_id);
IF  a12method_exist (acv, owner_id, dbproc, d_release, method_buf)
THEN
    IF  method_buf^.smethod.me_type = dbo_package
    THEN
        a12package_exist := true
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12create_dbproc (VAR acv : tak_all_command_glob;
            VAR a11v      : tak_a11_glob;
            start_node    : integer;
            indicator     : integer;
            server_mode   : integer;
            VAR dbproc_id : tgg00_Surrogate);
 
CONST
      c_is_constructor = true;
 
VAR
      is_replace        : boolean;
      with_commit       : boolean;
      withCursor        : boolean;
      ti                : integer;
      ti_func           : integer;
      dummy_size        : tsp00_Int4;
      literalPtr        : tsp00_MoveObjPtr;
      packageId         : tgg00_Surrogate;
      dummy_type_uid    : tsp00_C16;
      libraryPathBuffer : tak_method_filename;
      info_params       : tsp_dcom_paraminfo_parms;
 
BEGIN
is_replace        := (indicator = ord(true)) OR (indicator = cak_i_commit);
with_commit       := (indicator = cak_i_commit);
withCursor        := false;
a05identifier_get (acv, a11v.a1ti,
      sizeof (info_params.method), info_params.method);
ti := acv.a_ap_tree^[start_node].n_sa_level;
info_params.use_libname  := false;
IF  acv.a_is_ddl = ddl_create_package
THEN
    BEGIN
    packageId := cgg_zero_id;
    IF  acv.a_ap_tree^[ti].n_symb = s_hostfilename
    THEN (* definition via library filename *)
        BEGIN
        IF  acv.a_ap_tree^[ti].n_length DIV a01char_size >= sizeof(libraryPathBuffer) - 1
        THEN
            a07_b_put_error (acv, e_illegal_filename, 1)
        ELSE
            BEGIN
            info_params.use_libname  := true;
            info_params.library_name := @libraryPathBuffer;
            literalPtr               := @libraryPathBuffer;
            a05_string_literal_get (acv, ti, dcha,
                  sizeof (libraryPathBuffer), literalPtr^);
            libraryPathBuffer[acv.a_ap_tree^[ti].n_length DIV a01char_size + 1] := chr(0);
            info_params.prog_id := bsp_c64;
            END;
        (*ENDIF*) 
        END
    ELSE (* definition via registry *)
        BEGIN
        literalPtr := @info_params.prog_id;
        a05_string_literal_get (acv, ti, dcha,
              sizeof (info_params.prog_id), literalPtr^);
        END;
    (*ENDIF*) 
    END
ELSE
    ak12get_package_prog_id (acv, ti, info_params, packageId);
(*ENDIF*) 
IF  acv.a_returncode = 0
THEN
    BEGIN
    ti                         := acv.a_ap_tree^[ti].n_sa_level;
    ti_func                    := 0;
    a11v.a1tableid             := acv.a_curr_user_id;
    info_params.typeinfo_ptr   := NIL;
    info_params.func_idx       := 0;
    (* info_params.in_proc_server := server_mode = cak_i_local; PTS 1112663 *)
    info_params.session        := acv.a_transinf.tri_trans.trSessionId_gg00.ci4_gg00;
    CASE  acv.a_is_ddl OF
        ddl_create_procedure, ddl_create_trigger :
            BEGIN
            info_params.db_obj_type := dbo_dbproc;
            IF  (ti > 0)                                      AND
                (acv.a_ap_tree^[ti].n_proc = a12            ) AND
                (acv.a_ap_tree^[ti].n_subproc = cak_i_cursor)
            THEN
                withCursor := true;
            (*ENDIF*) 
            END;
        ddl_create_package :
            info_params.db_obj_type := dbo_package;
        OTHERWISE
            BEGIN
            is_replace              := false;
            info_params.db_obj_type := dbo_dbfunc;
            a11v.a1coln             := info_params.method;
            ti                      := acv.a_ap_tree^[start_node].n_lo_level;
            ti                      := acv.a_ap_tree^[ti].n_sa_level;
            IF  ti <> 0
            THEN
                BEGIN
                a05identifier_get (acv, ti,
                      sizeof (info_params.method), info_params.method);
                ti_func := acv.a_ap_tree^[ti].n_lo_level
                END;
            (*ENDIF*) 
            END;
        END;
    (*ENDCASE*) 
    ak12get_type_info (acv, a11v, packageId, server_mode,
          NOT c_is_constructor, is_replace, with_commit, withCursor, info_params,
          dummy_size, dummy_type_uid, dbproc_id);
    IF  ti_func <> 0
    THEN
        ak12FuncParameters (acv, ti_func, dbproc_id);
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  (acv.a_is_ddl = ddl_create_package) AND info_params.use_libname AND (acv.a_returncode = 0)
THEN
    a12CreateFileInfoRecord (acv, dbproc_id, libraryPathBuffer, info_params.MD5_footprint);
(*ENDIF*) 
IF  (acv.a_is_ddl = ddl_create_dbfunc) AND (ti <> 0)
THEN
    BEGIN
    REPEAT
        ti := acv.a_ap_tree^[ti].n_sa_level;
        IF  ti <> 0
        THEN
            BEGIN
            a05identifier_get (acv, ti,
                  sizeof (info_params.method), info_params.method);
            ak12get_type_info (acv, a11v, packageId, server_mode,
                  NOT c_is_constructor, is_replace, with_commit, withCursor, info_params,
                  dummy_size, dummy_type_uid, dbproc_id);
            IF  acv.a_ap_tree^[ti].n_lo_level <> 0
            THEN
                ak12FuncParameters (acv, acv.a_ap_tree^[ti].n_lo_level, dbproc_id);
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    UNTIL
        (ti = 0) OR (acv.a_returncode <> 0);
    (*ENDREPEAT*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12create_package (VAR acv : tak_all_command_glob;
            VAR a11v      : tak_a11_glob;
            start_node    : integer;
            indicator     : integer;
            server_mode   : integer);
 
VAR
      dummy_id : tgg00_Surrogate;
 
BEGIN
ak12create_dbproc (acv, a11v, start_node, indicator, server_mode, dummy_id);
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12create_type (VAR acv : tak_all_command_glob;
            VAR a11v   : tak_a11_glob);
 
CONST
      c_withCursor        = true;
      c_is_constructor    = true;
      c_is_replace        = true;
 
VAR
      b_err        : tgg00_BasisError;
      func_idx     : integer;
      sysk         : tgg00_SysInfoKey;
      size         : tsp00_Int4;
      domrefbuf    : tak_sysbufferaddress;
      dombuf       : tak_sysbufferaddress;
      tum_ptr      : tak_sysbufferaddress;
      type_id      : tgg00_Surrogate;
      type_owner_id: tgg00_Surrogate;
      dummy_id     : tgg00_Surrogate;
      info_params  : tsp_dcom_paraminfo_parms;
      literalPtr   : tsp00_MoveObjPtr;
      type_name    : tsp00_KnlIdentifier;
      type_uid     : tsp00_C16;
 
BEGIN
a05identifier_get (acv, a11v.a1ti, sizeof (type_name), type_name);
literalPtr := @info_params.prog_id;
a05_string_literal_get (acv, acv.a_ap_tree^[1].n_sa_level, dcha,
      sizeof (info_params.prog_id), literalPtr^);
ak12get_type_id (acv, type_id);
a11v.a1tableid := type_id;
a11v.a1tablen  := type_name;
type_owner_id  := acv.a_curr_user_id;
ak12domainref_syskey (type_owner_id, type_name, sysk);
a10_nil_get_sysinfo (acv, sysk, d_release,
      sizeof (tak_domainref), domrefbuf, b_err);
IF  b_err = e_ok
THEN
    WITH domrefbuf^.sdomainref DO
        BEGIN
        dsegmentid := cak00_public_segment_id;
        dsurrogate := type_id;
        a10add_sysinfo (acv, domrefbuf, b_err)
        END;
    (*ENDWITH*) 
(*ENDIF*) 
IF  b_err = e_duplicate_sysinfo
THEN
    a07_b_put_error (acv, e_duplicate_name,
          acv.a_ap_tree^[ 2 ].n_pos)
ELSE
    BEGIN
    IF  b_err = e_ok
    THEN
        BEGIN
        info_params.typeinfo_ptr   := NIL;
        info_params.method         := type_name;
        info_params.func_idx       := 0;
        (* info_params.in_proc_server := true; PTS 1112663 *)
        info_params.db_obj_type    := dbo_method;
        (* info_params.debug_location := NIL;  PTS 1112663 *)
        ak12get_type_info (acv, a11v, type_id, cak_i_inproc,
              c_is_constructor, NOT c_is_replace, NOT c_with_commit,
              NOT c_withCursor, info_params, size, type_uid, dummy_id)
        END;
    (*ENDIF*) 
    IF  b_err = e_ok
    THEN
        BEGIN
&       ifdef trace
        t01int4 (ak_sem, 'size        ', size);
&       endif
        sysk           := a01defaultkey;
        sysk.stableid  := type_id;
        sysk.sentrytyp := cak_edomain;
        a10_nil_get_sysinfo (acv, sysk, d_release,
              sizeof (tak_domainrecord), dombuf, b_err)
        END;
    (*ENDIF*) 
    IF  b_err = e_ok
    THEN
        WITH dombuf^.sdomain DO
            BEGIN
            dom_segmentid  := cak00_public_segment_id;
            dom_constraint := false;
            dom_filler     := 0;
            dom_type_uid   := type_uid;
            a11put_date_time (dom_date, dom_time);
            WITH dom_colinfo DO
                BEGIN
                ccolstack.etype    := st_fixcol;
                ccolstack.epos     := 1;
                ccolstack.elen_var := size + 1;
                ccolstack.ecol_tab := cgg_zero_c2;
                ccolpropset        := [];
                cextcolno          := 0;
                creccolno          := 0;
                ctabno             := 1;
                cdatatyp           := dudt;
                cdatalen           := size;
                cinoutlen          := size + 1;
                cdatafrac          := cak_frac_offset;
                cbinary            := false;
                cnextind           := 0;
                ccolumnn_len       := chr (a061identifier_len (type_name));
                ccolumnn           := type_name
                END;
            (*ENDWITH*) 
            a10add_sysinfo (acv, dombuf, b_err);
            IF  b_err = e_ok
            THEN
                BEGIN
                ak12type_uid_syskey (type_uid, sysk);
                a10_nil_get_sysinfo (acv, sysk, d_release,
                      sizeof (tak_type_uid_map_record), tum_ptr, b_err)
                END;
            (*ENDIF*) 
            IF  b_err = e_ok
            THEN
                BEGIN
                tum_ptr^.stypeuidmap.tum_segmentid := cak00_public_segment_id;
                tum_ptr^.stypeuidmap.tum_id[1]     := dom_surrogate[7];
                tum_ptr^.stypeuidmap.tum_id[2]     := dom_surrogate[8];
                a10add_sysinfo (acv, tum_ptr, b_err)
                END;
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    ELSE
        BEGIN
        info_params.func_idx := 1;
        REPEAT
            info_params.func_idx := info_params.func_idx + 1;
            info_params.method   := a01_il_b_identifier;
            ak12get_type_info (acv, a11v, type_id, cak_i_inproc,
                  NOT c_is_constructor, NOT c_is_replace, NOT c_with_commit,
                  NOT c_withCursor, info_params, size, type_uid, dummy_id);
        UNTIL
            (info_params.typeinfo_ptr = NIL) OR
            (acv.a_returncode <> 0);
        (*ENDREPEAT*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12InitParamInfoRec (VAR acv : tak_all_command_glob;
            VAR funcId : tgg00_Surrogate;
            paramCnt   : integer;
            VAR p      : tak_sysbufferaddress);
 
VAR
      e        : tgg00_BasisError;
      mblock_p : tgg00_MessBlockPtr;
      sysk     : tgg00_SysInfoKey;
 
BEGIN
sysk           := a01defaultkey;
sysk.stableid  := funcId;
sysk.sentrytyp := cak_epermmessblock;
a10get_sysinfo (acv, sysk, d_fix, p, e);
IF  e = e_ok
THEN
    BEGIN
    (* initialize all variables to NULL-value *)
    mblock_p := @p^.smessblock.mbr_mess_block;
    SAPDB_PascalFill ('VAK12 ',   1,    
          mblock_p^.mb_data_size, @mblock_p^.mb_data^.mbp_buf,
          cgg_rec_key_offset + 1, 5 + (1 + paramCnt * 2) * cak12_param_io_length,
          csp_undef_byte, acv.a_returncode);
    mblock_p^.mb_data^.mbp_rec.recLen_gg00 := cgg_rec_key_offset + 5 + cak12_param_io_length;
    END
ELSE
    a07_b_put_error (acv, e, 1)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12StoreParamInfo (VAR acv : tak_all_command_glob;
            p              : tak_sysbufferaddress;
            VAR param_info : tak00_scolinf);
 
VAR
      move_len : integer;
      mblock_p : tgg00_MessBlockPtr;
      res      : tsp00_NumError;
 
BEGIN
mblock_p := @p^.smessblock.mbr_mess_block;
WITH acv.a_mblock.mb_st^[acv.a_mblock.mb_qual^.mfirst_free-1] DO
    IF  (etype = st_value) AND
        (param_info.sci_typ in [dnumber, dfixed, dfloat, dinteger, dsmallint])
    THEN
        BEGIN
        IF  acv.a_mblock.mb_data^.mbp_buf[epos] = csp_default_byte
        THEN (* parameter *)
            BEGIN
            move_len := 1;
            mblock_p^.mb_data^.mbp_buf[mblock_p^.mb_data^.mbp_rec.recLen_gg00 + 1] := csp_undef_byte
            END
        ELSE
            BEGIN
            move_len := elen_var;
            IF  move_len > cak12_param_io_length
            THEN
                BEGIN
                move_len := cak12_param_io_length;
                END;
            (*ENDIF*) 
            g10mv ('VAK12 ',   2,    
                  acv.a_mblock.mb_data_size, mblock_p^.mb_data_size,
                  @acv.a_mblock.mb_data^.mbp_buf, epos, @mblock_p^.mb_data^.mbp_buf,
                  mblock_p^.mb_data^.mbp_rec.recLen_gg00 + 1,
                  move_len, acv.a_returncode);
            END;
        (*ENDIF*) 
        IF  move_len < cak12_param_io_length
        THEN
            SAPDB_PascalFill ('VAK12 ',   3,    
                  mblock_p^.mb_data_size, @mblock_p^.mb_data^.mbp_buf,
                  mblock_p^.mb_data^.mbp_rec.recLen_gg00 + move_len + 1,
                  cak12_param_io_length - move_len,
                  csp_defined_byte, acv.a_returncode);
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDWITH*) 
mblock_p^.mb_data^.mbp_rec.recLen_gg00 :=
      mblock_p^.mb_data^.mbp_rec.recLen_gg00 + cak12_param_io_length;
IF  param_info.sci_len > 0
THEN
    BEGIN
    mblock_p^.mb_data^.mbp_buf[mblock_p^.mb_data^.mbp_rec.recLen_gg00+1] := csp_defined_byte;
    s41plint (mblock_p^.mb_data^.mbp_buf, mblock_p^.mb_data^.mbp_rec.recLen_gg00+2,
          (cak12_param_io_length - 2) * 2, 0, param_info.sci_len, res)
    END;
(*ENDIF*) 
mblock_p^.mb_data^.mbp_rec.recLen_gg00 :=
      mblock_p^.mb_data^.mbp_rec.recLen_gg00 + cak12_param_io_length;
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12FuncParameters (VAR acv : tak_all_command_glob;
            param_ti      : integer;
            VAR dbproc_id : tgg00_Surrogate);
 
VAR
      e           : tgg00_BasisError;
      ok          : boolean;
      ti          : integer;
      ix          : integer;
      jx          : integer;
      idx         : integer;
      paramNo     : integer;
      exp         : integer;
      pMethod     : tak_sysbufferaddress;
      pParam      : tak_param_info_ptr;
      method_sysk : tgg00_SysInfoKey;
      param       : tsp00_KnlIdentifier;
 
BEGIN
method_sysk           := a01defaultkey;
method_sysk.stableid  := dbproc_id;
method_sysk.sentrytyp := cak_emethod;
a10get_sysinfo (acv, method_sysk, d_release, pMethod, e);
IF  e = e_ok
THEN
    BEGIN
    param_ti := acv.a_ap_tree^[param_ti].n_sa_level;
    paramNo  := 0;
    WHILE (param_ti <> 0) AND  (acv.a_returncode = 0) DO
        BEGIN
        paramNo := paramNo + 1;
        pParam  := pMethod^.smethod.me_param_list[paramNo];
        ti      := acv.a_ap_tree^[param_ti].n_lo_level;
        IF  acv.a_ap_tree^[ti].n_proc = a12
        THEN
            BEGIN
            CASE acv.a_ap_tree^[ti].n_subproc OF
                cak_i_number :
                    BEGIN
                    IF  (pParam^.param_datatype in [dfixed, dfloat, dinteger, dsmallint]) OR
                        (pParam^.param_com_datatype = csp1_vt_lc_kb71_param_desc)
                    THEN
                        BEGIN
                        pParam^.param_datatype    := dnumber;
                        pParam^.param_datalength  := 0;
                        pParam^.param_inoutlength := 0;
                        END
                    ELSE
                        a07_b_put_error (acv, e_incompatible_datatypes,
                              acv.a_ap_tree^[ti].n_pos);
                    (*ENDIF*) 
                    END;
                cak_i_varchar :
                    BEGIN
                    IF  (pParam^.param_datatype in [dcha, dchb]) OR
                        (pParam^.param_com_datatype = csp1_vt_lc_kb71_param_desc)
                    THEN
                        BEGIN
                        pParam^.param_datatype   := dcha;
                        pParam^.param_datalength := -1;
                        END
                    ELSE
                        a07_b_put_error (acv, e_incompatible_datatypes,
                              acv.a_ap_tree^[ti].n_pos);
                    (*ENDIF*) 
                    END;
                OTHERWISE
                    a07_b_put_error (acv, e_not_implemented, 1)
                END;
            (*ENDCASE*) 
            END
        ELSE
            BEGIN
            a05identifier_get (acv, ti, sizeof (param), param);
            ok := param[1] = 'P';
            IF  ok
            THEN
                BEGIN
                ix := 2;
                WHILE (param[ix] >= chr(ord('0'))) AND
                      (param[ix] <= chr(ord('9'))) AND
                      (ix <= 5) DO
                    ix := ix + 1;
                (*ENDWHILE*) 
                exp := 1;
                idx := 0;
                FOR jx := ix - 1 DOWNTO 2 DO
                    BEGIN
                    idx := idx + (ord(param[jx]) - ord('0')) * exp;
                    exp := exp * 10;
                    END;
                (*ENDFOR*) 
                IF  idx < paramNo
                THEN
                    WHILE ix <= sizeof(param) DO
                        BEGIN
                        IF  param[ix] <> ' '
                        THEN
                            ok := false;
                        (*ENDIF*) 
                        ix := ix + 1;
                        END
                    (*ENDWHILE*) 
                ELSE
                    ok := false;
                (*ENDIF*) 
                IF  ok AND
                    (pParam^.param_com_datatype = csp1_vt_lc_kb71_param_desc)
                THEN
                    BEGIN
                    pParam^.param_datatype    := dunknown;
                    pParam^.param_datalength  := idx;
                    END
                ELSE
                    a07_b_put_error (acv, e_invalid_parameter,
                          acv.a_ap_tree^[ti].n_pos)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        ti := acv.a_ap_tree^[ti].n_sa_level;
        IF  ti <> 0
        THEN
            BEGIN
            ak12ParamExpression (acv, ti, pMethod^.smethod);
            END;
        (*ENDIF*) 
        param_ti := acv.a_ap_tree^[param_ti].n_sa_level;
        END;
    (*ENDWHILE*) 
    a10repl_sysinfo (acv, pMethod, e);
    END;
(*ENDIF*) 
IF  e <> e_ok
THEN
    a07_b_put_error (acv, e, 1)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12ParamExpression (VAR acv : tak_all_command_glob;
            tree_index    : integer;
            VAR methodRec : tak_methodrecord);
 
VAR
      e            : tgg00_BasisError;
      ix           : integer;
      aux          : integer;
      colno        : integer;
      colIdx       : integer;
      loop_cnt     : integer;
      inoutlen     : integer;
      digits       : integer;
      cnt10        : integer;
      colname      : tsp00_KnlIdentifier;
      pMblock      : tak_sysbufferaddress;
      a11v         : tak_a11_glob;
      sysk         : tgg00_SysInfoKey;
 
BEGIN
a11glob_init (acv, a11v);
a11v.a1authname   := a01_i_temp;
a11v.a1authid     := cak_temp_user_id;
a11v.a1tablen     := a01_i_temp;
a11v.a1temp_table := true;
acv.a_pars_curr.fileHandling_gg00 := acv.a_pars_curr.fileHandling_gg00 - [ hsNoLog_egg00 ];
a11init_baserecord (acv, a11v);
loop_cnt        := 1;
colno           := 0;
inoutlen        := 5;
digits          := 1;
cnt10           := 0;
WHILE (colno <= methodRec.me_param_cnt) AND (acv.a_returncode = 0) DO
    BEGIN
    loop_cnt := 1;
    WHILE (loop_cnt <= 2) AND (acv.a_returncode = 0) DO
        BEGIN
        IF  colno = 0
        THEN
            BEGIN
            IF  loop_cnt = 1
            THEN
                a061assign_colname ('$RC               ', colname)
            ELSE
                a061assign_colname ('$DATALENGTH       ', colname);
            (*ENDIF*) 
            a061app_columnname (acv, acv.a_p_arr1.pbasep^.sbase,
                  colname, colIdx);
            END
        ELSE
            BEGIN
            cnt10 := cnt10 + 1;
            IF  cnt10 = 10
            THEN
                BEGIN
                cnt10  := 0;
                digits := digits + 1;
                END;
            (*ENDIF*) 
            a11v.a1coln := a01_il_b_identifier;
            IF  loop_cnt = 1
            THEN
                a11v.a1coln[1] := 'P'
            ELSE
                BEGIN
                a11v.a1coln[1] := '#';
                a11v.a1coln[2] := 'P';
                END;
            (*ENDIF*) 
            aux := colno;
            FOR ix := digits DOWNTO 1 DO
                BEGIN
                a11v.a1coln[loop_cnt+digits] := chr(ord('0') + aux MOD 10);
                aux := aux DIV 10
                END;
            (*ENDFOR*) 
            a061app_columnname (acv, acv.a_p_arr1.pbasep^.sbase,
                  a11v.a1coln, colIdx);
            END;
        (*ENDIF*) 
        IF  acv.a_returncode = 0
        THEN
            BEGIN
            WITH acv.a_p_arr1.pbasep^.sbase, bcolumn[colIdx]^ DO
                BEGIN
                cextcolno             := bmaxcol;
                creccolno             := cextcolno;
                ctabno                := 1;
                ccolpropset           := [];
                cdatatyp              := dfixed;
                cdatafrac             := cak_frac_offset;
                cdatalen              := (inoutlen - 2) * 2;
                cinoutlen             := inoutlen;
                cbinary               := false;
                ccolstack.etype       := st_fixcol;
                ccolstack.eop         := op_none;
                ccolstack.epos        := blenfixedcol;
                ccolstack.elen_var    := cinoutlen;
                ccolstack.ecol_tab[1] := chr(0);
                ccolstack.ecol_tab[2] := chr(0);
                blenfixedcol          := blenfixedcol + cinoutlen
                END;
            (*ENDWITH*) 
            END;
        (*ENDIF*) 
        inoutlen := cak12_param_io_length;
        loop_cnt := loop_cnt + 1;
        END;
    (*ENDWHILE*) 
    colno := colno + 1;
    END;
(*ENDWHILE*) 
IF  acv.a_returncode = 0
THEN
    BEGIN
    a11v.a1sort      := true;
    a11v.a1createtab := true;
    a11end_create_table (acv, a11v)
    END;
(*ENDIF*) 
acv.a_pars_curr.fileHandling_gg00 := acv.a_pars_curr.fileHandling_gg00 + [hsNoLog_egg00];
IF  acv.a_returncode = 0
THEN
    a262compile (acv, acv.a_ap_tree^[tree_index].n_lo_level);
(*ENDIF*) 
IF  acv.a_returncode = 0
THEN
    BEGIN
    sysk           := a01defaultkey;
    sysk.stableid  := methodRec.me_surrogate;
    sysk.sentrytyp := cak_epermmessblock;
    a10mblock_into_cache (acv, sysk, acv.a_mblock, d_release, pMblock, e);
    IF  e = e_ok
    THEN
        a10add_sysinfo (acv, pMblock, e);
    (*ENDIF*) 
    IF  e <> e_ok
    THEN
        a07_b_put_error (acv, e, 1)
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  acv.a_returncode = 0
THEN
    a11drop_table  (acv,  acv.a_p_arr1.pbasep^.sbase.bsurrogate,
          twithoutkey, false);
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12get_package_prog_id (VAR acv : tak_all_command_glob;
            ti              : integer;
            VAR info_params : tsp_dcom_paraminfo_parms;
            VAR packageId   : tgg00_Surrogate);
 
VAR
      b_err : tgg00_BasisError;
      p     : tak_sysbufferaddress;
      sysk  : tgg00_SysInfoKey;
 
BEGIN
sysk           := a01defaultkey;
sysk.sauthid   := acv.a_curr_user_id;
sysk.sentrytyp := cak_emethodref;
a05identifier_get (acv, ti, sizeof (sysk.sappl), sysk.sappl);
sysk.skeylen   := sysk.skeylen + sizeof (sysk.sappl);
a10get_sysinfo (acv, sysk, d_release, p, b_err);
IF  b_err = e_ok
THEN
    IF  p^.smethodref.mrf_type = dbo_package
    THEN
        BEGIN
        packageId := p^.smethodref.mrf_method_id;
        a12LoadFileInfo (acv, packageId, info_params.library_name, info_params.MD5_footprint);
        IF  info_params.library_name <> NIL
        THEN
            info_params.use_libname := true
        ELSE
            BEGIN
            info_params.use_libname := false;
            sysk           := a01defaultkey;
            sysk.stableid  := packageId;
            sysk.sentrytyp := cak_emethodfileinfo;
            sysk.sentrytyp := cak_emethodinfo;
            a10get_sysinfo (acv, sysk, d_release, p, b_err);
            IF  b_err = e_ok
            THEN
                info_params.prog_id := p^.smethodinfo.mei_prog_id
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END
    ELSE
        b_err := e_sysinfo_not_found;
    (*ENDIF*) 
(*ENDIF*) 
IF  b_err <> e_ok
THEN
    IF  b_err = e_sysinfo_not_found
    THEN
        a07_b_put_error (acv, e_unknown_name, acv.a_ap_tree^[ti].n_pos)
    ELSE
        a07_b_put_error (acv, b_err, 1)
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12type_uid_syskey (VAR type_uid : tsp00_C16;
            VAR sysk : tgg00_SysInfoKey);
 
VAR
      c8_ptr : ^tsp00_C8;
 
BEGIN
sysk            := a01defaultkey;
c8_ptr          := @type_uid;
sysk.sauthid    := c8_ptr^;
sysk.sentrytyp  := cak_etype_uid;
c8_ptr          := @type_uid[9];
sysk.suserid    := c8_ptr^;
sysk.skeylen    := sysk.skeylen + sizeof (sysk.suserid);
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12get_type_id (VAR acv : tak_all_command_glob;
            VAR type_id : tgg00_Surrogate);
 
VAR
      b_err  : tgg00_BasisError;
      sysbuf : tak_sysbufferaddress;
      i_prev : tsp00_Int4;
      i_curr : tsp00_Int4;
      sysk   : tgg00_SysInfoKey;
      prevk  : tgg00_SysInfoKey;
 
BEGIN
sysk           := a01defaultkey;
sysk.ssite     := cak_type_site;
sysk.sentrytyp := cak_edomain;
REPEAT
    prevk  := sysk;
    i_prev := ord (prevk.stableid[7]) * 256 + ord (prevk.stableid[8]);
    a10next_sysinfo (acv, sysk, 2, d_release,
          cak_edomain, sysbuf, b_err);
    IF  b_err = e_ok
    THEN
        BEGIN
        i_curr := ord (sysk.stableid[7]) * 256 + ord (sysk.stableid[8]);
        IF  i_curr > i_prev + 1
        THEN
            b_err := e_no_next_record
        (*ENDIF*) 
        END;
    (*ENDIF*) 
UNTIL
    b_err <> e_ok;
(*ENDREPEAT*) 
IF  b_err = e_no_next_record
THEN
    BEGIN
    type_id    := prevk.stableid;
    i_prev     := i_prev + 1;
    type_id[7] := chr (i_prev DIV 256);
    type_id[8] := chr (i_prev MOD 256)
    END
ELSE
    a07_b_put_error (acv, b_err, 1)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12get_type_info (VAR acv : tak_all_command_glob;
            VAR a11v         : tak_a11_glob;
            VAR packageId    : tgg00_Surrogate;
            server_mode      : integer;
            is_constructor   : boolean;
            is_replace       : boolean;
            with_commit      : boolean;
            withCursor       : boolean;
            VAR info_params  : tsp_dcom_paraminfo_parms;
            VAR size         : integer;
            VAR type_uid     : tsp00_C16;
            VAR method_id    : tgg00_Surrogate);
 
CONST
      c_release = true;
 
TYPE
 
      TPacketBuf = RECORD
            CASE boolean OF
                true :
                    (align : tsp00_Addr);
                false :
                    (* (buf : ARRAY[1..2] OF tgg00_Rec);    PTS 1110591 FF *)
                    (buf : ARRAY[1..4] OF tgg00_Rec);    (* PTS 1110591 FF *)
                END;
            (*ENDCASE*) 
 
 
VAR
      replRefBuf         : boolean;
      do_return          : boolean;
      do_invalidate      : boolean;
      type_id            : tsp00_C2;
      b_err              : tgg00_BasisError;
      e                  : tsp8_uni_error;
      err_char_no        : tsp00_Int4;
      dispid             : tsp00_Int4;
      param_pos          : tsp00_Int4;
      name_pos           : tsp00_Int4;
      abap_tab_columns   : tsp00_Int4;
      ix                 : integer;
      param_cnt          : integer;
      external_param_cnt : integer;
      pc132              : ^tsp00_C132;
      p                  : tsp00_MoveObjPtr;
      packet_ptr         : tsp1_packet_ptr;
      segm_ptr           : tsp1_segment_ptr;
      sinfo_part_ptr     : tsp1_part_ptr;
      name_part_ptr      : tsp1_part_ptr;
      method_type        : tsp00_DbObjectType;
      buf                : TPacketBuf;
      methodbuf          : tak_sysbufferaddress;
      colinfo            : tak00_scolinf;
      methodname         : tsp00_KnlIdentifier;
      cip                : tsp_dcom_co_create_instance_parms;
      (* debug_location     : tsp00_C132;       PTS 1112663 *)
 
CONST
      c_old_tsp_rte_header = 20;
 
BEGIN
replRefBuf    := false;
packet_ptr    := @buf;
do_invalidate := false;
do_return     := false;
methodname    := info_params.method;
IF  info_params.db_obj_type = dbo_package
THEN (* don't know any methodname *)
    info_params.method := a01_il_b_identifier;
(*+++++ wrong packet layout: tsp_rte_header ++++ *)
(*ENDIF*) 
packet_ptr^.sp1_header.sp1h_varpart_size :=
      sizeof (buf) - c_old_tsp_rte_header -
      sizeof (tsp1_packet_header);
packet_ptr^.sp1_header.sp1h_varpart_len := 0;
packet_ptr^.sp1_header.sp1h_no_of_segm  := 0;
(*&if $OS = WIN32*)
info_params.packet          := @buf;
info_params.errtext         := a01_il_b_identifier;
info_params.session_context := @acv;
(* PTS 1105195, T.A. 04.01.2000 *)
IF  g01unicode
THEN
    BEGIN
    ix := sizeof(info_params.method);
    s80uni_trans (@info_params.method, sizeof(info_params.method),
          csp_unicode, @info_params.method, ix,
          csp_ascii, [uni_fillup_field],
          e, err_char_no);
    IF  e <> uni_ok
    THEN
        a07_uni_error (acv, e, err_char_no)
    (*ENDIF*) 
    END;
(*ENDIF*) 
info_params.package_id := packageId;
vdcom_paraminfo (info_params);
IF  packet_ptr^.sp1_segm.sp1r_returncode <> 0
THEN
    BEGIN
    a260hresult_error (packet_ptr^.sp1_segm.sp1r_errorpos,
          methodname, info_params.errtext, b_err);
    a07_const_b_put_error (acv, b_err, 1, @info_params.errtext,
          sizeof (info_params.errtext))
    END;
(*&else*)
(*a07_b_put_error (acv, e_not_implemented, 1);*)
(*&endif*)
(*ENDIF*) 
do_return := (info_params.func_idx > 0)    AND
      (methodname = a11v.a1tablen) AND
      (a11v.a1tablen <> a01_il_b_identifier);
IF  (acv.a_returncode = 0) AND NOT do_return
THEN
    BEGIN
    segm_ptr := @packet_ptr^.sp1_segm;
    s26find_part (segm_ptr^, sp1pk_shortinfo, sinfo_part_ptr);
    s26find_part (segm_ptr^, sp1pk_columnnames, name_part_ptr);
    IF  (sinfo_part_ptr = NIL) OR (name_part_ptr = NIL)
    THEN
        a07_b_put_error (acv, e_invalid_parameter, 1)
    ELSE
        BEGIN
&       ifdef trace
        p := @sinfo_part_ptr^.sp1p_buf;
        t01moveobj (ak_sem, p^, 1, sinfo_part_ptr^.sp1p_buf_len);
        p := @name_part_ptr^.sp1p_buf;
        t01moveobj (ak_sem, p^, 1, name_part_ptr^.sp1p_buf_len);
&       endif
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  (acv.a_returncode = 0) AND NOT do_return
THEN
    BEGIN
    b_err := e_ok;
    IF  acv.a_is_ddl = ddl_create_procedure
    THEN
        method_type := dbo_dbproc
    ELSE
        BEGIN
        method_type := info_params.db_obj_type;
        IF  methodname = a01_il_b_identifier
        THEN
            methodname  := info_params.method;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    a12NewMethod (acv, a11v.a1tableid, a11v.a1coln, methodname,
          acv.a_ap_tree^[a11v.a1ti].n_pos, is_replace, method_type,
          info_params.prog_id, a01_il_b_identifier, methodbuf);
    IF  acv.a_returncode = 0
    THEN
        WITH methodbuf^.smethod DO
            BEGIN
            method_id := me_surrogate;
            IF  acv.a_is_ddl = ddl_create_package
            THEN
                param_cnt := 0
            ELSE
                param_cnt := sinfo_part_ptr^.sp1p_arg_count;
            (*ENDIF*) 
            IF  is_replace AND (me_param_cnt <> param_cnt)
            THEN
                b_err := e_too_many_differences
            ELSE
                BEGIN
                IF  is_replace
                THEN
                    BEGIN
                    cip.coclsid := me_coclsid;
                    cip.iid     := me_iid;
                    END;
                (*ENDIF*) 
                IF  param_cnt > cak_max_param_index
                THEN
                    b_err := e_param_list_too_long
                ELSE
                    BEGIN
                    me_param_cnt  := param_cnt;
                    me_dispid     := info_params.dispid;
                    me_coclsid    := info_params.coclsid;
                    me_iid        := info_params.iid;
                    IF  acv.a_is_ddl = ddl_create_procedure
                    THEN
                        me_type := dbo_dbproc
                    ELSE
                        me_type := info_params.db_obj_type;
                    (*ENDIF*) 
                    IF  me_type in [dbo_package]
                    THEN
                        me_package_id := me_surrogate
                    ELSE
                        me_package_id := packageId;
                    (*ENDIF*) 
                    CASE server_mode OF
                        cak_i_inproc :
                            me_debug := dbg_inproc;
                        cak_i_local :
                            me_debug := dbg_local;
                        END;
                    (*ENDCASE*) 
                    me_sql             := false;
                    me_cursor          := withCursor;
                    param_pos          := 1;
                    name_pos           := 1;
                    type_id[1]         := a11v.a1tableid[7];
                    type_id[2]         := a11v.a1tableid[8];
                    abap_tab_columns   := 0;
                    external_param_cnt := 0;
                    FOR ix := 1 TO param_cnt DO
                        BEGIN
                        IF  acv.a_returncode = 0
                        THEN
                            ak12one_parameter (acv, is_constructor, is_replace,
                                  info_params.db_obj_type = dbo_dbproc,
                                  type_id, sinfo_part_ptr,
                                  param_pos, name_part_ptr, external_param_cnt, name_pos,
                                  me_param_list[ix], abap_tab_columns, type_uid);
                        (*ENDIF*) 
                        END;
                    (*ENDFOR*) 
                    IF  (acv.a_returncode = 0) AND
                        (info_params.db_obj_type = dbo_method  )
                    THEN
                        BEGIN
                        a12output_parameter (acv, methodbuf, ix, colinfo);
                        size := colinfo.sci_len
                        END;
                    (*ENDIF*) 
                    IF  (me_type <> dbo_method                        ) AND
                        (acv.a_is_ddl <> ddl_create_package           )
                    THEN
                        me_sql := a260sql_in_dbproc (acv, me_coclsid, me_package_id)
                    ELSE
                        me_sql := false;
                    (*ENDIF*) 
                    do_invalidate := is_replace
                          AND
                          ((cip.coclsid <> me_coclsid) OR (cip.iid <> me_iid));
                    a10_add_repl_sysinfo (acv, methodbuf, NOT is_replace, b_err)
                    END
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    IF  b_err <> e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    ELSE
        BEGIN
        IF  acv.a_is_ddl = ddl_create_procedure
        THEN
            a16put_usage_def  (acv, packageId, method_id, tempty);
        (*ENDIF*) 
        IF  with_commit AND (acv.a_returncode = 0)
        THEN
            BEGIN
            a52_ex_commit_rollback (acv, m_commit, NOT c_release, NOT c_release);
            IF  (acv.a_returncode = 0)
            THEN
                BEGIN
                IF  do_invalidate
                THEN
                    vdcom_invalidate (cip);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12one_parameter (VAR acv : tak_all_command_glob;
            is_constructor       : boolean;
            is_replace           : boolean;
            is_dbproc            : boolean;
            create_type_id       : tsp00_C2;
            sinfo_part           : tsp1_part_ptr;
            VAR param_pos        : tsp00_Int4;
            name_part            : tsp1_part_ptr;
            VAR param_cnt        : integer;
            VAR name_pos         : tsp00_Int4;
            VAR param_info_ptr   : tak_param_info_ptr;
            VAR abap_tab_columns : tsp00_Int4;
            VAR type_uid         : tsp00_C16);
 
VAR
      in_stream_desc         : boolean;
      param_shinfo           : tsp1_dcom_param_info;
      namelen                : integer;
      maxLength              : integer;
      e                      : tsp8_uni_error;
      err_char_no            : tsp00_Int4;
      par_name               : tsp00_KnlIdentifier;
      old_param_datatype     : tsp00_DataType;
      old_param_datafrac     : tsp00_Uint1;
      old_param_datalength   : tsp00_Int2;
      old_param_inoutlength  : tsp00_Int2;
      old_param_in_out       : tsp00_C2;
      old_param_com_datatype : tsp00_Int2;
      old_param_type_id      : tsp00_C2;
      param_desc_guid        : tsp00_C16;
 
BEGIN
WITH acv, param_shinfo DO
    BEGIN
    in_stream_desc := abap_tab_columns > 0;
    IF  NOT in_stream_desc
    THEN
        namelen   := ord(name_part^.sp1p_buf[name_pos])
    ELSE
        namelen := 0;
    (*ENDIF*) 
    IF  is_replace
    THEN
        BEGIN
        IF  namelen <> ord(param_info_ptr^.param_name_len)
        THEN
            a07_b_put_error (acv, e_too_many_differences, 1)
        ELSE
            BEGIN
            old_param_datatype     := param_info_ptr^.param_datatype;
            old_param_datafrac     := param_info_ptr^.param_datafrac;
            old_param_datalength   := param_info_ptr^.param_datalength;
            old_param_inoutlength  := param_info_ptr^.param_inoutlength;
            old_param_in_out       := param_info_ptr^.param_in_out;
            old_param_com_datatype := param_info_ptr^.param_com_datatype;
            old_param_type_id      := param_info_ptr^.param_type_id
            END;
        (*ENDIF*) 
        END
    ELSE
        a10new (acv, sizeof (tak_param_info) - sizeof (tsp00_C256) + namelen * a01char_size,
              param_info_ptr);
    (*ENDIF*) 
    IF  param_info_ptr = NIL
    THEN
        a07_b_put_error (acv, e_no_more_memory, 1)
    ELSE
        WITH param_info_ptr^ DO
            BEGIN
            IF  acv.a_is_ddl = ddl_create_trigger
            THEN
                sp1i_dcom_io_type := sp1io_input;
            (*ENDIF*) 
            g10mv ('VAK12 ',   4,    
                  sinfo_part^.sp1p_buf_size,
                  sizeof (param_shinfo), @sinfo_part^.sp1p_buf, param_pos,
                  @param_shinfo, 1, sizeof (param_shinfo),
                  a_returncode);
            IF  abap_tab_columns = 0
            THEN
                BEGIN
                IF  (param_cnt = a260max_params) OR
                    ((param_cnt = a260max_output_params) AND
                    ( sp1i_dcom_io_type in [sp1io_output, sp1io_inout]))
                THEN
                    a07_b_put_error (acv, e_too_many_values, param_cnt)
                ELSE
                    BEGIN
                    param_cnt            := param_cnt + 1;
                    param_cpp_offset     := 0;
                    param_ascii_offset   := 0;
                    param_unicode_offset := 0;
                    IF  g01unicode
                    THEN
                        BEGIN
                        maxLength := namelen * 2;
                        s80uni_trans (@name_part^.sp1p_buf[name_pos + 1], namelen,
                              csp_ascii, @param_name, maxLength,
                              csp_unicode, [], e, err_char_no);
                        IF  e <> uni_ok
                        THEN
                            a07_uni_error (acv, e, err_char_no)
                        (*ENDIF*) 
                        END
                    ELSE
                        g10mv ('VAK12 ',   5,    
                              name_part^.sp1p_buf_size, sizeof (param_name),
                              @name_part^.sp1p_buf, name_pos + 1,
                              @param_name, 1, namelen,
                              a_returncode);
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                param_cpp_offset     := param_shinfo.sp1i_dcom_cpp_offset;
                param_ascii_offset   := param_shinfo.sp1i_dcom_ascii_offset;
                param_unicode_offset := param_shinfo.sp1i_dcom_unicode_offset;
                abap_tab_columns     := abap_tab_columns - 1
                END;
            (*ENDIF*) 
            name_pos       := name_pos + namelen + 1;
            param_name_len := chr (namelen * a01char_size);
            param_pos := param_pos + sizeof (param_shinfo);
            IF  sp1ot_mandatory in sp1i_dcom_mode
            THEN
                param_in_out[1] := csp_info_mandatory
            ELSE
                IF  sp1ot_optional in sp1i_dcom_mode
                THEN
                    param_in_out[1] := csp_info_optional
                ELSE
                    IF  sp1ot_default in sp1i_dcom_mode
                    THEN
                        param_in_out[1] := csp_info_default;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            param_in_out[2]    := chr(sp1i_dcom_io_type);
            param_datafrac     := cak_frac_offset;
            param_com_datatype := sp1i_dcom_datatype;
            param_datalength   := cak_is_undefined;
            param_type_id      := cgg_zero_c2;
            IF  (acv.a_is_ddl in [ddl_create_dbfunc, ddl_create_trigger]) AND
                NOT in_stream_desc                                        AND
                (sp1i_dcom_datatype in [csp1_vt_i2, csp1_vt_ui2, csp1_vt_i4, csp1_vt_int,
                csp1_vt_ui4, csp1_vt_uint, csp1_vt_r4, csp1_vt_r8])
            THEN
                ak12unsupported_type (acv, sp1i_dcom_datatype, sp1i_dcom_sub_datatype);
            (*ENDIF*) 
            CASE sp1i_dcom_datatype OF
                csp1_vt_lc_char, csp1_vt_lc_ascii7 :
                    BEGIN
                    param_datatype    := dcha;
                    param_datalength  := 1;
                    param_inoutlength := 2
                    END;
                csp1_vt_lc_wyde :
                    BEGIN
                    param_datatype    := dwyde;
                    param_datalength  := 1;
                    param_inoutlength := 2
                    END;
                csp1_vt_lc_wchar :
                    BEGIN
                    param_datatype    := dunicode;
                    param_datalength  := 1;
                    param_inoutlength := 3
                    END;
                csp1_vt_bool, csp1_vt_lc_bool :
                    BEGIN
                    param_datatype    := dboolean;
                    param_datalength  := 1;
                    param_inoutlength := 2
                    END;
                csp1_vt_i1, csp1_vt_ui1, csp1_vt_lc_byte  :
                    BEGIN
                    param_datatype    := dchb;
                    param_datalength  := 1;
                    param_inoutlength := 2
                    END;
                csp1_vt_lc_int1 , csp1_vt_lc_uint1 :
                    BEGIN
                    param_datatype    := dsmallint;
                    param_datalength  := 5;
                    param_inoutlength := 5;
                    END;
                csp1_vt_i2 :
                    BEGIN
                    param_datatype    := dsmallint;
                    param_datalength  := 5;
                    param_inoutlength := 5;
                    END;
                csp1_vt_ui2 :
                    BEGIN
                    param_datatype    := dfixed;
                    param_datalength  := 5;
                    param_inoutlength := 5
                    END;
                csp1_vt_i4, csp1_vt_int  :
                    BEGIN
                    param_datatype    := dinteger;
                    param_datalength  := 10;
                    param_inoutlength := 7;
                    END;
                csp1_vt_ui4, csp1_vt_uint :
                    BEGIN
                    param_datatype    := dfixed;
                    param_datalength  := 10;
                    param_inoutlength := 7
                    END;
                csp1_vt_i8 :
                    IF  in_stream_desc
                    THEN
                        BEGIN
                        param_datatype    := dinteger;
                        param_datalength  := 19;
                        param_inoutlength := 12;
                        END
                    ELSE
                        ak12unsupported_type (acv, sp1i_dcom_datatype, -1);
                    (*ENDIF*) 
                csp1_vt_ui8 :
                    IF  in_stream_desc
                    THEN
                        BEGIN
                        param_datatype    := dfixed;
                        param_datalength  := 19;
                        param_inoutlength := 12;
                        END
                    ELSE
                        ak12unsupported_type (acv, sp1i_dcom_datatype, -1);
                    (*ENDIF*) 
                csp1_vt_r4 :
                    BEGIN
                    param_datatype    := dfloat;
                    param_datalength  := 6;
                    param_inoutlength := 5;
                    param_datafrac    := 0
                    END;
                csp1_vt_r8  :
                    BEGIN
                    param_datatype    := dfloat;
                    param_datalength  := 15;
                    param_inoutlength := 10;
                    param_datafrac    := 0
                    END;
                csp1_vt_bstr :
                    BEGIN
                    param_datatype    := dcha;
                    param_datalength  := 254;
                    param_inoutlength := 255;
                    param_datafrac    := 0
                    END;
                csp1_vt_variant :
                    BEGIN
                    param_datatype := dunknown;
                    END;
                csp1_vt_carray :
                    BEGIN
                    CASE sp1i_dcom_sub_datatype OF
                        csp1_vt_lc_char, csp1_vt_lc_ascii7 :
                            param_datatype := dcha;
                        csp1_vt_lc_wchar :
                            param_datatype := dunicode;
                        csp1_vt_lc_byte, csp1_vt_i1, csp1_vt_ui1  :
                            param_datatype := dchb;
                        csp1_vt_lc_bool :
                            param_datatype := dboolean;
                        csp1_vt_lc_wyde :
                            param_datatype := dwyde;
                        OTHERWISE
                            ak12unsupported_type (acv, sp1i_dcom_datatype, sp1i_dcom_sub_datatype);
                        END;
                    (*ENDCASE*) 
                    param_datalength   := sp1i_dcom_dim;
                    param_inoutlength  := param_datalength + 1;
                    END;
                csp1_vt_userdefined :
                    BEGIN
                    param_datatype    := dudt;
                    param_datalength  := sp1i_dcom_dim;
                    param_inoutlength := param_datalength + 1
                    END;
                csp1_vt_lc_kb71_param_desc :
                    BEGIN
                    param_datatype    := dcha;
                    param_datalength  := -1;
                    param_inoutlength := -1
                    END;
                csp1_vt_ptr :
                    IF  (sp1i_dcom_io_type = sp1io_input)        AND
                        (acv.a_is_ddl     <> ddl_create_trigger) AND
                        (acv.a_is_ddl     <> ddl_create_dbfunc ) AND
                        (sp1i_dcom_sub_datatype in [csp1_vt_i2, csp1_vt_ui2, csp1_vt_i4, csp1_vt_int,
                        csp1_vt_ui4, csp1_vt_uint, csp1_vt_r4, csp1_vt_r8])
                    THEN
                        ak12unsupported_type (acv, sp1i_dcom_datatype, sp1i_dcom_sub_datatype)
                    ELSE
                        BEGIN
                        CASE sp1i_dcom_sub_datatype OF
                            csp1_vt_lc_char, csp1_vt_lc_ascii7 :
                                BEGIN
                                param_datatype    := dcha;
                                param_datalength  := sp1i_dcom_dim;
                                param_inoutlength := param_datalength + 1;
                                END;
                            csp1_vt_lc_wchar :
                                BEGIN
                                param_datatype    := dunicode;
                                param_datalength  := 1;
                                param_inoutlength := 3
                                END;
                            csp1_vt_i1, csp1_vt_ui1, csp1_vt_lc_byte :
                                BEGIN
                                param_datatype    := dchb;
                                param_datalength  := sp1i_dcom_dim;
                                param_inoutlength := param_datalength + 1
                                END;
                            csp1_vt_lc_int1, csp1_vt_i2, csp1_vt_lc_uint1   :
                                BEGIN
                                param_datatype    := dsmallint;
                                param_datalength  := 5;
                                param_inoutlength := 5
                                END;
                            csp1_vt_ui2 :
                                BEGIN
                                param_datatype    := dfixed;
                                param_datalength  := 5;
                                param_inoutlength := 5
                                END;
                            csp1_vt_i4, csp1_vt_int :
                                BEGIN
                                param_datatype    := dinteger;
                                param_datalength  := 10;
                                param_inoutlength := 7
                                END;
                            csp1_vt_ui4, csp1_vt_uint :
                                BEGIN
                                param_datatype    := dfixed;
                                param_datalength  := 10;
                                param_inoutlength := 7
                                END;
                            csp1_vt_r4   :
                                BEGIN
                                param_datatype    := dfloat;
                                param_datalength  := 6;
                                param_inoutlength := 5
                                END;
                            csp1_vt_r8   :
                                BEGIN
                                param_datatype    := dfloat;
                                param_datalength  := 15;
                                param_inoutlength := 10
                                END;
                            csp1_vt_bool, csp1_vt_lc_bool :
                                BEGIN
                                param_datatype    := dboolean;
                                param_datalength  := 1;
                                param_inoutlength := 2
                                END;
                            csp1_vt_carray :
                                BEGIN
                                param_datatype    := dchb;
                                param_datalength  := sp1i_dcom_dim;
                                param_inoutlength := param_datalength + 1
                                END;
                            csp1_vt_userdefined :
                                BEGIN
                                IF  is_dbproc
                                THEN
                                    param_datatype := dchb
                                ELSE
                                    param_datatype := dudt;
                                (*ENDIF*) 
                                param_datalength  := sp1i_dcom_length;
                                param_inoutlength := param_datalength + 1;
                                param_datafrac    := sp1i_dcom_dim;
                                abap_tab_columns  := sp1i_dcom_dim;
                                END;
                            OTHERWISE
                                ak12unsupported_type (acv, sp1i_dcom_datatype, sp1i_dcom_sub_datatype);
                            END;
                        (*ENDCASE*) 
                        { CASE }
                        IF  (sp1i_dcom_sub_datatype <> csp1_vt_userdefined) AND
                            ((param_datatype = dcha) OR (param_datatype = dchb))
                        THEN
                            BEGIN
                            IF  param_datalength > 1
                            THEN
                                param_com_datatype := csp1_vt_carray
                            ELSE
                                param_com_datatype := sp1i_dcom_sub_datatype;
                            (*ENDIF*) 
                            END
                        ELSE
                            param_com_datatype := sp1i_dcom_sub_datatype;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                csp1_vt_lc_abap_tab_handle, csp1_vt_lc_stream_handle :
                    BEGIN
                    param_datatype     := dabaptabhandle;
                    param_datalength   := ak263EvalHandleLength (sp1i_dcom_dim);
                    param_inoutlength  := param_datalength + 1;
                    param_datafrac     := sp1i_dcom_dim;
                    abap_tab_columns   := sp1i_dcom_dim;
                    END;
                OTHERWISE
                    ak12unsupported_type (acv,  sp1i_dcom_datatype, -1);
                END;
            (*ENDCASE*) 
            IF  is_constructor
            THEN
                BEGIN
                IF  (param_datatype = dudt) AND (NOT in_stream_desc)
                THEN
                    param_type_id := create_type_id;
                (*ENDIF*) 
                IF  (sp1i_dcom_io_type in [sp1io_output, sp1io_inout])
                    AND
                    NOT in_stream_desc
                THEN
                    type_uid := sp1i_dcom_type_uid
                (*ENDIF*) 
                END
            ELSE
                type_uid := sp1i_dcom_type_uid;
            (*ENDIF*) 
            IF  (param_datatype = dudt) AND
                NOT is_constructor      AND
                NOT in_stream_desc
            THEN
                BEGIN
                IF  type_uid <> param_desc_guid
                THEN
                    BEGIN
                    a12type_uid_to_id (acv, type_uid, param_type_id);
                    IF  param_type_id = cgg_zero_c2
                    THEN
                        BEGIN
                        par_name := a01_il_b_identifier;
                        IF  namelen > sizeof (a01_il_b_identifier)
                        THEN
                            namelen := sizeof (a01_il_b_identifier);
                        (*ENDIF*) 
                        g10mv ('VAK12 ',   6,    
                              sizeof (param_name), sizeof (par_name),
                              @param_name, 1, @par_name, 1, namelen,
                              a_returncode);
                        (*a07_nb_put_error (acv, e_missing_usertype_guid, 1, par_name)*)
                        a07_b_put_error (acv, e_not_implemented, 1)
                        END;
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            param_state := param_undef;
            IF  is_replace AND
                ((old_param_datatype    <> param_info_ptr^.param_datatype    ) OR
                (old_param_datafrac     <> param_info_ptr^.param_datafrac    ) OR
                (old_param_datalength   <> param_info_ptr^.param_datalength  ) OR
                (old_param_inoutlength  <> param_info_ptr^.param_inoutlength ) OR
                (old_param_in_out       <> param_info_ptr^.param_in_out      ) OR
                (old_param_com_datatype <> param_info_ptr^.param_com_datatype) OR
                (old_param_type_id      <> param_info_ptr^.param_type_id     ))
            THEN
                a07_b_put_error (acv, e_too_many_differences, 1)
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12unsupported_type (VAR acv : tak_all_command_glob;
            dcom_type     : integer;
            dcom_sub_type : integer);
 
CONST
      c_with_zero = true;
 
VAR
      msg : tsp00_C40;
 
BEGIN
msg := 'UNSUPPORTED DCOM TYPE :                 ';
g17int4to_line (dcom_type, NOT c_with_zero, 5, 24, msg);
IF  dcom_sub_type > 0
THEN
    BEGIN
    msg[30] := ',';
    g17int4to_line (dcom_sub_type, NOT c_with_zero, 5, 30, msg)
    END;
(*ENDIF*) 
a07_const_b_put_error (acv, e_not_implemented, 1, @msg, sizeof(msg));
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12create_domain (VAR acv : tak_all_command_glob;
            VAR a11v   : tak_a11_glob);
 
VAR
      b_err      : tgg00_BasisError;
      ix         : integer;
      domrefbuf  : tak_sysbufferaddress;
      dombuf     : tak_sysbufferaddress;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    ak12get_domain_identifiers (acv, a1ti, a1authname, a1tablen);
    IF  a1authname = a01_il_b_identifier
    THEN
        a1authname := a_curr_user_name;
    (*ENDIF*) 
    IF  a1authname <> a_curr_user_name
    THEN
        a07_kw_put_error (acv, e_missing_privilege,
              a_ap_tree^[a1ti].n_pos, cak_i_userid)
    ELSE
        BEGIN
        a05identifier_get  (acv, a1ti, sizeof (a1tablen), a1tablen);
        a11init_baserecord (acv, a11v);
        a1createtab := true;
        a11one_column_def (acv, a11v);
        IF  a1serial_node <> 0
        THEN
            ak12store_serial_value (acv, a11v);
        (*ENDIF*) 
        a1createtab  := false;
        a11end_create_table (acv, a11v)
        END;
    (*ENDIF*) 
    IF  a_returncode = 0
    THEN
        BEGIN
        ak12domainref_syskey (a_curr_user_id, a1tablen, a1sysk);
        a10_nil_get_sysinfo (acv, a1sysk, d_release,
              sizeof (tak_domainref), domrefbuf, b_err);
        IF  b_err = e_ok
        THEN
            WITH domrefbuf^.sdomainref DO
                BEGIN
                dsegmentid := cak00_public_segment_id;
                dsurrogate := a1tableid;
                a10add_sysinfo (acv, domrefbuf, b_err)
                END;
            (*ENDWITH*) 
        (*ENDIF*) 
        IF  b_err = e_duplicate_sysinfo
        THEN
            a07_b_put_error (acv, e_duplicate_name,
                  a_ap_tree^[ 2 ].n_pos)
        ELSE
            BEGIN
            IF  b_err = e_ok
            THEN
                BEGIN
                a1sysk           := a_p_arr1.pbasep^.syskey;
                a1sysk.sentrytyp := cak_edomain;
                a10_nil_get_sysinfo (acv, a1sysk, d_release,
                      sizeof (tak_domainrecord), dombuf, b_err)
                END;
            (*ENDIF*) 
            IF  b_err = e_ok
            THEN
                WITH a_p_arr1.pbasep^.sbase, dombuf^.sdomain DO
                    BEGIN
                    dom_segmentid  := cak00_public_segment_id;
                    dom_constraint := a_ap_tree^[1].n_sa_level > 0;
                    dom_filler     := 0;
                    FOR ix := 1 TO sizeof (dom_type_uid) DO
                        dom_type_uid[ix] := chr(0);
                    (*ENDFOR*) 
                    a11put_date_time (dom_date, dom_time);
                    a061colinfo_to_var (bcolumn[bfirstindex]^, dom_colinfo);
                    a10add_sysinfo (acv, dombuf, b_err)
                    END;
                (*ENDWITH*) 
            (*ENDIF*) 
            IF  b_err = e_ok
            THEN
                BEGIN
                a1ti := a_ap_tree^[ 1 ].n_sa_level;
                a11condition (acv, a11v, 1, cak_is_undefined);
                a10key_del (acv, a_p_arr1.pbasep)
                END
            ELSE
                a07_b_put_error (acv, b_err, 1)
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12drop_domain (VAR acv : tak_all_command_glob;
            domain_ref : tak_sysbufferaddress);
 
VAR
      b_err      : tgg00_BasisError;
      owner_id   : tgg00_Surrogate;
      owner_name : tsp00_KnlIdentifier;
      dom_name   : tsp00_KnlIdentifier;
      domain_def : tak_sysbufferaddress;
      sysk       : tgg00_SysInfoKey;
      qual       : tak_del_tab_qual;
 
BEGIN
owner_id       := domain_ref^.sdomainref.downer;
dom_name       := domain_ref^.sdomainref.dname;
sysk           := a01defaultkey;
sysk.sentrytyp := cak_edomain;
sysk.stableid  := domain_ref^.sdomainref.dsurrogate;
a10get_sysinfo (acv, sysk,
      d_fix, domain_def, b_err);
IF  b_err = e_ok
THEN
    ak12drop_references (acv, owner_id, dom_name,
          domain_def^.syskey.stableid,
          domain_def^.sdomain.dom_colinfo.cdatatyp = dudt)
ELSE
    a07_b_put_error (acv, b_err, 1);
(*ENDIF*) 
IF  acv.a_returncode = 0
THEN
    IF  domain_def^.sdomain.dom_colinfo.cdatatyp = dudt
    THEN
        BEGIN
        ak12drop_methods    (acv, domain_def^.sdomain.dom_surrogate);
        ak12type_uid_syskey (domain_def^.sdomain.dom_type_uid, sysk);
        a10del_sysinfo (acv, sysk, b_err);
        IF  b_err <> e_ok
        THEN
            a07_b_put_error (acv, b_err, 1)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDIF*) 
IF  acv.a_returncode = 0
THEN
    BEGIN
    (* Delete sdomain, sdefault, sconstraint and sviewdesc *)
    (* catalog records                                     *)
    qual.del_qual_cnt  := 2;
    qual.del_colno     := 1;
    qual.del_qual[ 1 ] := cak_edomain;
    qual.del_qual[ 2 ] := cak_eusage;
    IF  (ctdefault in domain_def^.sdomain.dom_colinfo.ccolpropset) OR
        (ctserial  in domain_def^.sdomain.dom_colinfo.ccolpropset)
    THEN
        BEGIN
        qual.del_qual_cnt  := 2;
        qual.del_qual[ 2 ] := cak_edefault
        END;
    (*ENDIF*) 
    IF  domain_def^.sdomain.dom_constraint
    THEN
        BEGIN
        qual.del_qual[ qual.del_qual_cnt+1 ] := cak_econstraint;
        qual.del_qual[ qual.del_qual_cnt+2 ] := cak_eviewdesc;
        qual.del_qual_cnt := qual.del_qual_cnt + 2
        END;
    (*ENDIF*) 
    IF  ctcomment in domain_def^.sdomain.dom_colinfo.ccolpropset
    THEN
        BEGIN
        qual.del_qual[ qual.del_qual_cnt+1 ] := cak_ecomment;
        qual.del_qual_cnt := qual.del_qual_cnt + 1
        END;
    (*ENDIF*) 
    a10_del_tab_sysinfo (acv,
          domain_def^.syskey.stableid, qual, false, b_err);
    IF  b_err = e_ok
    THEN
        a10del_sysinfo (acv, domain_ref^.syskey, b_err);
    (*ENDIF*) 
    IF  b_err = e_ok
    THEN
        BEGIN
        a06determine_username (acv, owner_id, owner_name);
        a38domain_drop        (acv, owner_name, dom_name)
        END
    ELSE
        a07_b_put_error (acv, b_err, 1);
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12drop_methods (VAR acv : tak_all_command_glob;
            VAR domain_id : tgg00_Surrogate);
 
VAR
      b_err       : tgg00_BasisError;
      sysbuf      : tak_sysbufferaddress;
      sysk        : tgg00_SysInfoKey;
      method_sysk : tgg00_SysInfoKey;
 
BEGIN
method_sysk           := a01defaultkey;
method_sysk.sentrytyp := cak_emethod;
sysk                  := a01defaultkey;
sysk.stableid         := domain_id;
sysk.sentrytyp        := cak_emethodref;
REPEAT
    a10next_sysinfo (acv, sysk,
          sizeof (sysk.stableid) + sizeof (sysk.sentrytyp), d_release,
          cak_emethodref, sysbuf, b_err);
    IF  b_err = e_ok
    THEN
        BEGIN
        method_sysk.stableid := sysbuf^.smethodref.mrf_method_id;
        a10del_sysinfo (acv, method_sysk, b_err);
        IF  b_err = e_ok
        THEN
            a10del_sysinfo (acv, sysk, b_err)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
UNTIL
    b_err <> e_ok;
(*ENDREPEAT*) 
IF  b_err <> e_no_next_record
THEN
    a07_b_put_error (acv, b_err, 1)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12output_parameter (VAR acv : tak_all_command_glob;
            method_buf     : tak_sysbufferaddress;
            VAR inout_idx  : integer;
            VAR colinf     : tak00_scolinf);
 
VAR
      ix : integer;
 
BEGIN
inout_idx  := 0;
ix         := 1;
WHILE  ix <= method_buf^.smethod.me_param_cnt DO
    IF  method_buf^.smethod.me_param_list[ix]^.param_in_out[2] in
        [chr(sp1io_output), chr (sp1io_inout)]
    THEN
        BEGIN
        IF  method_buf^.smethod.me_param_list[ix]^.param_in_out[2] =
            chr (sp1io_inout)
        THEN
            inout_idx := ix;
        (*ENDIF*) 
        a12describe_param (acv, method_buf, -ix, colinf);
        ix := csp_maxint2
        END
    ELSE
        ix := ix + 1
    (*ENDIF*) 
(*ENDWHILE*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      a12dbproc_exist (VAR acv : tak_all_command_glob;
            VAR owner      : tsp00_KnlIdentifier;
            VAR dbproc     : tsp00_KnlIdentifier;
            dstate         : tak_directory_state;
            VAR method_buf : tak_sysbufferaddress) : boolean;
 
VAR
      isUnicodeClient : boolean;
      lastMemberSize  : integer;
      ix              : integer;
      jx              : integer;
      alignment       : integer;
      maxAlignment    : integer;
      owner_id        : tgg00_Surrogate;
 
BEGIN
a12dbproc_exist := false;
a06det_user_id (acv, owner, owner_id);
IF  a12method_exist (acv, owner_id, dbproc, dstate, method_buf)
THEN
    IF  method_buf^.smethod.me_type = dbo_dbproc
    THEN
        BEGIN
        a12dbproc_exist := true;
        IF  NOT a260IsInternalDBProc (method_buf^.smethod)
        THEN
            BEGIN
            isUnicodeClient := acv.a_cmd_packet_header.sp1h_mess_code in [csp_unicode_swap, csp_unicode];
            ix              := 1;
            WHILE ix < method_buf^.smethod.me_param_cnt DO
                WITH method_buf^.smethod.me_param_list[ix]^ DO
                    BEGIN
                    IF  param_com_datatype = csp1_vt_userdefined
                    THEN
                        BEGIN
                        (* current parameter is a c struct. In this case param_cpp_offset is used *)
                        (* to store the size of the structure from the client point of view       *)
                        jx           := 1;
                        maxAlignment := 1;
                        WHILE jx <= param_datafrac DO
                            BEGIN
                            CASE method_buf^.smethod.me_param_list[ix+jx]^.param_com_datatype OF
                                csp1_vt_bool,
                                csp1_vt_i1,
                                csp1_vt_ui1,
                                csp1_vt_lc_byte,
                                csp1_vt_lc_int1,
                                csp1_vt_lc_uint1,
                                csp1_vt_lc_bool :
                                    BEGIN
                                    alignment      := 1;
                                    lastMemberSize := 1;
                                    END;
                                csp1_vt_i2,
                                csp1_vt_ui2 :
                                    BEGIN
                                    alignment      := 2;
                                    lastMemberSize := 2;
                                    END;
                                csp1_vt_i4,
                                csp1_vt_ui4,
                                csp1_vt_int,
                                csp1_vt_uint,
                                csp1_vt_r4 :
                                    BEGIN
                                    alignment      := 4;
                                    lastMemberSize := 4;
                                    END;
                                csp1_vt_r8,
                                csp1_vt_i8,
                                csp1_vt_ui8 :
                                    BEGIN
                                    alignment      := 8;
                                    lastMemberSize := 8;
                                    END;
                                csp1_vt_lc_char,
                                csp1_vt_lc_ascii7 :
                                    BEGIN
                                    IF  isUnicodeClient
                                    THEN
                                        alignment := 2
                                    ELSE
                                        alignment := 1;
                                    (*ENDIF*) 
                                    lastMemberSize := alignment;
                                    END;
                                csp1_vt_lc_wyde :
                                    BEGIN
                                    IF  isUnicodeClient
                                    THEN
                                        alignment := 2
                                    ELSE
                                        alignment := 1;
                                    (*ENDIF*) 
                                    lastMemberSize := alignment;
                                    END;
                                csp1_vt_carray :
                                    BEGIN
                                    lastMemberSize := method_buf^.smethod.me_param_list[ix+param_datafrac]^.param_datalength;
                                    alignment      := 1;
                                    IF  isUnicodeClient AND
                                        (method_buf^.smethod.me_param_list[ix+param_datafrac]^.param_datatype in
                                        [dcha, dwyde])
                                    THEN
                                        BEGIN
                                        lastMemberSize := lastMemberSize * 2;
                                        alignment      := 2;
                                        END;
                                    (*ENDIF*) 
                                    END;
                                OTHERWISE
                                    ak12unsupported_type (acv,
                                          method_buf^.smethod.me_param_list[ix+param_datafrac]^.param_com_datatype, 0);
                                END;
                            (*ENDCASE*) 
                            IF  alignment > maxAlignment
                            THEN
                                maxAlignment := alignment;
                            (*ENDIF*) 
                            IF  NOT acv.a_pseudoUnicodeClient
                            THEN
                                IF  isUnicodeClient
                                THEN
                                    BEGIN
                                    IF  (method_buf^.smethod.me_param_list[ix+jx]^.param_cpp_offset <>
                                        method_buf^.smethod.me_param_list[ix+jx]^.param_unicode_offset)
                                        OR
                                        (method_buf^.smethod.me_param_list[ix+jx]^.param_datatype = dcha)
                                    THEN
                                        BEGIN
                                        param_state := param_new;
                                        END;
                                    (*ENDIF*) 
                                    END
                                ELSE
                                    IF  (method_buf^.smethod.me_param_list[ix+jx]^.param_cpp_offset <>
                                        method_buf^.smethod.me_param_list[ix+jx]^.param_ascii_offset)
                                        OR
                                        (method_buf^.smethod.me_param_list[ix+jx]^.param_datatype = dwyde)
                                    THEN
                                        BEGIN
                                        param_state := param_new;
                                        END;
                                    (*ENDIF*) 
                                (*ENDIF*) 
                            (*ENDIF*) 
                            jx := jx + 1;
                            END;
                        (*ENDWHILE*) 
                        IF  param_state <> param_new
                        THEN
                            param_cpp_offset := param_datalength
                        ELSE
                            BEGIN
                            IF  isUnicodeClient
                            THEN
                                BEGIN
                                param_cpp_offset :=
                                      ((method_buf^.smethod.me_param_list[ix+param_datafrac]^.param_unicode_offset +
                                      lastMemberSize + maxAlignment - 1) DIV maxAlignment) * maxAlignment;
                                END
                            ELSE
                                BEGIN
                                param_cpp_offset :=
                                      ((method_buf^.smethod.me_param_list[ix+param_datafrac]^.param_ascii_offset +
                                      lastMemberSize + maxAlignment - 1) DIV maxAlignment) * maxAlignment;
                                END;
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    ix := ix + 1;
                    END;
                (*ENDWITH*) 
            (*ENDWHILE*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12describe_param  (VAR acv : tak_all_command_glob;
            method_buf   : tak_sysbufferaddress;
            param_no     : integer;
            VAR colinf   : tak00_scolinf);
 
VAR
      parm : integer;
 
BEGIN
parm := abs(param_no);
colinf.sci_typ := dunknown;
IF  parm <= method_buf^.smethod.me_param_cnt
THEN
    WITH method_buf^.smethod,
         me_param_list[parm]^ DO
        BEGIN
        colinf.sci_typ       := param_datatype;
        colinf.sci_len       := param_datalength;
        colinf.sci_frac      := param_datafrac - cak_frac_offset;
        colinf.sci_iolen     := param_inoutlength;
        colinf.sci_cprops    := [];
        colinf.sci_com_type  := param_com_datatype;
        colinf.sci_udt_id    := param_type_id;
&       ifdef trace
        t01int4 (ak_sem, 'datatype    ', ord (param_datatype));
        t01int4 (ak_sem, 'com_datatype', param_com_datatype);
        t01int4 (ak_sem, 'type_id     ',
              ord (param_type_id[1]) * 256 + ord (param_type_id[2]));
&       endif
        END
    (*ENDWITH*) 
ELSE
    a07_b_put_error (acv, e_too_many_values, 1)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      a12EvalDataLength (VAR acv : tak_all_command_glob;
            p : tak_sysbufferaddress) : integer;
 
VAR
      res      : tsp00_NumError;
      dest     : tsp00_Int4;
      mblock_p : tgg00_MessBlockPtr;
 
BEGIN
a12EvalDataLength := -1;
mblock_p := @p^.smessblock.mbr_mess_block;
mblock_p^.mb_qual^.mbool := true; (* no sql to parse *)
a262Call (acv, p, @mblock_p^.mb_data^.mbp_buf);
IF  acv.a_returncode = 0
THEN
    BEGIN
    IF  mblock_p^.mb_data^.mbp_buf[cgg_rec_key_offset + 6] = csp_defined_byte
    THEN
        BEGIN
        s40glint (mblock_p^.mb_data^.mbp_buf, cgg_rec_key_offset + 7,
              (cak12_param_io_length - 2) * 2, dest, res);
        IF  res = num_ok
        THEN
            a12EvalDataLength := dest
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
a10rel_sysinfo(p)
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12FindParameter(VAR acv : tak_all_command_glob;
            VAR ownerid : tgg00_Surrogate;
            VAR dbproc  : tsp00_KnlIdentifier;
            paramNo     : integer;
            VAR pInfo   : tak_param_info_ptr);
 
VAR
      ix          : integer;
      currParamNo : integer;
      method_buf  : tak_sysbufferaddress;
 
BEGIN
pInfo := NIL;
IF  a12method_exist (acv, ownerid, dbproc, d_release, method_buf)
THEN
    BEGIN
    ix          := 1;
    currParamNo := 1;
    WHILE currParamNo < paramNo DO
        BEGIN
        REPEAT
            ix := ix + 1;
            IF  ix > method_buf^.smethod.me_param_cnt
            THEN
                BEGIN
                ix          := 1;
                currParamNo := csp_maxint2;
                END;
            (*ENDIF*) 
        UNTIL
            (method_buf^.smethod.me_param_list[ix]^.param_name_len <> chr(0));
        (*ENDREPEAT*) 
        currParamNo := currParamNo + 1;
        END;
    (*ENDWHILE*) 
    IF  currParamNo <> csp_maxint2
    THEN
        pInfo := method_buf^.smethod.me_param_list[ix]
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      a12exist_type (VAR acv : tak_all_command_glob;
            VAR tree_node  : integer;
            VAR owner      : tsp00_KnlIdentifier;
            VAR type_name  : tsp00_KnlIdentifier;
            VAR type_buf   : tak_sysbufferaddress) : boolean;
 
VAR
      dom_ref : tak_sysbufferaddress;
 
BEGIN
a12get_domain (acv, owner, type_name, tree_node, dom_ref, type_buf);
IF  acv.a_returncode = 0
THEN
    IF  type_buf^.sdomain.dom_colinfo.cdatatyp <> dudt
    THEN
        BEGIN
        type_buf := NIL;
        a07_nb_put_error (acv, e_unknown_name,
              acv.a_ap_tree^[tree_node].n_pos, type_name)
        END;
    (*ENDIF*) 
(*ENDIF*) 
a12exist_type := acv.a_returncode = 0
END;
 
(*------------------------------*) 
 
FUNCTION
      a12dbfunc_exist (VAR acv : tak_all_command_glob;
            VAR owner       : tsp00_KnlIdentifier;
            VAR dbfunc_name : tsp00_KnlIdentifier;
            dstate          : tak_directory_state;
            VAR method_buf  : tak_sysbufferaddress) : boolean;
 
VAR
      exists  : boolean;
      ownerId : tgg00_Surrogate;
 
BEGIN
exists := false;
IF  owner = a01_il_b_identifier
THEN
    ownerId := acv.a_curr_user_id
ELSE
    a06det_user_id (acv, owner, ownerId);
(*ENDIF*) 
IF  a12method_exist (acv, ownerId, dbfunc_name, dstate, method_buf)
THEN
    IF  method_buf^.smethod.me_type = dbo_dbfunc
    THEN
        exists := true;
    (*ENDIF*) 
(*ENDIF*) 
IF  NOT exists AND (owner = a01_il_b_identifier)
THEN
    BEGIN (* look for public dbfunction *)
    ownerId := cak_public_id;
    IF  a12method_exist (acv, ownerId, dbfunc_name, dstate, method_buf)
    THEN
        IF  method_buf^.smethod.me_type = dbo_dbfunc
        THEN
            exists := true
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
a12dbfunc_exist := exists
END;
 
(*------------------------------*) 
 
FUNCTION
      a12method_exist (VAR acv : tak_all_command_glob;
            VAR type_id     : tgg00_Surrogate;
            VAR method_name : tsp00_KnlIdentifier;
            dstate          : tak_directory_state;
            VAR method_buf  : tak_sysbufferaddress) : boolean;
 
VAR
      b_err : tgg00_BasisError;
      sysk  : tgg00_SysInfoKey;
 
BEGIN
sysk           := a01defaultkey;
sysk.sauthid   := type_id;
sysk.sentrytyp := cak_emethodref;
sysk.sappl     := method_name;
sysk.skeylen   := sysk.skeylen + sizeof (sysk.sappl);
a10get_sysinfo (acv, sysk,
      d_release, method_buf, b_err);
IF  b_err = e_ok
THEN
    BEGIN
    sysk           := a01defaultkey;
    sysk.stableid  := method_buf^.smethodref.mrf_method_id;
    sysk.sentrytyp := cak_emethod;
    a10get_sysinfo (acv, sysk,
          dstate, method_buf, b_err)
    END;
(*ENDIF*) 
IF  b_err <> e_ok
THEN
    IF  b_err <> e_sysinfo_not_found
    THEN
        a07_b_put_error (acv, b_err, 1);
    (*ENDIF*) 
(*ENDIF*) 
a12method_exist := b_err = e_ok
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12NewMethod (VAR acv : tak_all_command_glob;
            VAR OwnerId     : tgg00_Surrogate;
            VAR DBFuncName  : tsp00_KnlIdentifier;
            VAR MethodName  : tsp00_KnlIdentifier;
            ErrorPos        : tsp00_Int4;
            VAR IsReplace   : boolean;
            MethodType      : tsp00_DbObjectType;
            ProgId          : tsp00_C64;
            VAR language    : tsp00_KnlIdentifier;
            VAR methodbuf   : tak_sysbufferaddress);
 
VAR
      ix            : integer;
      b_err         : tgg00_BasisError;
      DBFuncId      : tsp00_C2;
      ReplRefBuf    : boolean;
      methodrefbuf  : tak_sysbufferaddress;
      methodinfobuf : tak_sysbufferaddress;
      MethodId      : tgg00_Surrogate;
      sysk          : tgg00_SysInfoKey;
 
BEGIN
b_err      := e_ok;
ReplRefBuf := false;
a05surrogate_get (acv, MethodId);
IF  MethodType = dbo_dbfunc
THEN
    MethodId[1] := chr(ord(st_surrogate));
(*ENDIF*) 
IF  acv.a_is_ddl <> ddl_create_trigger
THEN
    BEGIN
    sysk           := a01defaultkey;
    sysk.sauthid   := OwnerId;
    sysk.sentrytyp := cak_emethodref;
    sysk.sappl     := MethodName;
    sysk.skeylen   := sysk.skeylen + sizeof (sysk.sappl);
    a10_fix_len_get_sysinfo (acv, sysk, d_release,
          sizeof (tak_methodrefrecord), 0, methodrefbuf, b_err);
    IF  (acv.a_returncode = 0)
    THEN
        IF  b_err = e_ok
        THEN
            IF  NOT IsReplace
            THEN
                BEGIN
                b_err := e_duplicate_name;
                a07_nb_put_error (acv, b_err, ErrorPos, MethodName)
                END
            ELSE
                BEGIN
                MethodId := methodrefbuf^.smethodref.mrf_method_id;
                END
            (*ENDIF*) 
        ELSE
            WITH methodrefbuf^.smethodref DO
                BEGIN
                IsReplace     := false;
                b_err         := e_ok;
                mrf_segmentid := cak00_public_segment_id;
                mrf_type      := MethodType;
                mrf_filler    := false;
                mrf_method_id := MethodId;
                END
            (*ENDWITH*) 
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  NOT IsReplace AND (acv.a_is_ddl <> ddl_create_trigger) AND (b_err = e_ok)
THEN
    BEGIN
    a10_add_repl_sysinfo (acv, methodrefbuf, NOT ReplRefBuf, b_err);
    IF  b_err = e_duplicate_sysinfo
    THEN
        BEGIN
        IF  MethodType = dbo_dbfunc
        THEN
            MethodName := DBFuncName;
        (*ENDIF*) 
        a07_nb_put_error (acv, e_duplicate_name, ErrorPos, MethodName)
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  b_err = e_ok
THEN
    BEGIN
    sysk           := a01defaultkey;
    sysk.stableid  := MethodId;
    sysk.sentrytyp := cak_emethodinfo;
    IF  IsReplace
    THEN
        a10get_sysinfo (acv, sysk,
              d_fix, methodinfobuf, b_err)
    ELSE
        a10_nil_get_sysinfo (acv, sysk, d_fix,
              sizeof (tak_method_inforecord), methodinfobuf, b_err);
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  b_err = e_ok
THEN
    WITH methodinfobuf^.smethodinfo DO
        BEGIN
        mei_segmentid      := cak00_public_segment_id;
        mei_comment        := false;
        mei_owner          := acv.a_curr_user_id;
        mei_name           := MethodName;
        a11put_date_time (mei_date, mei_time);
        mei_prog_id        := ProgId;
        mei_language       := language;
        a10_add_repl_sysinfo (acv, methodinfobuf, NOT IsReplace, b_err)
        END;
    (*ENDWITH*) 
(*ENDIF*) 
IF  b_err = e_ok
THEN
    BEGIN
    sysk.sentrytyp := cak_emethod;
    IF  IsReplace
    THEN
        a10get_sysinfo (acv, sysk,
              d_fix, methodbuf, b_err)
    ELSE
        a10_nil_get_sysinfo (acv, sysk, d_fix,
              sizeof (tak_methodrecord), methodbuf, b_err)
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  b_err = e_ok
THEN
    WITH methodbuf^.smethod DO
        BEGIN
        me_segmentid           := cak00_local_segment_id;
        me_param_cnt           := 0;
        me_type                := MethodType;
        me_debug               := dbg_inproc;
        me_sql                 := false;
        me_cursor              := false;
        me_dispid              := 0;
        me_coclsid             := bsp_c16;
        me_iid                 := bsp_c16;
        me_package_id          := cgg_zero_id;
        IF  NOT IsReplace
        THEN
            FOR ix := 1 TO cak_max_param_index DO
                me_param_list[ix] := NIL;
            (*ENDFOR*) 
        (*ENDIF*) 
        END
    (*ENDWITH*) 
ELSE
    a07_b_put_error (acv, b_err, 1)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12type_uid_to_id (VAR acv : tak_all_command_glob;
            VAR type_uid : tsp00_C16;
            VAR type_id  : tsp00_C2);
 
VAR
      b_err : tgg00_BasisError;
      sysk  : tgg00_SysInfoKey;
      p     : tak_sysbufferaddress;
 
BEGIN
ak12type_uid_syskey (type_uid, sysk);
a10get_sysinfo (acv, sysk,
      d_release, p, b_err);
IF  b_err = e_ok
THEN
    type_id := p^.stypeuidmap.tum_id
ELSE
    BEGIN
    type_id := cgg_zero_c2;
    IF  b_err <> e_sysinfo_not_found
    THEN
        a07_b_put_error (acv, b_err, 1)
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12domainref_syskey (VAR owner_id    : tgg00_Surrogate;
            VAR domain_name : tsp00_KnlIdentifier;
            VAR sysk        : tgg00_SysInfoKey);
 
BEGIN
sysk.sauthid     := owner_id;
sysk.sentrytyp   := cak_edomainref;
sysk.slinkage    := cak_init_linkage;
sysk.sidentifier := domain_name;
sysk.skeylen     := mxak_standard_sysk + sizeof (domain_name);
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12drop_package (VAR acv : tak_all_command_glob;
            start_node : tsp00_Int4);
 
VAR
      b_err         : tgg00_BasisError;
      next_exists   : boolean;
      ix            : integer;
      method_buf    : tak_sysbufferaddress;
      usage_buf     : tak_sysbufferaddress;
      sysk          : tgg00_SysInfoKey;
      method_sysk   : tgg00_SysInfoKey;
      package_name  : tsp00_KnlIdentifier;
 
BEGIN
a05identifier_get (acv, start_node, sizeof (package_name), package_name);
IF  a12package_exist (acv, acv.a_curr_user_name, package_name, method_buf)
THEN
    BEGIN
    sysk                  := method_buf^.syskey;
    sysk.sentrytyp        := cak_eusage;
    (* drop all procedures of package *)
    method_sysk           := a01defaultkey;
    method_sysk.sentrytyp := cak_emethod;
    REPEAT
        a10get_sysinfo (acv, sysk,
              d_fix, usage_buf, b_err);
        IF  b_err = e_ok
        THEN
            WITH usage_buf^.susage DO
                BEGIN
                ix := 1;
                WHILE (ix <= usagecount) AND
                      (b_err = e_ok)     AND
                      (acv.a_returncode = 0) DO
                    BEGIN
                    method_sysk.stableid := usagedef[ix].usa_tableid;
                    a10get_sysinfo (acv, method_sysk,
                          d_fix, method_buf, b_err);
                    IF  b_err = e_ok
                    THEN
                        a261drop_procedure (acv, method_buf, acv.a_curr_user_id);
                    (*ENDIF*) 
                    ix := ix + 1
                    END;
                (*ENDWHILE*) 
                next_exists := usagenext_exist;
                IF  b_err = e_ok
                THEN
                    a10del_sysinfo (acv, sysk, b_err);
                (*ENDIF*) 
                IF  b_err = e_ok
                THEN
                    IF  next_exists
                    THEN
                        a06inc_linkage (sysk.slinkage)
                    ELSE
                        b_err := e_no_next_record;
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            (*ENDWITH*) 
        ELSE
            IF  (b_err = e_sysinfo_not_found) AND (sysk.slinkage = cak_init_linkage)
            THEN
                b_err := e_no_next_record;
            (*ENDIF*) 
        (*ENDIF*) 
    UNTIL
        b_err <> e_ok;
    (*ENDREPEAT*) 
    IF  b_err <> e_no_next_record
    THEN
        a07_b_put_error (acv, b_err, 1)
    ELSE (* drop package catalog information *)
        IF  a12package_exist (acv, acv.a_curr_user_name, package_name, method_buf)
        THEN (* information may have been removed from cache, read again *)
            a261drop_procedure (acv, method_buf, acv.a_curr_user_id)
        ELSE
            a07ak_system_error (acv, 12, 1)
        (*ENDIF*) 
    (*ENDIF*) 
    END
ELSE
    a07_nb_put_error (acv, e_unknown_name, acv.a_ap_tree^[start_node].n_pos,
          package_name);
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12drop_domain (VAR acv : tak_all_command_glob;
            VAR a11v : tak_a11_glob);
 
VAR
      domain_ref : tak_sysbufferaddress;
      domain_def : tak_sysbufferaddress;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    a12get_domain (acv,
          a1authname, a1tablen, a1ti, domain_ref, domain_def);
    IF  a_returncode = 0
    THEN
        IF  a1authname <> a_curr_user_name
        THEN
            a07_kw_put_error (acv, e_missing_privilege,
                  a_ap_tree^[a1ti].n_pos, cak_i_userid)
        ELSE (*
              IF  domain_def^.sdomain.dom_colinfo.cdatatyp = dudt
              THEN
              a07_nb_put_error (acv, e_unknown_domainname,
              a_ap_tree^[ a1ti ].n_pos, a1tablen);
              ELSE *)
            a12drop_domain (acv, domain_ref)
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12drop_references (VAR acv : tak_all_command_glob;
            VAR domain_owner : tgg00_Surrogate;
            VAR domain_name  : tsp00_KnlIdentifier;
            VAR domain_id    : tgg00_Surrogate;
            restrict_ref     : boolean);
 
VAR
      b_err     : tgg00_BasisError;
      ix        : integer;
      usage_buf : tak_sysbufferaddress;
      usage_key : tgg00_SysInfoKey;
 
BEGIN
usage_key           := a01defaultkey;
usage_key.stableid  := domain_id;
usage_key.sentrytyp := cak_eusage;
REPEAT
    a10get_sysinfo (acv, usage_key,
          d_fix, usage_buf, b_err);
    IF  b_err = e_ok
    THEN
        BEGIN
        ix := 1;
        WHILE ix <= usage_buf^.susage.usagecount DO
            WITH usage_buf^.susage.usagedef[ix] DO
                BEGIN
                ak12table_drop_dom_references (acv,
                      domain_owner, domain_name,
                      usa_tableid, restrict_ref);
                ix := ix + 1
                END;
            (*ENDWITH*) 
        (*ENDWHILE*) 
        IF  NOT usage_buf^.susage.usagenext_exist
        THEN (* no succ usage record *)
            b_err := e_sysinfo_not_found
        (*ENDIF*) 
        END;
    (*ENDIF*) 
UNTIL
    (b_err <> e_ok) OR (acv.a_returncode <> 0);
(*ENDREPEAT*) 
IF  b_err <> e_sysinfo_not_found
THEN
    a07_b_put_error (acv, b_err, 1)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12get_domain_identifiers (VAR acv : tak_all_command_glob;
            VAR ti          : integer;
            VAR owner       : tsp00_KnlIdentifier;
            VAR domain_name : tsp00_KnlIdentifier);
 
BEGIN
WITH acv DO
    IF  a_ap_tree^[ti].n_symb = s_authid
    THEN
        a06get_username (acv, ti, owner)
    ELSE
        owner := a01_il_b_identifier;
    (*ENDIF*) 
(*ENDWITH*) 
a05identifier_get  (acv, ti, sizeof (domain_name), domain_name);
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12store_serial_value (VAR acv : tak_all_command_glob;
            VAR a11v : tak_a11_glob);
 
VAR
      curr_len : integer;
      b_err    : tgg00_BasisError;
      sysbuf   : tak_sysbufferaddress;
      param    : tsp00_C10;
      sysk     : tgg00_SysInfoKey;
 
BEGIN
WITH acv, a11v DO
    BEGIN
    sysk           := a_p_arr1.pbasep^.syskey;
    sysk.sentrytyp := cak_edefault;
    a10_nil_get_sysinfo (acv, sysk, d_release, sizeof (tak_defaultrecord),
          sysbuf, b_err);
    IF  b_err = e_ok
    THEN
        WITH sysbuf^.sdefault DO
            BEGIN
            dfsegment_id       := cak00_public_segment_id;
            dfdefault_function := 0;
            a1serial_node      := a_ap_tree^[a1serial_node].n_lo_level;
            IF  a1serial_node > 0
            THEN
                BEGIN
                a1serial_node      := a_ap_tree^[a1serial_node].n_lo_level;
                IF  a_ap_tree^[a1serial_node].n_pos > 0
                THEN
                    a05_li_constant_get (acv, a1serial_node,
                          a1colptr^, a1colptr^.cinoutlen,
                          sizeof (dfvalues), dfvalues, 2, curr_len)
                ELSE
                    dfvalues[2] := chr(128);
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                dfvalues[2] := csp_defined_byte;
                dfvalues[3] := chr(193);
                dfvalues[4] := chr(16);
                curr_len    := 3
                END;
            (*ENDIF*) 
            dfvalues[1] := chr(curr_len);
            IF  dfvalues [3] = chr(128)
            THEN
                BEGIN
                param := 'START < 1 ';
                a07_const_b_put_error (acv, e_invalid_sequence,
                      a_ap_tree^[a1serial_node].n_pos,
                      @param, sizeof (param))
                END
            ELSE
                BEGIN
                a1serial_node := 0;
                dfreclen      := dfreclen - sizeof (dfvalues) + 1 + curr_len;
                a10add_sysinfo (acv, sysbuf, b_err)
                END
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
    (*ENDIF*) 
    IF  b_err = e_ok
    THEN
        a07_b_put_error (acv, b_err, 1)
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ak12table_drop_dom_references (VAR acv : tak_all_command_glob;
            VAR domain_owner : tgg00_Surrogate;
            VAR domain_name  : tsp00_KnlIdentifier;
            VAR tableid      : tgg00_Surrogate;
            restrict_ref     : boolean);
 
CONST
      c_get_all    = true;
      c_scan_views = true;
 
VAR
      ok      : boolean;
      b_err   : tgg00_BasisError;
      jx      : integer;
      b       : tak_sysbufferaddress;
      base_ptr: tak_sysbufferaddress;
      sysk    : tgg00_SysInfoKey;
 
BEGIN
a06_systable_get (acv, d_fix, tableid, base_ptr, c_get_all, ok);
IF  restrict_ref AND ok
THEN
    BEGIN
    ok := false;
    a07_nb_put_error (acv, e_missing_privilege, 1,
          base_ptr^.sbase.btablen^)
    END;
(*ENDIF*) 
IF  ok
THEN
    BEGIN
    sysk           := base_ptr^.syskey;
    sysk.sentrytyp := cak_edomainusage;
    WITH base_ptr^.sbase DO
        FOR jx := bfirstindex TO blastindex DO
            WITH bcolumn[jx]^ DO
                IF  ctdomain in ccolpropset
                THEN
                    BEGIN (* curr column defined via default *)
                    sysk.slinkage[1] := chr (cextcolno DIV 256);
                    sysk.slinkage[2] := chr (cextcolno MOD 256);
                    a10get_sysinfo (acv, sysk,
                          d_release, b, b_err);
                    IF  b_err = e_ok
                    THEN
                        IF  (b^.scol_uses_dom.cud_owner = domain_owner)
                            AND
                            (b^.scol_uses_dom.cud_name = domain_name)
                        THEN
                            BEGIN
                            (* curr column defined by default     *)
                            (* to be dropped, => delete reference *)
                            ccolpropset := ccolpropset - [ctdomain];
                            a10del_sysinfo (acv, sysk, b_err);
                            END;
                        (*ENDIF*) 
                    (*ENDIF*) 
                    IF  b_err <> e_ok
                    THEN
                        a07_b_put_error (acv, b_err, 1)
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDWITH*) 
        (*ENDFOR*) 
    (*ENDWITH*) 
    IF  acv.a_returncode = 0
    THEN
        a10_version (acv, base_ptr^.sbase,
              m_succ_file_version, c_scan_views);
    (*ENDIF*) 
    IF  acv.a_returncode = 0
    THEN
        BEGIN
        a10repl_sysinfo (acv, base_ptr, b_err);
        IF  b_err <> e_ok
        THEN
            a07_b_put_error (acv, b_err, 1)
        ELSE
            a10rel_sysinfo (base_ptr);
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12get_domain (VAR acv : tak_all_command_glob;
            VAR owner       : tsp00_KnlIdentifier;
            VAR domain_name : tsp00_KnlIdentifier;
            ti              : integer;
            VAR domain_ref  : tak_sysbufferaddress;
            VAR domain_def  : tak_sysbufferaddress);
 
VAR
      owner_specified  : boolean;
      b_err            : tgg00_BasisError;
      dstate           : tak_directory_state;
      loop_cnt         : integer;
      sysk             : tgg00_SysInfoKey;
      owner_id         : tgg00_Surrogate;
 
BEGIN
WITH acv DO
    BEGIN
    ak12get_domain_identifiers (acv, ti, owner, domain_name);
    owner_specified := owner <> a01_il_b_identifier;
    IF  NOT owner_specified
    THEN (* start search from a dba *)
        IF  a_current_user_kind in [uprivate, unoprivate]
        THEN
            BEGIN
            owner    := a_acc_dbaname;
            owner_id := a_acc_dba_id;
            END
        ELSE
            BEGIN
            owner    := a_curr_user_name;
            owner_id := a_curr_user_id
            END
        (*ENDIF*) 
    ELSE
        a06det_user_id (acv, owner, owner_id);
    (*ENDIF*) 
    loop_cnt := 0;
    REPEAT
        loop_cnt := loop_cnt + 1;
        a12read_domain_ref (acv, owner_id, domain_name, domain_ref);
        IF  (domain_ref = NIL) AND
            NOT owner_specified
        THEN
            BEGIN
            CASE loop_cnt OF
                1 :
                    BEGIN
                    owner    := g01glob.sysuser_name;
                    owner_id := g01glob.sysuser_id
                    END;
                OTHERWISE
                    owner_specified := true
                END;
            (*ENDCASE*) 
            END;
        (*ENDIF*) 
    UNTIL
        (domain_ref <> NIL) OR owner_specified;
    (*ENDREPEAT*) 
    IF  domain_ref <> NIL
    THEN
        WITH domain_ref^.sdomainref DO
            BEGIN
            sysk           := a01defaultkey;
            sysk.stableid  := dsurrogate;
            sysk.sentrytyp := cak_edomain;
            IF  acv.a_is_ddl = ddl_drop_domain
            THEN
                dstate := d_fix
            ELSE
                dstate := d_release;
            (*ENDIF*) 
            a10get_sysinfo (acv, sysk,
                  dstate, domain_def, b_err);
            IF  b_err <> e_ok
            THEN
                a07_b_put_error (acv, b_err, 1)
            (*ENDIF*) 
            END
        (*ENDWITH*) 
    ELSE
        a07_nb_put_error (acv, e_unknown_domainname,
              a_ap_tree^[ ti ].n_pos, domain_name);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12read_domain_ref (VAR acv : tak_all_command_glob;
            VAR owner_id    : tgg00_Surrogate;
            VAR domain_name : tsp00_KnlIdentifier;
            VAR domain_ref  : tak_sysbufferaddress);
 
VAR
      b_err  : tgg00_BasisError;
      dstate : tak_directory_state;
      sysk   : tgg00_SysInfoKey;
 
BEGIN
domain_ref := NIL;
ak12domainref_syskey (owner_id, domain_name, sysk);
IF  acv.a_is_ddl = ddl_drop_domain
THEN
    dstate := d_fix
ELSE
    dstate := d_release;
(*ENDIF*) 
a10get_sysinfo (acv, sysk,
      dstate, domain_ref, b_err);
IF  (b_err <> e_ok) AND (b_err <> e_sysinfo_not_found)
THEN
    a07_b_put_error (acv, b_err, 1)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      a12reference (VAR acv : tak_all_command_glob;
            VAR dbproc_surrogate : tgg00_Surrogate;
            VAR owner            : tsp00_KnlIdentifier;
            VAR dbproc_name      : tsp00_KnlIdentifier);
 
VAR
      e              : tgg00_BasisError;
      methodinfo_buf : tak_sysbufferaddress;
      sysk           : tgg00_SysInfoKey;
 
BEGIN
sysk           := a01defaultkey;
sysk.stableid  := dbproc_surrogate;
sysk.sentrytyp := cak_emethodinfo;
a10get_sysinfo (acv, sysk,
      d_release, methodinfo_buf, e);
IF  e = e_ok
THEN
    BEGIN
    a06determine_username (acv,
          methodinfo_buf^.smethodinfo.mei_owner, owner);
    dbproc_name := methodinfo_buf^.smethodinfo.mei_name
    END
ELSE
    a07_b_put_error (acv, e, 1)
(*ENDIF*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
