Client Server Database Access the xBase Way

[xProgrammer]

Hi Antonio

Happy to share details, code etc but in a hurry to get to an appointment at present. Also would like to clean up code a bit.

I am using sockets. Backend is xHarbour text mode. Front end is xHarbour / Five Linux GUI. Data is transmitted in binary (HB_Serialize()) format in an array (of arrays etc as required). This includes variable names, parameters etc. For single record type queries object properties can be updated by a single call __ObjSetValueList. I haven't had to write a single line of C. Although I intend using threads I am just using a single thread model at this stage. Can just have separate copies listening on separate ports until I do threads.

Will give more details soon.

Regards

Doug

[xProgrammer]

Hi Antonio

Before I present actual code (in the posts to follow) I should provide the following by way of explanation.

Whilst this code is functional in the sense that I am using it in an application it is very much work in progress. The code is not claimed to be complete, neat, robust or optimised.

Also please note that the code has been written to meet my needs and not as a general "library" in any sense. Along the way I have had to make many design decisions where there were many alternatives which may suit you better.

Why would you bother going client-server with xBase? In my case the answer is simple. I need better performance across a VPN than I can achieve with conventional xBase code. The alternative is to use a third party data base back end such as mySQL, PostrgeSQL, or if you want to pay for the privilege Advantage DataBase Server, Sybase or SQLServer.

Those options will in general give you more than my option will, the extent of those extras depending upon your choice. Features such as transaction control, roll forward / roll back, ad hoc queries / reports and management tools.

At this stage all I have set out to do is to write a data base back end to do reads, updates and inserts.

Regards
xProgrammer

[xProgrammer]

Hi Antonio

I am using sockets to communicate between the GUI application front end (the client) and the data base back end (the server). I started with the sample code for the INet....() xHarbour functions to get a feel for socket programs. But there were quite a few changes required to get what I wanted.

Since the front end application obviously needs to communicate with the data base back end from many different points in the code I put together a basic sockets class. The current version is as follows:

Code: Select all  Expand view

CLASS TSocket

CLASSDATA lInitialised INIT .F.
DATA sIPAddress
DATA iPortNumber
DATA pSocket
DATA lConnected
DATA cData

METHOD New() CONSTRUCTOR
METHOD SetIP( sIPAddress )
METHOD SetPort( iPortNumber )
METHOD Connect()
METHOD Send( cMessage )
METHOD Receive()
METHOD Close()
METHOD SendReceive( cMessage )
METHOD CleanUp()

ENDCLASS

METHOD New() CLASS TSocket

::sIPAddress := "127.0.0.1"
::iPortNumber := 1800
IF !::lInitialised
   INetInit()
   ::lInitialised := .T.
ENDIF

RETURN self

METHOD SetIP( sIPAddress ) CLASS TSocket

::sIPAddress := sIPAddress

RETURN nil


METHOD SetPort( iPortNumber ) CLASS TSocket

::iPortNumber := iPortNumber

RETURN nil


METHOD Connect() CLASS TSocket

lOK := .T.
TRY
    ::pSocket := INetConnect( ::sIPAddress, 1800 )
CATCH
    MsgInfo( "Unable to connect to data server" )
    lOK := .F.
END

IF INetErrorCode( ::pSocket ) <> 0
   ? "Socket error:", INetErrorDesc( ::pSocket )
   INetCleanUp()
   lOK := .F.
   // QUIT
ENDIF

IF lOK
   ::lConnected := .T.
  ELSE
   ::lConnected := .F.
ENDIF

RETURN lOK


METHOD Send( cMessage ) CLASS TSocket

INetSend( ::pSocket, cMessage )

RETURN nil


METHOD Receive() CLASS TSocket

LOCAL cBuffer
LOCAL nBytes

::cData := ""
nBytes := 1
DO WHILE nBytes > 0
   cBuffer := Space( 1024 )
   nBytes := INetRecv( ::pSocket, @cBuffer )
   ::cData += Left( cBuffer, nBytes )
ENDDO

RETURN nil


METHOD Close() CLASS TSocket

INetClose( ::pSocket )

RETURN nil


METHOD SendReceive( cMessage ) CLASS TSocket

::Send( cMessage )
::Receive()
::Close()

RETURN ::cData


METHOD CleanUp() CLASS TSocket

