Reusable Part S_154RDW: Domino Database Wrapper
Name: S_154RDW
Description: The following RDMLX reusable part is a wrapper component designed to wrapper the standard LANSA DOM_ built-in function interfaces to Domino.
;
* ======================================================;
* ======================================================;
* ======================================================;
* S_154RDW : Domino Database File Equivalent Wrapper Component;
* ======================================================;
* ======================================================;
* ======================================================;
* ;
* Disclaimer: The following material is supplied as example material only. ;
* ---------------- No warranty concerning this material or its use in any way;
* whatsoever is expressed or implied. ;
* ;
* =======;
* Methods;
* =======;
;
* Open ;
* Opens a Domino database (or table).;
;
* Close;
* Closes a Domino database (or table).;
;
* DefineItem;
* Defines an item to be used by later SetItem and GetItem methods. ;
;
* SetItem;
* Set the alpha or numeric value of an item;
;
* GetItem ;
* Get the alpha or numeric value of an item;
;
* Insert;
* Insert all current item values into a Domino database;
;
* Fetch;
* Fetch a row from a Domino database by key;
;
* Get;
* Get a row from a Domino database by document handle;
;
* Select ;
* Select a set of rows from a Domino database and return the first matching row;
;
* SelectNext;
* Select the the next matching row. Use after Select or SelectNext only. ;
;
* Update;
* Update a row in the Domino database (by document handle) ;
;
* Delete ;
* Delete a row in the Domino database (by document handle) ;
;
* ========;
* Properties;
* ========;
;
* ErrorDetected : TRUE or FALSE value indicating whether an error has been detected;
;
;
* ======;
* Events;
* ====== ;
;
* DominoErrorDetected : Signaled when an unexpected error rreturn code is received from Domino ;
;
;
;
;
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM DISPLAYPOSITION(1) HEIGHT(17) LEFT(0) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(20);
Define #Dom_DBMS *char 255 ;
Define #Dom_PORT *char 32 ;
Define #Dom_SRVR *char 255 ;
Define #Dom_HNDL *char 4;
Define #Dom_RETC *char 2;
Define #Dom_ERROR *char 1 ;
Define #Dom_OPER *char 1;
Define #Dom_HDOC *char 4;
Define #Dom_HTBL *char 4;
Define #Dom_HNOTE *dec 15 0;
Define #Dom_PNOTE *dec 15 0;
Define #Dom_NNOTE *dec 7 0 edit_code(4) ;
Define #Dom_XNOTE *dec 7 0 edit_code(4) ;
Define #Dom_CRIT *Char 255;
;
Define #Dom_SPACE RefFld(#SysVar$Av) Default(*Component);
Define #Dom_SPARC *Char 2;
Def_Cond *NoSpace '#Dom_SPARC *ne OK' ;
;
Define #KeyNo *dec 1 0 ;
Define #KeyValue *char 255;
Define #KeyAgg *char 255;
Def_List #KeyList (#KeyNo #KeyValue) Type(*Working) Entrys(99);
;
Def_Cond *SetOper '#Dom_Oper = S';
Def_Cond *NoError '#Dom_ERROR *NE Y ';
Def_Cond *Error '#Dom_ERROR = Y ';
Def_Cond *RetOK '#Dom_RETC = OK';
Def_Cond *NotRetOK '#Dom_RETC *ne OK';
;
Group_By Name(#XG_Domino) Fields(#Dom_CRIT #Dom_OPER #Dom_HDOC #Dom_HNOTE #Dom_NNOTE #Dom_ERROR #Dom_DBMS #Dom_PORT #Dom_SRVR #Dom_HNDL #Dom_RETC) ;
DEFINE_COM CLASS(#PRIM_KCOL) NAME(#ITEM) COLLECTS(#S_154RIW) KEYEDBY(#STD_TEXTL);
* ;
* Externally Visible Properties and Signals;
* ;
Define_Pty errordetected get(geterrorstate);
Define_Evt DominoErrorDetected ;
;
* ====================;
* PROPERTY ROUTINES ;
* ====================;
;
* =========================================================================================== ;
* Get the value of the error detected property ;
* =========================================================================================== ;
;
PtyRoutine GetErrorState;
Define_Map *Output #Std_Bool #Prop001;
If '#Dom_ERROR = Y';
Set #Prop001 Value(TRUE);
Else ;
Set #Prop001 Value(FALSE);
Endif ;
EndRoutine ;
;
* ==================;
* METHOD ROUTINES ;
* ==================;
;
* =========================================================================================== ;
* Set the error state based on #Domi_RETC;
* =========================================================================================== ;
;
MthRoutine SetErrorState;
Case #Dom_RETC;
When '= ER';
Change #Dom_Error Y ;
Signal DominoErrorDetected;
When '= OK';
Change #Dom_Error N ;
OtherWise ;
Change #Dom_Error N ;
EndCase ;
EndRoutine ;
;
* =========================================================================================== ;
* MthRoutine Open;
* =========================================================================================== ;
;
MthRoutine Open;
Define_Map *Input #SysVar$av #WithName ;
Define_Map *Input #Std_TextL #PortName mandatory(' ');
Define_Map *Input #SysVar$Av #ServerName mandatory(' ') ;
;
if_null #Dom_DBMS;
Change #Dom_DBMS #WithName.Value ;
Change #Dom_PORT #PortName.Value ;
Change #Dom_SRVR #ServerName.Value ;
Use Dom_Open_DataBase (#Dom_DBMS #Dom_PORT #DOM_SRVR) (#Dom_RETC #Dom_HNDL);
Invoke #Com_Owner.SetErrorState;
if '#Com_Owner.ErrorDetected = True';
Change #Dom_DBMS *Null ;
Invoke #Com_Owner.Close;
EndIf ;
Endif ;
;
EndRoutine ;
;
* =========================================================================================== ;
* MthRoutine Close;
* =========================================================================================== ;
;
MthRoutine Close;
if_null #Dom_DBMS;
Change #XG_Domino *null ;
else ;
Use Dom_Close_DataBase (#Dom_HNDL) (#Dom_RETC);
Invoke #Com_Owner.SetErrorState;
Change #XG_Domino *null ;
EndIf ;
EndRoutine ;
;
* =========================================================================================== ;
* MthRoutine DefineItem;
* =========================================================================================== ;
;
MthRoutine DefineItem;
Define_Map *Input #Std_TextL #SymName;
Define_Map *Input #Std_TextL #DomName;
Define_Map *Input #Std_Texts #Type Mandatory(Text);
Define_Map *Input #Std_Num #KeyNumber Mandatory(0);
Define_Map *Input #Std_Num #Decimals Mandatory(0);
;
Define #UseType RefFld(#Std_Num);
;
Use UpperCase (#SymName) (#SymName) ;
Use UpperCase (#Type) (#Std_Texts) ;
Case #Std_Texts;
When '= number';
Change #UseType 1 ;
When '= text';
Change #UseType 2 ;
When '= time';
Change #UseType 3 ;
Otherwise ;
Abort 'Invalid type value passed to DefineItem method routine' ;
EndCase ;
;
Set #Item<#SymName> Item(#DomName.Value) Type(#UseType) KeyNum(#KeyNumber) NumDecimals(#Decimals);
;
EndRoutine ;
;
* =========================================================================================== ;
* MthRoutine SetItem;
* =========================================================================================== ;
;
MthRoutine SetItem;
Define_Map *Input #Std_TextL #SymName;
Define_Map *Input #Std_Numl #NumericVal mandatory(0.0) ;
Define_Map *Input #SysVar$Av #AlphaVal mandatory(' ') ;
;
Use UpperCase (#SymName.Value) (#Std_TextL);
;
Set #Item<#Std_TextL> NumericValue(#NumericVal.value) AlphaValue(#AlphaVal) ;
;
EndRoutine ;
;
* =========================================================================================== ;
* MthRoutine GetItem;
* =========================================================================================== ;
;
MthRoutine GetItem;
Define_Map *Input #Std_TextL #SymName;
Define_Map *Output #Std_Numl #NumericVal mandatory(0.0) ;
Define_Map *Output #SysVar$Av #AlphaVal mandatory(' ') ;
;
Use UpperCase (#SymName.Value) (#Std_TextL);
;
Set #NumericVal Value( #Item<#Std_TextL>.NumericValue ) ;
Set #AlphaVal Value( #Item<#Std_TextL>.AlphaValue ) ;
;
EndRoutine ;
;
* =========================================================================================== ;
* Insert new data ;
* =========================================================================================== ;
;
MthRoutine Insert;
;
* Get the handle for the creation ;
;
Use Dom_Create_Document (#Dom_HNDL) (#Dom_RETC #Dom_HDOC) ;
Invoke #Com_Owner.SetErrorState;
If *Error;
Return ;
Endif ;
;
* Map the values into domino ;
;
Change #Dom_OPER S;
Invoke #Item<>.EnumerateValues;
If *Error;
Return ;
Endif ;
* ;
* Update the Item ;
* ;
Use Dom_Update_Document (#Dom_HDOC) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
;
EndRoutine ;
;
* =========================================================================================== ;
* Fetch a document ;
* =========================================================================================== ;
;
MthRoutine Fetch;
Define_Map *Input #Std_Num #NumberKeys Mandatory(0) ;
Define_Map *Input #Sysvar$Av #Where Mandatory(' ');
Define_Map *Output #Std_Num #RetHandle Mandatory(0) ;
;
* Set default return values;
;
Set #RetHandle value(0);
;
* Build up the keys to be used ;
;
Change #Dom_CRIT *blanks;
;
If '#NumberKeys.Value > 0';
Invoke #Com_Owner.EnumerateKeys MaxKey(#NumberKeys.Value);
Change #Dom_CRIT #KeyAgg;
Endif ;
;
If '#Where.Value *ne *Blanks';
If_Null #Dom_CRIT;
Change #Dom_CRIT #Where.Value;
Else ;
Use TConcat( '(' #Dom_CRIT ') & (' #Where.Value ')' ) (#Dom_CRIT);
Endif ;
Endif ;
;
* Do the search ;
;
If_Null #Dom_CRIT ;
Use Dom_Search_Documents (#Dom_HNDL N *Blanks *blanks) (#Dom_RETC #Dom_HTBL #DOM_NNOTE) ;
Else ;
Use Dom_Search_Documents (#Dom_HNDL C *Blanks #Dom_CRIT) (#Dom_RETC #Dom_HTBL #DOM_NNOTE) ;
Endif ;
;
Invoke #Com_Owner.SetErrorState;
If *Error;
Return ;
Endif ;
;
* Check if nothing found;
;
If '#Dom_NNOTE <= 0';
Use Dom_End_Search_Docs ( #Dom_HTBL) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
Return ;
Endif ;
;
* Get the details ;
;
Use Dom_Get_Nxt_Document (#Dom_HTBL 0) (#Dom_RETC #Dom_HNOTE) ;
Invoke #Com_Owner.SetErrorState;
If *Error;
Use Dom_End_Search_Docs (#Dom_HTBL) (#Dom_RETC) ;
Return ;
Endif ;
;
* Handle eof;
;
If '#Dom_RETC = EF';
Use Dom_End_Search_Docs (#Dom_HTBL) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
Return ;
Endif ;
* ;
* Kill the search set ;
* ;
Use Dom_End_Search_Docs (#Dom_HTBL) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
* ;
* Get the document;
* ;
Invoke #Com_Owner.Get WithHandle(#Dom_HNOTE) RetHandle(#RetHandle) ;
;
EndRoutine ;
;
* =========================================================================================== ;
* Get Document ;
* =========================================================================================== ;
;
MthRoutine Get;
Define_Map *Input #Std_Num #WithHandle ;
Define_Map *Output #Std_Num #RetHandle ;
;
* Set default return values;
;
Set #RetHandle value(0);
Change #Dom_HNOTE #WithHandle.Value ;
;
* Open the document;
;
Use Dom_Open_Document (#Dom_HNDL #Dom_HNOTE) (#Dom_RETC #Dom_HDOC) ;
Invoke #Com_Owner.SetErrorState;
If *Error;
Return ;
Endif ;
;
* Map the Values From domino ;
;
Change #Dom_OPER G;
Invoke #Item<>.EnumerateValues;
If *Error;
Use Dom_Close_Document (#Dom_HDOC) (#Dom_RETC) ;
Return ;
Endif ;
* ;
* Close the document ;
* ;
Use Dom_Close_Document (#Dom_HDOC) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
If *Error;
Return ;
Endif ;
;
* Finished;
;
Set #RetHandle value(#Dom_HNOTE);
;
EndRoutine ;
;
* =========================================================================================== ;
* Update a Document ;
* =========================================================================================== ;
;
MthRoutine Update;
Define_Map *Input #Std_Num #WithHandle ;
Define_Map *Output #Std_Num #RetHandle mandatory(0);
;
* Set default return values;
;
Set #RetHandle value(0);
;
* Open the document;
;
Change #Dom_HNOTE #WithHandle.Value ;
;
Use Dom_Open_Document (#Dom_HNDL #Dom_HNOTE) (#Dom_RETC #Dom_HDOC) ;
;
If *NotRetOK;
Return ;
Endif ;
;
* Map the Values to domino ;
;
Change #Dom_OPER S;
Invoke #Item<>.EnumerateValues;
If *Error;
Use Dom_Close_Document (#Dom_HDOC) (#Dom_RETC) ;
Return ;
Endif ;
* ;
* Update the document ;
* ;
Use Dom_Update_Document (#Dom_HDOC) (#Dom_RETC) ;
;
If *RetOK;
Set #RetHandle value(#Dom_HNOTE);
Endif ;
;
EndRoutine ;
;
* =========================================================================================== ;
* Delete a Document ;
* =========================================================================================== ;
;
MthRoutine Delete;
Define_Map *Input #Std_Num #WithHandle ;
Define_Map *Output #Std_Num #RetHandle Mandatory(0) ;
;
* Set default return values;
;
Set #RetHandle value(0);
* ;
* Delete the document ;
* ;
Change #Dom_HNOTE #WithHandle.Value ;
;
Use Dom_Delete_Document (#Dom_HNDL #Dom_HNOTE) (#Dom_RETC) ;
;
If *NotRetOK;
Return ;
Endif ;
;
* Finished;
;
Set #RetHandle value(#Dom_HNOTE);
;
EndRoutine ;
;
* =========================================================================================== ;
* EnumerateKeys ;
* =========================================================================================== ;
;
MthRoutine EnumerateKeys;
Define_map *input #Std_Num #MaxKey;
;
Change #KeyAgg *blanks;
Clr_List #KeyList;
;
Invoke #Item<>.EnumerateKeys;
;
SelectList #KeyList;
if '#KeyNo > #MaxKey.Value' ;
Dlt_Entry *Current #KeyList;
EndIf ;
EndSelect ;
;
Sort_List #KeyList #KeyNo ;
;
SelectList #KeyList;
If_null #KeyAgg;
Change #KeyAgg #KeyValue ;
Else ;
Use BConcat (#KeyAgg '&' #KeyValue) (#KeyAgg);
Endif ;
EndSelect ;
;
EndRoutine ;
;
* =========================================================================================== ;
* Handle a select request ;
* =========================================================================================== ;
;
MthRoutine Select;
Define_Map *Input #Std_Num #NumberKeys Mandatory(0) ;
Define_Map *Input #Sysvar$Av #Where Mandatory(' ');
Define_Map *Output #Std_Num #RetHandle Mandatory(0) ;
;
* Set default return values;
;
Set #RetHandle value(0);
;
* Build up the keys to be used ;
;
Change #Dom_CRIT *blanks;
;
If '#NumberKeys.Value > 0';
Invoke #Com_Owner.EnumerateKeys MaxKey(#NumberKeys.Value);
Change #Dom_CRIT #KeyAgg;
Endif ;
;
If '#Where.Value *ne *Blanks';
If_Null #Dom_CRIT;
Change #Dom_CRIT #Where.Value;
Else ;
Use TConcat( '(' #Dom_CRIT ') AND (' #Where.Value ')' ) (#Dom_CRIT);
Endif ;
Endif ;
;
* Do the search ;
;
If_Null #Dom_CRIT ;
Use Dom_Search_Documents (#Dom_HNDL N *Blanks *blanks) (#Dom_RETC #Dom_HTBL #DOM_NNOTE) ;
Else ;
Use Dom_Search_Documents (#Dom_HNDL C *Blanks #Dom_CRIT) (#Dom_RETC #Dom_HTBL #DOM_NNOTE) ;
Endif ;
;
Invoke #Com_Owner.SetErrorState;
If *Error;
Return ;
Endif ;
;
* Check if nothing found;
;
If '#Dom_NNOTE <= 0';
Use Dom_End_Search_Docs ( #Dom_HTBL) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
Return ;
Endif ;
;
* Extract all document notes and put them into the space object ;
;
Change #Dom_PNOTE 0 ;
Change #Dom_NNOTE 0 ;
Change #Dom_XNOTE 0 ;
;
DoUntil '(#Dom_RETC = EF) or (#Dom_RETC = ER)';
Use Dom_Get_Nxt_Document (#Dom_HTBL #Dom_PNOTE) (#Dom_RETC #Dom_HNOTE) ;
Invoke #Com_Owner.SetErrorState;
Leave *Error ;
If '#Dom_RETC = OK';
Change #Dom_NNOTE '#Dom_NNOTE + 1';
Use Update_In_Space (#Dom_Space #Dom_NNOTE #Dom_HNOTE) (#Dom_SPARC);
If '#Dom_SPARC *NE OK';
Use Insert_In_Space (#Dom_Space #Dom_NNOTE #Dom_HNOTE);
Endif ;
Change #Dom_PNOTE #Dom_HNOTE ;
Endif ;
EndUntil ;
;
* Close the search ;
;
Use Dom_End_Search_Docs (#Dom_HTBL) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
If *Error;
Return ;
Endif ;
;
* Invoke the next row and return the total ;
;
Invoke #Com_Owner.SelectNext RetHandle(#RetHandle.Value);
;
* Finished ;
;
EndRoutine ;
;
* =========================================================================================== ;
* Handle a SelectNext Request;
* =========================================================================================== ;
;
MthRoutine SelectNext ;
Define_Map *Output #Std_Num #RetHandle Mandatory(0) ;
;
* Set Default return;
;
Set #RetHandle value(0);
;
* Move to next row ;
;
Change #Dom_XNOTE '#Dom_XNOTE + 1';
;
if '#Dom_XNOTE > #Dom_NNOTE';
Return ;
Endif ;
;
* Get the note if details previosuly saved ;
;
Use Fetch_In_Space (#Dom_Space #Dom_XNOTE) (#Dom_SPARC #Dom_XNOTE #Dom_HNOTE) ;
;
If '#Dom_SPARC *NE OK' ;
Change #Dom_NNOTE 0 ;
Change #Dom_XNOTE 0 ;
Return ;
Endif ;
;
* Return the specific record ;
;
Invoke #Com_Owner.Get WithHandle(#Dom_HNOTE) RetHandle(#RetHandle);
;
EndRoutine ;
;
* ================;
* EVENT ROUTINES ;
* ================;
;
* =========================================================================================== ;
* Handle KeyValue Exist;
* =========================================================================================== ;
;
EvtRoutine Handling(#Item<>.KeyValueExists) Expression(#Expression) KeyNumber(#KeyNumber);
Change #KeyNo #KeyNumber.Value;
Change #KeyValue #Expression.Value;
Add_Entry #KeyList;
EndRoutine ;
;
* =========================================================================================== ;
* Handle Itemvalue Exist;
* =========================================================================================== ;
;
EvtRoutine Handling(#Item<>.ItemValueExists) Com_Sender(#Current);
;
Define #TempItem *char 65;
Define #TempType *dec 5 0 ;
Define #TempAVal *char 256;
Define #TempNVal *dec 15 5 ;
;
if *NoError;
;
Change #TempItem #Current.Item;
Change #TempType #Current.Type ;
;
If *SetOper;
Change #TempAVal #Current.AlphaValue;
Change #TempNVal #Current.NumericValue ;
Use Dom_Add_Item (#Dom_HDOC #TempItem #TempType #TempAVal #TempNVal) (#Dom_RETC);
Else ;
Change (#TempAVal #TempNVal) *Null ;
Use Dom_Get_Item (#Dom_HDOC #TempItem #TempType) (#Dom_RETC #TempAVal #TempNVal);
Set #Current AlphaValue(#TempAVal);
Set #Current NumericValue(#TempNVal);
Endif ;
;
Invoke #Com_Owner.SetErrorState;
;
Endif ;
;
EndRoutine ;
;
* =========================================================================================== ;
* Handle CreateInstance;
* =========================================================================================== ;
;
EvtRoutine Handling(#Com_Owner.CreateInstance);
Change #XG_Domino *null ;
Invoke #Com_Owner.CreateUniqueSpace ReturnName(#Dom_SPACE);
Use Define_Space_Cell (#Dom_SPACE Std_Num Key);
Use Define_Space_Cell (#Dom_SPACE Dom_HNOTE );
EndRoutine ;
;
* =========================================================================================== ;
* Handle DestoryInstance;
* =========================================================================================== ;
;
EvtRoutine Handling(#Com_Owner.DestroyInstance);
Invoke #Com_Owner.Close ;
Use Destroy_Space (#Dom_SPACE);
EndRoutine ;
;
* =========================================================================================== ;
* Create a unique space name ;
* =========================================================================================== ;
;
MthRoutine CreateUniqueSpace;
Define_Map *Output #SysVar$av #ReturnName;
Define #TempName RefFld(#Dom_SPACE);
Define #TempChar *Char 10;
Define #TempNum RefFld(#Date) Length(10) Decimals(0) edit_code(4) default(0) To_Overlay(#TempChar);
Begin_Loop Using(#TempNum);
Use TConcat (*Component '.' #TempChar) (#TempName);
Use Space_Operation (#TempName CheckExistence) (#Dom_SPARC);
Leave *NoSpace;
End_Loop ;
Use Create_Space (#TempName);
Set #ReturnName Value(#TempName);
EndRoutine ;
;
END_COM ;
Name: S_154RDW
Description: The following RDMLX reusable part is a wrapper component designed to wrapper the standard LANSA DOM_ built-in function interfaces to Domino.
;
* ======================================================;
* ======================================================;
* ======================================================;
* S_154RDW : Domino Database File Equivalent Wrapper Component;
* ======================================================;
* ======================================================;
* ======================================================;
* ;
* Disclaimer: The following material is supplied as example material only. ;
* ---------------- No warranty concerning this material or its use in any way;
* whatsoever is expressed or implied. ;
* ;
* =======;
* Methods;
* =======;
;
* Open ;
* Opens a Domino database (or table).;
;
* Close;
* Closes a Domino database (or table).;
;
* DefineItem;
* Defines an item to be used by later SetItem and GetItem methods. ;
;
* SetItem;
* Set the alpha or numeric value of an item;
;
* GetItem ;
* Get the alpha or numeric value of an item;
;
* Insert;
* Insert all current item values into a Domino database;
;
* Fetch;
* Fetch a row from a Domino database by key;
;
* Get;
* Get a row from a Domino database by document handle;
;
* Select ;
* Select a set of rows from a Domino database and return the first matching row;
;
* SelectNext;
* Select the the next matching row. Use after Select or SelectNext only. ;
;
* Update;
* Update a row in the Domino database (by document handle) ;
;
* Delete ;
* Delete a row in the Domino database (by document handle) ;
;
* ========;
* Properties;
* ========;
;
* ErrorDetected : TRUE or FALSE value indicating whether an error has been detected;
;
;
* ======;
* Events;
* ====== ;
;
* DominoErrorDetected : Signaled when an unexpected error rreturn code is received from Domino ;
;
;
;
;
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM DISPLAYPOSITION(1) HEIGHT(17) LEFT(0) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(20);
Define #Dom_DBMS *char 255 ;
Define #Dom_PORT *char 32 ;
Define #Dom_SRVR *char 255 ;
Define #Dom_HNDL *char 4;
Define #Dom_RETC *char 2;
Define #Dom_ERROR *char 1 ;
Define #Dom_OPER *char 1;
Define #Dom_HDOC *char 4;
Define #Dom_HTBL *char 4;
Define #Dom_HNOTE *dec 15 0;
Define #Dom_PNOTE *dec 15 0;
Define #Dom_NNOTE *dec 7 0 edit_code(4) ;
Define #Dom_XNOTE *dec 7 0 edit_code(4) ;
Define #Dom_CRIT *Char 255;
;
Define #Dom_SPACE RefFld(#SysVar$Av) Default(*Component);
Define #Dom_SPARC *Char 2;
Def_Cond *NoSpace '#Dom_SPARC *ne OK' ;
;
Define #KeyNo *dec 1 0 ;
Define #KeyValue *char 255;
Define #KeyAgg *char 255;
Def_List #KeyList (#KeyNo #KeyValue) Type(*Working) Entrys(99);
;
Def_Cond *SetOper '#Dom_Oper = S';
Def_Cond *NoError '#Dom_ERROR *NE Y ';
Def_Cond *Error '#Dom_ERROR = Y ';
Def_Cond *RetOK '#Dom_RETC = OK';
Def_Cond *NotRetOK '#Dom_RETC *ne OK';
;
Group_By Name(#XG_Domino) Fields(#Dom_CRIT #Dom_OPER #Dom_HDOC #Dom_HNOTE #Dom_NNOTE #Dom_ERROR #Dom_DBMS #Dom_PORT #Dom_SRVR #Dom_HNDL #Dom_RETC) ;
DEFINE_COM CLASS(#PRIM_KCOL) NAME(#ITEM) COLLECTS(#S_154RIW) KEYEDBY(#STD_TEXTL);
* ;
* Externally Visible Properties and Signals;
* ;
Define_Pty errordetected get(geterrorstate);
Define_Evt DominoErrorDetected ;
;
* ====================;
* PROPERTY ROUTINES ;
* ====================;
;
* =========================================================================================== ;
* Get the value of the error detected property ;
* =========================================================================================== ;
;
PtyRoutine GetErrorState;
Define_Map *Output #Std_Bool #Prop001;
If '#Dom_ERROR = Y';
Set #Prop001 Value(TRUE);
Else ;
Set #Prop001 Value(FALSE);
Endif ;
EndRoutine ;
;
* ==================;
* METHOD ROUTINES ;
* ==================;
;
* =========================================================================================== ;
* Set the error state based on #Domi_RETC;
* =========================================================================================== ;
;
MthRoutine SetErrorState;
Case #Dom_RETC;
When '= ER';
Change #Dom_Error Y ;
Signal DominoErrorDetected;
When '= OK';
Change #Dom_Error N ;
OtherWise ;
Change #Dom_Error N ;
EndCase ;
EndRoutine ;
;
* =========================================================================================== ;
* MthRoutine Open;
* =========================================================================================== ;
;
MthRoutine Open;
Define_Map *Input #SysVar$av #WithName ;
Define_Map *Input #Std_TextL #PortName mandatory(' ');
Define_Map *Input #SysVar$Av #ServerName mandatory(' ') ;
;
if_null #Dom_DBMS;
Change #Dom_DBMS #WithName.Value ;
Change #Dom_PORT #PortName.Value ;
Change #Dom_SRVR #ServerName.Value ;
Use Dom_Open_DataBase (#Dom_DBMS #Dom_PORT #DOM_SRVR) (#Dom_RETC #Dom_HNDL);
Invoke #Com_Owner.SetErrorState;
if '#Com_Owner.ErrorDetected = True';
Change #Dom_DBMS *Null ;
Invoke #Com_Owner.Close;
EndIf ;
Endif ;
;
EndRoutine ;
;
* =========================================================================================== ;
* MthRoutine Close;
* =========================================================================================== ;
;
MthRoutine Close;
if_null #Dom_DBMS;
Change #XG_Domino *null ;
else ;
Use Dom_Close_DataBase (#Dom_HNDL) (#Dom_RETC);
Invoke #Com_Owner.SetErrorState;
Change #XG_Domino *null ;
EndIf ;
EndRoutine ;
;
* =========================================================================================== ;
* MthRoutine DefineItem;
* =========================================================================================== ;
;
MthRoutine DefineItem;
Define_Map *Input #Std_TextL #SymName;
Define_Map *Input #Std_TextL #DomName;
Define_Map *Input #Std_Texts #Type Mandatory(Text);
Define_Map *Input #Std_Num #KeyNumber Mandatory(0);
Define_Map *Input #Std_Num #Decimals Mandatory(0);
;
Define #UseType RefFld(#Std_Num);
;
Use UpperCase (#SymName) (#SymName) ;
Use UpperCase (#Type) (#Std_Texts) ;
Case #Std_Texts;
When '= number';
Change #UseType 1 ;
When '= text';
Change #UseType 2 ;
When '= time';
Change #UseType 3 ;
Otherwise ;
Abort 'Invalid type value passed to DefineItem method routine' ;
EndCase ;
;
Set #Item<#SymName> Item(#DomName.Value) Type(#UseType) KeyNum(#KeyNumber) NumDecimals(#Decimals);
;
EndRoutine ;
;
* =========================================================================================== ;
* MthRoutine SetItem;
* =========================================================================================== ;
;
MthRoutine SetItem;
Define_Map *Input #Std_TextL #SymName;
Define_Map *Input #Std_Numl #NumericVal mandatory(0.0) ;
Define_Map *Input #SysVar$Av #AlphaVal mandatory(' ') ;
;
Use UpperCase (#SymName.Value) (#Std_TextL);
;
Set #Item<#Std_TextL> NumericValue(#NumericVal.value) AlphaValue(#AlphaVal) ;
;
EndRoutine ;
;
* =========================================================================================== ;
* MthRoutine GetItem;
* =========================================================================================== ;
;
MthRoutine GetItem;
Define_Map *Input #Std_TextL #SymName;
Define_Map *Output #Std_Numl #NumericVal mandatory(0.0) ;
Define_Map *Output #SysVar$Av #AlphaVal mandatory(' ') ;
;
Use UpperCase (#SymName.Value) (#Std_TextL);
;
Set #NumericVal Value( #Item<#Std_TextL>.NumericValue ) ;
Set #AlphaVal Value( #Item<#Std_TextL>.AlphaValue ) ;
;
EndRoutine ;
;
* =========================================================================================== ;
* Insert new data ;
* =========================================================================================== ;
;
MthRoutine Insert;
;
* Get the handle for the creation ;
;
Use Dom_Create_Document (#Dom_HNDL) (#Dom_RETC #Dom_HDOC) ;
Invoke #Com_Owner.SetErrorState;
If *Error;
Return ;
Endif ;
;
* Map the values into domino ;
;
Change #Dom_OPER S;
Invoke #Item<>.EnumerateValues;
If *Error;
Return ;
Endif ;
* ;
* Update the Item ;
* ;
Use Dom_Update_Document (#Dom_HDOC) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
;
EndRoutine ;
;
* =========================================================================================== ;
* Fetch a document ;
* =========================================================================================== ;
;
MthRoutine Fetch;
Define_Map *Input #Std_Num #NumberKeys Mandatory(0) ;
Define_Map *Input #Sysvar$Av #Where Mandatory(' ');
Define_Map *Output #Std_Num #RetHandle Mandatory(0) ;
;
* Set default return values;
;
Set #RetHandle value(0);
;
* Build up the keys to be used ;
;
Change #Dom_CRIT *blanks;
;
If '#NumberKeys.Value > 0';
Invoke #Com_Owner.EnumerateKeys MaxKey(#NumberKeys.Value);
Change #Dom_CRIT #KeyAgg;
Endif ;
;
If '#Where.Value *ne *Blanks';
If_Null #Dom_CRIT;
Change #Dom_CRIT #Where.Value;
Else ;
Use TConcat( '(' #Dom_CRIT ') & (' #Where.Value ')' ) (#Dom_CRIT);
Endif ;
Endif ;
;
* Do the search ;
;
If_Null #Dom_CRIT ;
Use Dom_Search_Documents (#Dom_HNDL N *Blanks *blanks) (#Dom_RETC #Dom_HTBL #DOM_NNOTE) ;
Else ;
Use Dom_Search_Documents (#Dom_HNDL C *Blanks #Dom_CRIT) (#Dom_RETC #Dom_HTBL #DOM_NNOTE) ;
Endif ;
;
Invoke #Com_Owner.SetErrorState;
If *Error;
Return ;
Endif ;
;
* Check if nothing found;
;
If '#Dom_NNOTE <= 0';
Use Dom_End_Search_Docs ( #Dom_HTBL) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
Return ;
Endif ;
;
* Get the details ;
;
Use Dom_Get_Nxt_Document (#Dom_HTBL 0) (#Dom_RETC #Dom_HNOTE) ;
Invoke #Com_Owner.SetErrorState;
If *Error;
Use Dom_End_Search_Docs (#Dom_HTBL) (#Dom_RETC) ;
Return ;
Endif ;
;
* Handle eof;
;
If '#Dom_RETC = EF';
Use Dom_End_Search_Docs (#Dom_HTBL) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
Return ;
Endif ;
* ;
* Kill the search set ;
* ;
Use Dom_End_Search_Docs (#Dom_HTBL) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
* ;
* Get the document;
* ;
Invoke #Com_Owner.Get WithHandle(#Dom_HNOTE) RetHandle(#RetHandle) ;
;
EndRoutine ;
;
* =========================================================================================== ;
* Get Document ;
* =========================================================================================== ;
;
MthRoutine Get;
Define_Map *Input #Std_Num #WithHandle ;
Define_Map *Output #Std_Num #RetHandle ;
;
* Set default return values;
;
Set #RetHandle value(0);
Change #Dom_HNOTE #WithHandle.Value ;
;
* Open the document;
;
Use Dom_Open_Document (#Dom_HNDL #Dom_HNOTE) (#Dom_RETC #Dom_HDOC) ;
Invoke #Com_Owner.SetErrorState;
If *Error;
Return ;
Endif ;
;
* Map the Values From domino ;
;
Change #Dom_OPER G;
Invoke #Item<>.EnumerateValues;
If *Error;
Use Dom_Close_Document (#Dom_HDOC) (#Dom_RETC) ;
Return ;
Endif ;
* ;
* Close the document ;
* ;
Use Dom_Close_Document (#Dom_HDOC) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
If *Error;
Return ;
Endif ;
;
* Finished;
;
Set #RetHandle value(#Dom_HNOTE);
;
EndRoutine ;
;
* =========================================================================================== ;
* Update a Document ;
* =========================================================================================== ;
;
MthRoutine Update;
Define_Map *Input #Std_Num #WithHandle ;
Define_Map *Output #Std_Num #RetHandle mandatory(0);
;
* Set default return values;
;
Set #RetHandle value(0);
;
* Open the document;
;
Change #Dom_HNOTE #WithHandle.Value ;
;
Use Dom_Open_Document (#Dom_HNDL #Dom_HNOTE) (#Dom_RETC #Dom_HDOC) ;
;
If *NotRetOK;
Return ;
Endif ;
;
* Map the Values to domino ;
;
Change #Dom_OPER S;
Invoke #Item<>.EnumerateValues;
If *Error;
Use Dom_Close_Document (#Dom_HDOC) (#Dom_RETC) ;
Return ;
Endif ;
* ;
* Update the document ;
* ;
Use Dom_Update_Document (#Dom_HDOC) (#Dom_RETC) ;
;
If *RetOK;
Set #RetHandle value(#Dom_HNOTE);
Endif ;
;
EndRoutine ;
;
* =========================================================================================== ;
* Delete a Document ;
* =========================================================================================== ;
;
MthRoutine Delete;
Define_Map *Input #Std_Num #WithHandle ;
Define_Map *Output #Std_Num #RetHandle Mandatory(0) ;
;
* Set default return values;
;
Set #RetHandle value(0);
* ;
* Delete the document ;
* ;
Change #Dom_HNOTE #WithHandle.Value ;
;
Use Dom_Delete_Document (#Dom_HNDL #Dom_HNOTE) (#Dom_RETC) ;
;
If *NotRetOK;
Return ;
Endif ;
;
* Finished;
;
Set #RetHandle value(#Dom_HNOTE);
;
EndRoutine ;
;
* =========================================================================================== ;
* EnumerateKeys ;
* =========================================================================================== ;
;
MthRoutine EnumerateKeys;
Define_map *input #Std_Num #MaxKey;
;
Change #KeyAgg *blanks;
Clr_List #KeyList;
;
Invoke #Item<>.EnumerateKeys;
;
SelectList #KeyList;
if '#KeyNo > #MaxKey.Value' ;
Dlt_Entry *Current #KeyList;
EndIf ;
EndSelect ;
;
Sort_List #KeyList #KeyNo ;
;
SelectList #KeyList;
If_null #KeyAgg;
Change #KeyAgg #KeyValue ;
Else ;
Use BConcat (#KeyAgg '&' #KeyValue) (#KeyAgg);
Endif ;
EndSelect ;
;
EndRoutine ;
;
* =========================================================================================== ;
* Handle a select request ;
* =========================================================================================== ;
;
MthRoutine Select;
Define_Map *Input #Std_Num #NumberKeys Mandatory(0) ;
Define_Map *Input #Sysvar$Av #Where Mandatory(' ');
Define_Map *Output #Std_Num #RetHandle Mandatory(0) ;
;
* Set default return values;
;
Set #RetHandle value(0);
;
* Build up the keys to be used ;
;
Change #Dom_CRIT *blanks;
;
If '#NumberKeys.Value > 0';
Invoke #Com_Owner.EnumerateKeys MaxKey(#NumberKeys.Value);
Change #Dom_CRIT #KeyAgg;
Endif ;
;
If '#Where.Value *ne *Blanks';
If_Null #Dom_CRIT;
Change #Dom_CRIT #Where.Value;
Else ;
Use TConcat( '(' #Dom_CRIT ') AND (' #Where.Value ')' ) (#Dom_CRIT);
Endif ;
Endif ;
;
* Do the search ;
;
If_Null #Dom_CRIT ;
Use Dom_Search_Documents (#Dom_HNDL N *Blanks *blanks) (#Dom_RETC #Dom_HTBL #DOM_NNOTE) ;
Else ;
Use Dom_Search_Documents (#Dom_HNDL C *Blanks #Dom_CRIT) (#Dom_RETC #Dom_HTBL #DOM_NNOTE) ;
Endif ;
;
Invoke #Com_Owner.SetErrorState;
If *Error;
Return ;
Endif ;
;
* Check if nothing found;
;
If '#Dom_NNOTE <= 0';
Use Dom_End_Search_Docs ( #Dom_HTBL) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
Return ;
Endif ;
;
* Extract all document notes and put them into the space object ;
;
Change #Dom_PNOTE 0 ;
Change #Dom_NNOTE 0 ;
Change #Dom_XNOTE 0 ;
;
DoUntil '(#Dom_RETC = EF) or (#Dom_RETC = ER)';
Use Dom_Get_Nxt_Document (#Dom_HTBL #Dom_PNOTE) (#Dom_RETC #Dom_HNOTE) ;
Invoke #Com_Owner.SetErrorState;
Leave *Error ;
If '#Dom_RETC = OK';
Change #Dom_NNOTE '#Dom_NNOTE + 1';
Use Update_In_Space (#Dom_Space #Dom_NNOTE #Dom_HNOTE) (#Dom_SPARC);
If '#Dom_SPARC *NE OK';
Use Insert_In_Space (#Dom_Space #Dom_NNOTE #Dom_HNOTE);
Endif ;
Change #Dom_PNOTE #Dom_HNOTE ;
Endif ;
EndUntil ;
;
* Close the search ;
;
Use Dom_End_Search_Docs (#Dom_HTBL) (#Dom_RETC) ;
Invoke #Com_Owner.SetErrorState;
If *Error;
Return ;
Endif ;
;
* Invoke the next row and return the total ;
;
Invoke #Com_Owner.SelectNext RetHandle(#RetHandle.Value);
;
* Finished ;
;
EndRoutine ;
;
* =========================================================================================== ;
* Handle a SelectNext Request;
* =========================================================================================== ;
;
MthRoutine SelectNext ;
Define_Map *Output #Std_Num #RetHandle Mandatory(0) ;
;
* Set Default return;
;
Set #RetHandle value(0);
;
* Move to next row ;
;
Change #Dom_XNOTE '#Dom_XNOTE + 1';
;
if '#Dom_XNOTE > #Dom_NNOTE';
Return ;
Endif ;
;
* Get the note if details previosuly saved ;
;
Use Fetch_In_Space (#Dom_Space #Dom_XNOTE) (#Dom_SPARC #Dom_XNOTE #Dom_HNOTE) ;
;
If '#Dom_SPARC *NE OK' ;
Change #Dom_NNOTE 0 ;
Change #Dom_XNOTE 0 ;
Return ;
Endif ;
;
* Return the specific record ;
;
Invoke #Com_Owner.Get WithHandle(#Dom_HNOTE) RetHandle(#RetHandle);
;
EndRoutine ;
;
* ================;
* EVENT ROUTINES ;
* ================;
;
* =========================================================================================== ;
* Handle KeyValue Exist;
* =========================================================================================== ;
;
EvtRoutine Handling(#Item<>.KeyValueExists) Expression(#Expression) KeyNumber(#KeyNumber);
Change #KeyNo #KeyNumber.Value;
Change #KeyValue #Expression.Value;
Add_Entry #KeyList;
EndRoutine ;
;
* =========================================================================================== ;
* Handle Itemvalue Exist;
* =========================================================================================== ;
;
EvtRoutine Handling(#Item<>.ItemValueExists) Com_Sender(#Current);
;
Define #TempItem *char 65;
Define #TempType *dec 5 0 ;
Define #TempAVal *char 256;
Define #TempNVal *dec 15 5 ;
;
if *NoError;
;
Change #TempItem #Current.Item;
Change #TempType #Current.Type ;
;
If *SetOper;
Change #TempAVal #Current.AlphaValue;
Change #TempNVal #Current.NumericValue ;
Use Dom_Add_Item (#Dom_HDOC #TempItem #TempType #TempAVal #TempNVal) (#Dom_RETC);
Else ;
Change (#TempAVal #TempNVal) *Null ;
Use Dom_Get_Item (#Dom_HDOC #TempItem #TempType) (#Dom_RETC #TempAVal #TempNVal);
Set #Current AlphaValue(#TempAVal);
Set #Current NumericValue(#TempNVal);
Endif ;
;
Invoke #Com_Owner.SetErrorState;
;
Endif ;
;
EndRoutine ;
;
* =========================================================================================== ;
* Handle CreateInstance;
* =========================================================================================== ;
;
EvtRoutine Handling(#Com_Owner.CreateInstance);
Change #XG_Domino *null ;
Invoke #Com_Owner.CreateUniqueSpace ReturnName(#Dom_SPACE);
Use Define_Space_Cell (#Dom_SPACE Std_Num Key);
Use Define_Space_Cell (#Dom_SPACE Dom_HNOTE );
EndRoutine ;
;
* =========================================================================================== ;
* Handle DestoryInstance;
* =========================================================================================== ;
;
EvtRoutine Handling(#Com_Owner.DestroyInstance);
Invoke #Com_Owner.Close ;
Use Destroy_Space (#Dom_SPACE);
EndRoutine ;
;
* =========================================================================================== ;
* Create a unique space name ;
* =========================================================================================== ;
;
MthRoutine CreateUniqueSpace;
Define_Map *Output #SysVar$av #ReturnName;
Define #TempName RefFld(#Dom_SPACE);
Define #TempChar *Char 10;
Define #TempNum RefFld(#Date) Length(10) Decimals(0) edit_code(4) default(0) To_Overlay(#TempChar);
Begin_Loop Using(#TempNum);
Use TConcat (*Component '.' #TempChar) (#TempName);
Use Space_Operation (#TempName CheckExistence) (#Dom_SPARC);
Leave *NoSpace;
End_Loop ;
Use Create_Space (#TempName);
Set #ReturnName Value(#TempName);
EndRoutine ;
;
END_COM ;