RETURN InetCleanUp()

There are some further possible developments that would simplify using this class but they wouldn't really fit into a fairly generic TSocket class so I will probably end up creating a sub class of TSocket enhanced to suit the particular needs of communicating with the data base back end.

Regards
xProgrammer

[xProgrammer]

Hi Antonio

The front end application needs to set up communication as follows:

Code: Select all  Expand view

oSocket := TSocket():New()
oSocket:SetIP( sIPAddress )
oSocket:SetPort( 1800 )

Currently my database queries are identified by numbers set in defines as follows:

Code: Select all  Expand view

#define query_PT_LIST_BY_NAME 1
#define query_PT_BY_KEY       2
#define query_PT_WRITE        3
etc.....

Sending a query to the data base back end is done as follows:

Code: Select all  Expand view

   oSocket:Connect()
   aREQUEST[1] := query_PT_LIST_BY_NAME
   aREQUEST[2] := Array( 1 )
   aREQUEST[2][1] := ::sSearch
   oSocket:Send( HB_Serialize( aREQUEST) )

A few words of explanation are required here. I am using arrays to communicate between the client and the server. The array is then serialized for transmission to the server where the process is reversed. The same method is used in reverse for the server's response. The parameter(s) are passed in the second element of the passed array.

The above code is requesting a list of patients with a name matching the value in ::sSearch.

The return is handled by the following code:

Code: Select all  Expand view

   oSocket:Receive()
   oSocket:Close()
   aTranslated := HB_Deserialize( oSocket:cData )
   aSTATUS := aTranslated[1]
   aOUTPUT := aTranslated[2]

aSTATUS will contain success / failure information. aOUTPUT contains the returned data. At the present time the format of aOUPUT is as follows:

aOUTPUT[1] contains a list of variables returned (currently not used), the values themselves are contained in aOUTPUT[2] through aOUTPUT[n+1]. So in this case the data returned can be most easily used as follows:

Code: Select all  Expand view

   iList := LEN( aLIST[2] )
   ::aKey := aLIST[2]
   ::aFName := aLIST[3]
   ::aGName := aLIST[4]
   ::aDOB := aLIST[5]
   ::aGender := aLIST[6]

Perhaps easier to follow is a query that returns a single record. Here is the code to get the data for a single patient record with key

Code: Select all  Expand view

   LOCAL aREQUEST
   oSocket:Connect()
   aREQUEST := ARRAY( 2 )
   aREQUEST[1] := query_PT_BY_KEY
   aREQUEST[2] := Array( 1 )
   aREQUEST[2][1] := ::sKey
   oSocket:Send( HB_Serialize( aREQUEST) ) 
   oSocket:Receive()
   oSocket:Close()
   aTranslated := HB_Deserialize( oSocket:cData )
   aSTATUS := aTranslated[1]
   aOUTPUT := aTranslated[2]
   __ObjSetValueList( self, aOUTPUT )
   ::dDOB := SToD( ::sDOB )

Note that aTranslated[2] contains the data in the following format:

Code: Select all  Expand view

{ { <variable-name-1>, <variable-1-value> },  { <variable-name-2>, <variable-2-value> }, ............. { <variable-name-n>, <variable-n-value> } }

That is convenient because we can use __ObjSetValueList() to put the values into the calling object.

I'll explain more in subsequent posts, but I have to get back to programming or I'll get in trouble so bye for now.

Regards
xProgrammer

[hua]

Hi Doug,

I guess I have sort of wandered off the topic a bit! I put the topic here because I thought some others might be interested in the approach I am taking. But I'm quite happy to push on regardless. In fact to date the journey has been rather exciting. Does that make me strange? Probably. But I can live with that.

Whatever you (or anyone else) can share is appreciated Doug Nowadays there's no books, magazines, etc that can help me increase my knowledge of programming using FWH+[x]Harbour to the expert level yet. The only major source of knowledge is this forum.

On a completely different matter I wish we had a book for FWH similar to Clipper Developers Guide book where the best methods to tackle different issues are experly disected and explained.

[xProgrammer]

Hi Antonio

I've just done my first performance test across my VPN and I'm very pleased to say that its fast. Still more development to do but its going well.

Regards
xProgrammer

[xProgrammer]

Hi Antonio

The data base server back end is very much a work in progress but it is functional. Quite a few features need to be added such as error handling, links to other tables, automatic allocation of primary keys etc.

Also please note that I have made a number of design decisions that suit my purposes. Some of these make the code slightly more complicated but they give me what I need.

There are really two types of queries - those that will ever only return a single record or fail and those that will return 0 through many records. The first type might be a read, an update or an insert. The second type will be a read.

I have created a base TData Class and two subclasses, namely TSingleData and TListData. Current versions are as follows:

Code: Select all  Expand view

CLASS TData

DATA iWorkArea
DATA aPROPERTIES
DATA iProperties
DATA aOUTPUT
DATA aLIST
DATA lFound
DATA iRecord
DATA sName

METHOD New() CONSTRUCTOR

ENDCLASS

METHOD New() CLASS TData

RETURN self


CLASS TListData FROM TData

METHOD New() CONSTRUCTOR
METHOD SetUp()
METHOD ClearData()
METHOD ReadRecord()
METHOD IndexRead()

ENDCLASS

METHOD New( iWorkArea, aProperties, sName ) CLASS TListData

::iWorkArea := iWorkArea
::aPROPERTIES := aProperties
IF PCount() > 2
   ::sName := sName
  ELSE
   ::sName := ""
ENDIF
::SetUp()

RETURN self

METHOD SetUp() CLASS TListData

LOCAL ii
LOCAL aTHIS

SELECT ( ::iWorkArea )
::iProperties := LEN( ::aPROPERTIES )
IF lVerbose
   ?
   ? "Setting Up List Data ", ::sName, " property count ", LTRIM( STR( ::iProperties ) )
ENDIF
::aLIST := Array( ::iProperties + 1 )
::aLIST[1] := ARRAY( ::iProperties )
FOR ii = 1 TO ::iProperties
   ::aLIST[1][ii] := ::aPROPERTIES[ii][2]
   ::aPROPERTIES[ii][3] := FieldPos( ::aPROPERTIES[ii][1] )
   IF lVerbose
      ? "Field ", ::aPROPERTIES[ii][1], " found at ", ::aPROPERTIES[ii][3], " returned as ", ::aPROPERTIES[ii][2]
   ENDIF
   ::aLIST[ii + 1] := ARRAY( 0 )
NEXT

RETURN nil

METHOD IndexRead( iOrder, sSearch, bCompare ) CLASS TListData

LOCAL vTest

SELECT ( ::iWorkArea )
::ClearData()
SET ORDER TO ( iOrder )
SEEK sSearch
::lFound := FOUND()
IF ::lFound
   lLoop := .T.
   DO WHILE lLoop
      IF lVerbose
         ? "Found ", sSearch, " at record ", RecNo(), " in ", ::sName
      ENDIF
      ::ReadRecord()
      SKIP
      IF EOF()
         lLoop := .F.
         IF lVerbose
            ? "End of file reached in ", ::sName
         ENDIF
        ELSE
         vTest := Eval( bCompare )
         IF vTest <> sSearch
            lLoop := .F.
            IF lVerbose
               ? "No match at record ", RecNo(), " in ", ::sName
            ENDIF
         ENDIF
      ENDIF
   ENDDO
  ELSE
   IF lVerbose
      ? "Failed to find ", sSearch, " in ", ::sName
   ENDIF
ENDIF

RETURN nil

METHOD ClearData() CLASS TListData

LOCAL ii
FOR ii = 2 TO ::iProperties + 1
   ASize( ::aLIST[ii], 0 )
NEXT

RETURN nil

METHOD ReadRecord() CLASS TListData

SELECT ( ::iWorkArea )

FOR ii = 1 TO ::iProperties
   cDataType := FieldType( ::aProperties[ii][3] )
   DO CASE
      CASE cDataType = "D"
         AAdd( ::aLIST[ii + 1], STOD( FieldGet( ::aPROPERTIES[ii][3] ) ) )
      OTHERWISE
         AAdd( ::aLIST[ii + 1], FieldGet( ::aPROPERTIES[ii][3] ) )
   ENDCASE
   IF lVerbose
      ? ::aLIST[1][ii], " = ", ::aLIST[ii + 1][Len( ::aLIST[ii + 1] )]
   ENDIF
NEXT

RETURN nil



CLASS TSingleData FROM TData

METHOD New() CONSTRUCTOR
METHOD SetUp()
METHOD ReadRecord()
METHOD KeyRead()
METHOD Write()
METHOD WriteRecord()

ENDCLASS

METHOD New( iWorkArea, aProperties, iKeyAllocator, sName ) CLASS TSingleData

::iWorkArea := iWorkArea
::aPROPERTIES := aProperties
IF PCount() > 3
   ::sName := sName
  ELSE
   ::sName := ""
ENDIF
::SetUp()

RETURN self


METHOD Setup() CLASS TSingleData

LOCAL ii
LOCAL aTHIS

SELECT ( ::iWorkArea )
::iProperties := LEN( ::aPROPERTIES )
IF lVerbose
   ? "Setting Up Single Data ", ::sName, " property count ", LTRIM( STR( ::iProperties ) )
ENDIF
::aOUTPUT := ARRAY( ::iProperties )
FOR ii = 1 TO ::iProperties
   aTHIS := Array( 2 )
   aTHIS[1] := ::aPROPERTIES[ii][2]
   ::aOUTPUT[ii] := aTHIS
   ::aPROPERTIES[ii][3] := FieldPos( ::aPROPERTIES[ii][1] )
   IF lVerbose
      ? "Field ", ::aPROPERTIES[ii][1], " found at position ", ::aPROPERTIES[ii][3], " returned as ", ::aPROPERTIES[ii][2]
   ENDIF
NEXT

RETURN nil

METHOD ReadRecord() CLASS TSingleData

SELECT ( ::iWorkArea )
FOR ii = 1 TO ::iProperties
   ::aOUTPUT[ii][2] := FieldGet( ::aPROPERTIES[ii][3] )
   ? ::aOUTPUT[ii][1], " = ", ::aOUTPUT[ii][2]
NEXT

RETURN nil

METHOD KeyRead( iOrder, sKey ) CLASS TSingleData

SELECT ( ::iWorkArea )
SET ORDER TO ( iOrder )
SEEK sKey
::lFound := FOUND()
IF ::lFound
   IF lVerbose
      ? "Found ", sKey, " at ", RecNo(), " in ", ::sName
   ENDIF
   ::iRecord := RecNo()
   ::ReadRecord()
   aRESPONSE[2] := ::aOUTPUT
  ELSE
   IF lVerbose
      ? "ERROR: Failed to find ", sKey, " in ", ::sName
   ENDIF
ENDIF

RETURN nil

METHOD Write( iOrder, aRESPONSE, sKey ) CLASS TSingleData

SELECT ( ::iWorkArea )
SET ORDER TO ( iOrder )

IF aRESPONSE[1][2] = "["
   ? "Insert Required"
   APPEND BLANK
   aRESPONSE[1][2] := "999999999999001"
  ELSE
   ? "Update Required"
   SEEK sKey
   ::lFound := FOUND()
   IF ::lFound
      ? "Record Found"
      ::WriteRecord( aRESPONSE )
     ELSE
      ? "ERROR: Unable to locate record for update"
   ENDIF
ENDIF

RETURN nil

METHOD WriteRecord( aOUTPUT ) CLASS TSingleData

LOCAL ii
LOCAL iPosition

FOR ii = 1 TO LEN( aOUTPUT )
   iPosition := FieldPos( aOUTPUT[ii][1] ) 
   IF iPosition > 0
      FieldPut( iPosition, aOUTPUT[ii][2] )   
   ENDIF
NEXT

RETURN nil

As you can see TSingleData:Write() will handle both update and insert operations but the code for insert has not yet been completed.

::aPROPERTIES is an array holding the details of what fields are to be returned and what the variable name to be used is equivalent to SELECT <field> AS <variable>. In the ::SetUp() function field positions are determined from the field names and used thereafter. Also an array is built up with the variable names ready for the values to be inserted at query time and returned to the client.

You can run the server in verbose mode (lVerbose := .T.) and see it in operation.

Regards
xProgrammer

[xProgrammer]

Hi Antonio

Defining the queries is easy (if a little long winded given that I am returning variable names which aren't field names). For example:

Code: Select all  Expand view

   oPT_BY_KEY := TSingleData():New( 1, { { "PT_KEY", "sKey", 0 }, { "PT_NMFAMLY", "sNmFamly", 0 }, { "PT_NMGIVEN", "sNmGiven", 0 }, ;
      { "PT_NMOTHER", "sNmOther", 0 }, { "PT_NMPREV", "sNmPrev", 0 }, { "PT_NMPREF", "sNmPref", 0 }, { "PT_NMTITLE", "sNmTitle", 0 }, ;
      { "PT_DOB", "sDOB", 0 }, { "PT_GENDER", "cGender", 0 }, { "PT_ADLINE1", "sAdLine1", 0 }, { "PT_ADLINE2", "sAdLine2", 0 }, ;
      { "PT_ADSUBRB", "sAdSubrb", 0 }, { "PT_ADSTATE", "sAdState", 0 }, { "PT_ADPCODE", "sAdPCode", 0 }, { "PT_ADCNTRY", "sAdCntry", 0 }, ;
      { "PT_PHHOME", "sPhHome", 0 }, { "PT_PHWORK", "sPhWork", 0 }, { "PT_PHMOB", "sPhMob", 0 }, { "PT_PHFAX", "sPhFax", 0 }, ;
      { "PT_EMAIL", "sEmail", 0 }, { "PT_MEDIC", "sMedic", 0 }, { "PT_MEDPOS", "sMedPos", 0 }, { "PT_VETAFF", "sVetAff", 0 }, ;
      { "PT_ACTIVE", "cActive", 0 }, { "PT_LUBY", "sLUBy", 0 }, { "PT_LUWHEN", "sLUWhen", 0 }, { "PT_LUACTN", "cLUActn", 0 } }, ;
      1, "Patient by Key" )
   oPT_LIST_BY_NAME := TListData():New( 1, { { "PT_KEY", "sKey", 0 }, { "PT_NMFAMLY", "sNmFamly", 0 }, { "PT_NMGIVEN", "sNmGiven", 0 }, ;
      { "PT_DOB", "dDOB", 0 }, { "PT_GENDER", "cGender", 0 } }, "Patient List by Name" )
   oPF_LIST_BY_PT_KEY := TListData():New( 3, { { "PF_KEY", "aKey", 0 }, { "PF_FLKEY", "aFLKey", 0 }, { "PF_FLKEY", "aFLName", -1, 2, 1 }, ;
      { "PF_DTFIRST", "aDtFirst", 0 }, { "PF_DTLAST", "aDtLast", 0 }, { "PF_CLOSED", "aClosed", 0 } }, "Patient File List by Patient Key")

Note that the first parameter is the WorkArea to use (my code assumes that all files are opened up by the data base server on startup). Then follows an array of fields to return in the format { { <field-name>, <variable-name>, 0 }, .... }. The third element will (in most cases) be updated by the SetUp function to the field's position in the table. For return values that are something other than the value of a field there are further options available which I can explain in the future. Fot TSingleData:New() the next parameter is an offset into the primary key allocator (yet to be included). The final parameter is a name to be used when in verbose mode.

Defining how to process a particular request is pretty easy. Currently I am using a CASE statement but I may need to use a more efficient method as the number of possible requests increases.

Code: Select all  Expand view

   aREQUEST := HB_Deserialize( cData )
   IF lVerbose
      ? "Received request number: ", aREQUEST[1]
   ENDIF
   iSelection := aREQUEST[1]
   DO CASE
      CASE iSelection = query_PT_LIST_BY_NAME
         oPT_LIST_BY_NAME:IndexRead( 2, aREQUEST[2][1], { | | UPPER( PT_NMFAMLY + PT_NMGIVEN ) } )
      CASE iSelection = query_PT_BY_KEY
         oPT_BY_KEY:KeyRead( 1, aREQUEST[2][1] )
         aRESPONSE[2] := oPT_BY_KEY:aOUTPUT
      CASE iSelection = query_PT_WRITE
         oPT_BY_KEY:Write( 1, aREQUEST[2], aREQUEST[2][1][2] )
      CASE iSelection := query_PF_LIST_BY_PT_KEY
         oPF_BY_PT_KEY:Read( 2, aREQUEST[2][1] )
      OTHERWISE
         // error handling required here
   ENDCASE
   IF lVerbose
      ? "Press [Ctl-C] to quit"
   ENDIF

Pretty straight forward. A few words of explanation. TListData:IndexRead() takes the following parameters:
iOrder - to set the controlling index
sSearch - the value to seek
bCompare - a code block to evaluate to see if subsequent records match sSearch.

Regards
xProgrammer

[Antonio Linares]

Doug,

many thanks for your explanations, very interesting

[xProgrammer]

Hi Antonio

The current code for the server main loop is:

Code: Select all  Expand view

   INetInit()
   // listen on port 1800
   pServer := INetServer( 1800 )
   INetSetTimeout( pServer, 500 )
   ? "Server up and ready for requests", pServer
   ? "Press [Ctl-C] to quit"
   lContinue := .T.
   DO WHILE lContinue
      // wait for incoming connection requests
      pClient := INetAccept( pServer )
      IF INetErrorCode( pServer ) == 0
         // process client request
         // possibly in a future version in a separate thread
         ServeClient( pClient )
      ENDIF
   ENDDO
   // WaitForThreads() would go here in a threded version
   // close socket and cleanup memory
   INetClose( pServer )
   INetCleanup()

Please note that this does not use threads so it would be a case of one instance per remote user. Some restructuring of code would be required (I think) for a threaded version.

The server now supports returning record numbers and fields from a "foreign" file by following a foreign key all just using an extension of the current parameter arrays.

Regards
xProgrammer

[xProgrammer]

Hi Antonio

This is very much an ongoing exercise. I have simplified the process of executing a query from the client (GUI application) with the following little class TQuery:

Code: Select all  Expand view

CLASS TQuery

DATA lSuccess
DATA aREQUEST
DATA aTranslated

METHOD New() CONSTRUCTOR
METHOD Execute()

ENDCLASS

METHOD New() CLASS TQuery

::aREQUEST := Array( 2 )

RETURN self

METHOD Execute( iQuery, aParameters) CLASS TQuery

::aREQUEST[1] := iQuery
::aREQUEST[2] := aParameters
oSocket:Connect()
oSocket:Send( HB_Serialize( ::aREQUEST) )   
oSocket:Receive()
oSocket:Close()
::aTranslated := HB_Deserialize( oSocket:cData )
// For now
::lSuccess := .T.

RETURN ::lSuccess

This class needs to be extended to handle errors, give an opportunity to retry updates where records are locked etc.

So now for example to get a list of patients with a given name the application does:

Code: Select all  Expand view

   oQuery:Execute( query_PT_LIST_BY_NAME, { ::sSearch } )
   aSTATUS := oQuery:aTranslated[1]
   aLIST := oQuery:aTranslated[2]

A later version should have TQuery:Execute() returning a meaningful status. It should also check that the return value is an array with at least two elements.

Regards
xProgrammer

[xProgrammer]

Hi Antonio

Work on the xBase data server continues. Code is much better organised on the server end with a TServerQueryClass that will be responsible for gathering error information as well as the communication process. Structre is nice and flexible this way so that multiple queries can be handled in the one round trip. Thus, for example, you can not only retrieve the data needed for a particular object you can also get all the options that will be needed to populate list-boxes etc that may be part of the screen. TServerQuery has done away with the DO CASE and is using an array of function pointers. The current code for TServerQuery is:

Code: Select all  Expand view

CLASS TServerQuery

DATA iErrorLevel
DATA aErrors
DATA aResponse
DATA aRequest

METHOD New()
METHOD Request( pClient )
METHOD FlagError( iErrorLevel, iErrorNumber )

ENDCLASS

METHOD New()

::aErrors := Array( 0 )

RETURN self

METHOD Request( pClient ) CLASS TServerQuery

LOCAL cBuffer
LOCAL nBytes
LOCAL cData
LOCAL aOUTPUT := ARRAY( 0 )
LOCAL aSTATUS := ARRAY( 3 )


::iErrorLevel := 0
ASize( ::aErrors, 0 )
::aResponse := Array( 3 )
? "Serving:", INetAddress( pClient )
cData := ""
lReceiving := .T.
INetSetTimeout( pClient, 100 )
DO WHILE  lReceiving
   cBuffer := Space( 4096 )
   nBytes := INetRecv( pClient, @cBuffer )
   ? "Bytes received:", nBytes
   IF nBytes < 1
      lReceiving := .F.
     ELSE
      cData += Left( cBuffer, nBytes )
   ENDIF
ENDDO
::aREQUEST := HB_Deserialize( cData )
IF lVerbose
   ? "Received request number: ", ::aREQUEST[1]
ENDIF
aSTATUS[1] := 0
iSelection := ::aREQUEST[1]
HB_Exec( aCompiled[iSelection], nil )



   IF lVerbose
      ? "Press [Ctl-C] to quit"
   ENDIF
   aSTATUS[1] := ::iErrorLevel
   aSTATUS[2] := 1
   aSTATUS[3] := ""
   ::aRESPONSE[1] := aSTATUS
   cData := HB_Serialize( ::aRESPONSE )
   INetSend( pClient, cData )


RETURN nil

METHOD FlagError( iErrorLevel, iErrorNumber ) CLASS TServerQuery

::iErrorLevel := MAX( ::iErrorLevel, iErrorLevel )
IF PCount() > 1
   AAdd( ::aErrors, iErrorNumber )
ENDIF

RETURN ni


Code for the individual queries is:

[code]
FUNCTION GetPatientListByName()

oPT_LIST_BY_NAME:IndexRead( 2, oQuery:aREQUEST[2][1], { | | UPPER( PT_NMFAMLY + PT_NMGIVEN ) } )
oQuery:aRESPONSE[2] := oPT_LIST_BY_NAME:aLIST

RETURN nil

FUNCTION GetPatientDataByKey()

oPT_BY_KEY:KeyRead( 1, oQuery:aREQUEST[2][1] )
oQuery:aRESPONSE[2] := oPT_BY_KEY:aOUTPUT

RETURN nil

FUNCTION WritePatientData()

oPT_BY_KEY:Write( 1, oQuery:aREQUEST[2], oQuery:aREQUEST[2][1][2] )

RETURN nil

FUNCTION GetPatientFileListByPatientKey()

oPF_LIST_BY_PT_KEY:IndexRead( 2, oQuery:aREQUEST[2][1], { | | PF_PTKEY } )
oQuery:aRESPONSE[2] := oPF_LIST_BY_PT_KEY:aLIST

RETURN nil

FUNCTION GetPatientFileDataByKey()

oPF_BY_KEY:KeyRead( 1, oQuery:aREQUEST[2][1] )
oQuery:aRESPONSE[2] := oPF_BY_KEY:aOUTPUT
oFL_LIST:ReadAll( nil )
oQuery:aRESPONSE[3] := oFL_LIST:aLIST

RETURN nil

FUNCTION GetFileLocationList()

oFL_LIST:ReadAll( nil )
oQuery:aRESPONSE[2] := oFL_LIST:aLIST

RETURN nil

FUNCTION WritePatientFileData()

oPF_BY_KEY:Write( 1, oQuery:aREQUEST[2], oQuery:aREQUEST[2][1][2] )

RETURN nil[code]

Note that aCompiled is set up as follows:

[code] PUBLIC aCompiled := Array( 7 )
aCompiled[1] := ( @GetPatientListByName() )
aCompiled[2] := ( @GetPatientDataByKey() )
aCompiled[3] := ( @WritePatientData() )
aCompiled[4] := ( @GetPatientFileListByPatientKey() )
aCompiled[5] := ( @GetPatientFileDataByKey() )
aCompiled[6] := ( @GetFileLocationList() )
aCompiled[7] := ( @WritePatientFileData() ])[/code]

The other main piece of setting up the queries is

[code]
// Patient by Key
oPT_BY_KEY := TSingleData():New( wa_PT_PATIENT, { { "PT_KEY", "sKey", 0 }, { "PT_NMFAMLY", "sNmFamly", 0 }, { "PT_NMGIVEN", "sNmGiven", 0 }, ;
{ "PT_NMOTHER", "sNmOther", 0 }, { "PT_NMPREV", "sNmPrev", 0 }, { "PT_NMPREF", "sNmPref", 0 }, { "PT_NMTITLE", "sNmTitle", 0 }, ;
{ "PT_DOB", "sDOB", 0 }, { "PT_GENDER", "cGender", 0 }, { "PT_ADLINE1", "sAdLine1", 0 }, { "PT_ADLINE2", "sAdLine2", 0 }, ;
{ "PT_ADSUBRB", "sAdSubrb", 0 }, { "PT_ADSTATE", "sAdState", 0 }, { "PT_ADPCODE", "sAdPCode", 0 }, { "PT_ADCNTRY", "sAdCntry", 0 }, ;
{ "PT_PHHOME", "sPhHome", 0 }, { "PT_PHWORK", "sPhWork", 0 }, { "PT_PHMOB", "sPhMob", 0 }, { "PT_PHFAX", "sPhFax", 0 }, ;
{ "PT_EMAIL", "sEmail", 0 }, { "PT_MEDIC", "sMedic", 0 }, { "PT_MEDPOS", "sMedPos", 0 }, { "PT_VETAFF", "sVetAff", 0 }, ;
{ "PT_ACTIVE", "cActive", 0 }, { "PT_LUBY", "sLUBy", 0 }, { "PT_LUWHEN", "sLUWhen", 0 }, { "PT_LUACTN", "cLUActn", 0 } }, ;
1, "Patient by Key" )

// Patient List by Name
oPT_LIST_BY_NAME := TListData():New( wa_PT_PATIENT, { { "PT_KEY", "sKey", 0 }, { "PT_NMFAMLY", "sNmFamly", 0 }, { "PT_NMGIVEN", "sNmGiven", 0 }, ;
{ "PT_DOB", "dDOB", 0 }, { "PT_GENDER", "cGender", 0 } }, "Patient List by Name" )

// Patient File List by Patient Key
oPF_LIST_BY_PT_KEY := TListData():New( wa_PF_PATIENTFILE, { { "PF_KEY", "aKey", 0 }, { "PF_FLKEY", "aFLKey", 0 }, ;
{ "PF_FLKEY", "aFLName", -2, 2, 1, "FL_NAME" }, { "PF_DTFIRST", "aDtFirst", 0 }, { "PF_DTLAST", "aDtLast", 0 }, ;
{ "PF_CLOSED", "aClosed", 0 } }, "Patient File List by Patient Key")

// Patient File by Key
oPF_BY_KEY := TSingleData():New( wa_PF_PATIENTFILE, { { "PF_KEY", "sKey", 0 }, { "PF_FLKEY", "sFLKey", 0 }, ;
{ "PF_FLKEY", "sFLName", -1, 2, 1, "FL_NAME" }, { "PF_DTFIRST", "sDtFirst", 0 }, { "PF_DTLAST", "sDtLast", 0 }, ;
{ "PF_CLOSED", "cClosed", 0 }, { "PF_ACTIVE", "cActive", 0 }, { "PF_LUBY", "sLUBy", 0 }, { "PF_LUWHEN", "sLUWhen", 0 }, ;
{ "PF_LUACTN", "cLUActn", 0 } }, 3, "Patient File by Key")
// File Location List
oFL_LIST := TListData():New( wa_FL_FILELOCATION, { { "FL_KEY", "aFLKey", 0 }, { "FL_NAME", "aFLName", 0 } }, "File Locations List" )
[/code]

Note that these objects may be used by more than 1 query, eg for reading a record and for updating or inserting it.

[Antonio Linares]

Doug,

Very interesting work, thanks for sharing it

How do you control that the socket connection is active ?

[xProgrammer]

Hi Antonio

The data base back end server runs the following loop to see if there is an incoming request:

Code: Select all  Expand view

   ?
   ? "Setting up sockets"
   INetInit()
   // listen on port 1800
   pServer := INetServer( 1800 )
   INetSetTimeout( pServer, 500 )
   ? "Server up and ready for requests", pServer
   ? "Press [Ctl-C] to quit"
   lContinue := .T.
   DO WHILE lContinue
      // wait for incoming connection requests
      pClient := INetAccept( pServer )
      IF INetErrorCode( pServer ) == 0
         // process client request
         // possibly in a future version in a separate thread
         //ServeClient( pClient )
         oQuery:Request( pClient )
      ENDIF
   ENDDO
   // WaitForThreads() would go here in a threaded version
   // close socket and cleanup memory
   INetClose( pServer )
   INetCleanup()
RETURN

Currently there is no exit from the loop. I would have coded in {Ctl-C] as an exit with an InKey() function call but [Ctl-C] terminates the application without Inkey() returning anyhow as a text based application under Linux. I don't know if that might cause longer term issues. Maybe I should code in an alternative?

Regards
Doug
(xProgrammer)

[Patrick Mast]

Hey Doug,

Is this not what LetoDB does?

Patrick