sqlite3_create_function - custom aggregate function

[Bern Ertl]

... Looks like I will need to use sqlite3_create_function() to register my own ... function.  As SQLitening doesn't currently encapsulate sqlite3_create_function(), is it possible to call it directly on the client end, or will I need to add a server side proc to call it and access it via slRunProc?

Anyone know if it's possible to register a PB function with sqlite3_create_function()?

I've run into another situation where it would be very useful to take advantage of this feature.  I'd like to create a TRIGGER that builds a comma separated string representing records in a table.  I would use the group_concat() aggregate function, but I need to do more than just assemble values from a single column.  I need to encode data from 3 different columns for each value in the string.

I don't suppose anyone here has any experience writing custom aggregate functions with SQLite?

It would also be awesome if I could implement some PB string handling functions like PARSE$ and REMOVE$ for use within SQL statements using this mechanism.

[Bern Ertl]

Fred, any chance SQLitening might be expanded to encapsulate the sqlite3_create_function() to make this chore easier?  Have a look here:

http://www.powerbasic.com/support/pbforums/showthread.php?t=40372

[Fred Meier]

I will take a look and get back to you.

[Bern Ertl]

Thanks Fred. 

I've implemented the following code in a SQLiteningProcsA DLL:

Code Select Expand

%SQLITE_TRANSIENT = -1
%SQLITE_UTF8      = 1

DECLARE FUNCTION sqlite3_create_function CDECL LIB "sqlite3.dll" ALIAS "sqlite3_create_function" (BYVAL rhDab AS DWORD, zName AS ASCIIZ, BYVAL nArg AS LONG, BYVAL eTextRep AS LONG, _
BYVAL pUserData AS DWORD, BYVAL pFunc AS DWORD, BYVAL pStep AS DWORD, BYVAL pFinal AS DWORD) AS LONG
DECLARE FUNCTION sqlite3_value_text CDECL LIB "sqlite3.dll" ALIAS "sqlite3_value_text" (BYVAL sqlite3_value AS DWORD) AS DWORD
DECLARE SUB      sqlite3_result_text CDECL LIB "sqlite3.dll" ALIAS "sqlite3_result_text" (BYVAL sqlite3_context AS DWORD, BYVAL pzText AS DWORD, BYVAL nBytes AS LONG, BYVAL DWORD)

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Custom SQL functions...
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

SUB sqlFnRemove CDECL ( BYVAL hContext AS DWORD, BYVAL iArgs AS LONG, BYVAL pArgv AS DWORD PTR) EXPORT

LOCAL sMain AS STRING, sMatch AS STRING, sResult AS STRING, pzText AS ASCIIZ PTR

'#IF 0
MSGBOX "iArgs = " + FORMAT$( iArgs)
IF iArgs <> 2 THEN EXIT SUB

pzText = sqlite3_value_text( @pArgv[0])
sMatch = @pzText
MSGBOX "sMatch = >" + sMatch + "<"
pzText = sqlite3_value_text( @pArgv[1])
sMain = @pzText
MSGBOX "sMain = >" + sMain + "<"

sResult = REMOVE$( sMain, sMatch)
REPLACE ", , " WITH ", " IN sResult
sResult = TRIM$( sResult, ", ") + $NUL

MSGBOX "sResult = >" + sResult + "<"

sqlite3_result_text hContext, BYVAL STRPTR( sResult), -1, %SQLITE_TRANSIENT

MSGBOX "Done"
'#ENDIF

END SUB

'============================<[ InitCustomSQLFns ]>=============================

FUNCTION ICF ALIAS "ICF" (BYVAL rhDab AS DWORD, _
  BYVAL rlTcpFileNumber AS LONG, _
  blParm1 AS LONG, _
  blParm2 AS LONG, _
  bsParm3 AS STRING, _
  bsParm4 AS STRING) EXPORT AS LONG

'ICF = Initialize Custom (SQL) Functions

'In:  none

'Out: FUNCTION = 0 for success, <>0 if error
'     blParm1 = where in execution path SQLite error occurred (if any)
'     bsParm3 = error message if error occurred

LOCAL lResult AS LONG, zText AS ASCIIZ * 16

zText = "RemoveXfromY"
100 lResult = sqlite3_create_function( rhDab, zText, 2, %SQLITE_UTF8, 0, CODEPTR( sqlFnRemove), 0, 0)

IF ISTRUE lResult THEN
bsParm3 = "Failed to create RemoveXfromY"
blParm1 = 100        ' Return "error line number"
FUNCTION = lResult   ' Set return code
EXIT FUNCTION
END IF

END FUNCTIONThe call to ICF returns successfully (ie. sqlite3_create_function() is returning a success code).  When I try calling RemoveXfromY within a SQL statement, the SQLitening server shuts down with an error -18 (no matter what code is placed within the SUB - the code never gets executed).  I'm guessing there is an issue with the declaration for sqlFnRemove, but I'm not seeing it. 

[Bern Ertl]

I figured out the problem.  The SQLiteningProcsA DLL is loaded and unloaded dynamically as it is called by slRunProc (without the 'u' modchar).  When I'm executing the SQL statement that references the RemoveXfromY function, the function is no longer loaded in memory.

Question: Do I need to add the 'u' ModChar to *every* function call to a Procs DLL, or just the first one?  If I add the 'u' ModChar to every call, does SQLitening unload the DLL when the client app closes (or dies unexpectedly)?

[Fred Meier]

Yes you did. I was composing this answer when you posted.

Bern, I have done some testing and, like you, believe the best way
(probably the only way) to install a custom function is to do it in a
Proc.  That assumes you want it to work in both local and remote.

The server is aborting (returning error -18) because the custom function
is no longer in memory when you invoke it.  Procs are loaded and unloaded
every time they are called, unless you use the "u" modchar. 

I was able to get the same error without the "u" modchar and was able to
invoke a custom function just fine with the "u" modchar.  Add the "u"
modchar and it should work OK. 

Adding the "u" modchar will require you to force the Proc Dll to unload. 
This is done by calling it one last time just before your program ends or
when you no longer need it.  If, for example, your Proc Dll is suffix "T"
and your entry is "CreateFunction" then the first line below will load the
Dll (the "u" modchar keeps it in memory) and create the custom function
while the second line (run when your are done with costume function) will
unload the Dll. 

Code Select Expand

   slRunProc "TCreateFunction", 0, 0, "", "", "u"
   slRunProc "T", 0, 0, "", "", ""

This should work in both local and remote.  There is a small problem in
local mode.  It will return error -19 when doing the unload (second line
above).  Next release will contain fix.  If you need it now then change
the following source line in the function slRunProc in SQLitening.Bas and
recompile. 

from
      elseif len(rsProcName) then
            to
      elseif len(mid$(rsProcName, 2)) then

You only need the "u" modchar on the run Proc that creates the custom
function.  When you run a Proc a LoadLibrary is issued.  If the Dll is
already in memory then only the use count is incremented.  After the Proc
runs, if there is no "u" modchar then multiple FreeLibrary's are issued
until the use count is zero. 

If your client aborts then the Dll will remain in memory but would be
unloaded the next time the app runs OK. 

[Bern Ertl]

OK.  To clarify, I currently have all my proc Fns in the same DLL.  I guess I should separate out the SQLite custom function(s) into it's own proc DLL so I can handle the 'u' modchar for it independently of whatever other proc functions I call infrequently.

[Fred Meier]

I just realized there may be a problem with my "FreeLibrary until use
count is zero" concept with multi treads on the server.  I will do testing
and get back to you. 

[Fred Meier]

Yes, there is a problem with my "free library until zero use count".
The following three programs need changing and compiling.

Replace the following function in SQLitening.Bas and compile.

Code Select Expand

'============================<[ Run Proc ]>============================
Function slRunProc alias "slRunProc" (rsProcName as String, _
                                      blParm1 as Long, _
                                      blParm2 as Long, _
                                      bsParm3 as String, _
                                      bsParm4 as String, _
                                      optional byval rsModChars as String)Export as Long
'   ProcName is the one character library suffix followed by the name of the
'   entry to be called within the library.  ProcName may also contain an
'   optional password.  This password is separated from the proc name by the
'   $BS character.     The full library name is SQLiteningProcs + the one
'   character suffix.  A ProcName of AStoreOrder^TallWalk (^ is the $BS)
'   would has the following three parts:
'      1.  A is the library name suffix so SQLiteningProcsA.Dll would be
'          loaded.
'      2.  StoreOrder is the entry name.
'      3.  TallWalk is the optional password.
'   If you are only loading or unloading the library (L or U modchar passed)
'   then the ProcName is only the one character library suffix.
'   SQLiteningProcsA.Bas is included as a sample proc library.  There are
'   two sample entries coded there; Entry1 is called by this slRunProc while
'   Entry2 is invoked by using the SQLite load_extension function.
'   ModChars:
'      Em = Return errors. This will override the global return errors flag.
'           m is the optional message display modifier and can be:
'              0 = No message is displayed.  This is the default.
'              1 = Display a warning message with OK button.  Error is
'                  returned when OK pressed.
'              2 = Display a question message with OK and Cancel buttons.
'                  If they press OK, error is returned.  If they press
'                  Cancel, will exit process.
'      e  = Do not return errors, display message and exit process. This
'           will override the global return errors flag.
'      L  = Load the library.  Pass only the one character library prefix
'           in ProcName.  Useful if you know you will be running procs many
'           times from this library.  This is required for creating SQLite
'           custom functions.  You must later unload the library.
'      U  = Unload the library.  Pass only the one character library prefix
'           in ProcName.  Required if your previously loaded the library.
'      u  = Do not unload the library after running the proc. Pass the one
'           character library prefix and entry name in ProcName.  You must
'           later unload the library. 

   Local lhProcsLibHand as Dword
   Local lhRutAddr as Dword

   ' Must handle differently if running remote
   if guFlags.AreRunningRemote then

      ' Running remote so run remote proc
      irGetRutAddress "SQLiteRunProc", lhRutAddr
      call dword lhRutAddr using UsingRunProcRemote(ghDab, rsProcName, blParm1, blParm2, bsParm3, bsParm4, rsModChars) to glLastError

   else

      ' Running local so check if they passed an entry name
      if len(mid$(rsProcName, 2)) then

         ' Yes we have an entry name so load and get address
         lhProcsLibHand = LoadLibrary("SQLiteningProcs" & left$(rsProcName, 1))
         lhRutAddr = GetProcAddress(lhProcsLibHand, bycopy parse$(mid$(rsProcName, 2), $BS, 1))
         if lhRutAddr then
            call dword lhRutAddr using UsingRunProcLocal(ghDab, 0, blParm1, blParm2, bsParm3, bsParm4) to glLastError
         else
            glLastError = -19
         end if
         ' Free the lib if we can
         if isfalse instr(rsModChars, "u") then FreeLibrary(lhProcsLibHand)
      else

         ' No entry name then just load or free lib
         if instr(rsModChars, "L") then
            lhProcsLibHand = LoadLibrary("SQLiteningProcs" & left$(rsProcName, 1))
         elseif instr(rsModChars, "U") then
            lhProcsLibHand = GetModuleHandle("SQLiteningProcs" & rsProcName)
            FreeLibrary(lhProcsLibHand)
         end if
      end if
   end if
   if glLastError then goto ErrorRut

   ' Exit OK
   exit function

   ErrorRut:
   irHandleError "Run Proc " & rsProcName, rsModChars
   function = glLastError

End Function

Replace the following function in SQLiteningClient.Bas and compile.

Code Select Expand

'============================<[ Run Proc ]>============================
Function SQLiteRunProc alias "SQLiteRunProc" (byval rhDab as Dword, _
                                              rsProcName as String, _
                                              blParm1 as Long, _
                                              blParm2 as Long, _
                                              bsParm3 as String, _
                                              bsParm4 as String, _
                                              optional byval rsModChars as String)Export as Long
'   String to be passed is as follows:
'       1 -  4 = blParm1
'       5 -  8 = blParm2
'       9 - 12 = length of rsProcName
'      13 - ?? = rsProcName
'      ?? - ?? = length of bsParm3
'      ?? - ?? = bsParm3
'      ?? - ?? = length of bsParm4
'      ?? - ?? = bsParm4
'   String to be returned is as follows:
'       1 -  4 = blParm1
'       5 -  8 = blParm2
'       9 - ?? = length of bsParm3
'      ?? - ?? = bsParm3
'      ?? - ?? = length of bsParm4
'      ?? - ?? = bsParm4

   Local llOffset, llLength as Long
   Local lsA as String

   ' Call proc on server
   function = DoRequest(%reqRunProc, rhDab, _
                        iif&(instr(rsModChars, "L"), 1, 0) + iif&(instr(rsModChars, "U"), 2, 0) +  + iif&(instr(rsModChars, "u"), 4, 0), _
                        mkl$(blParm1) & mkl$(blParm2) & mkl$(len(rsProcName)) & rsProcName & _
                        mkl$(len(bsParm3)) & bsParm3 & mkl$(len(bsParm4)) & bsParm4, _
                        0, lsA)

   ' Set returning values from returning string
   blParm1 = cvl(lsA, 1)
   blParm2 = cvl(lsA, 5)
   llOffset = 9
   llLength = cvl(lsA, llOffset)
   bsParm3 = mid$(lsA, llOffSet + 4, llLength)
   llOffset = llOffset + llLength + 4
   llLength = cvl(lsA, llOffset)
   bsParm4 = mid$(lsA, llOffSet + 4, llLength)

End Function

Replace the following function in SQLiteningServer.Bas and compile.

Code Select Expand

'============================<[ Run Proc ]>============================
Function RunProc(byval rhDab as Dword, _
                 byval rlFlags as Long, _
                 rsDataIn as String, _
                 wsDataOut as String, _
                 byval rlTcpFileNumber as Long) as Long
'   DataIn is as follows:
'       1 -  4 = blParm1
'       5 -  8 = blParm2
'       9 - 12 = length of rsProcName
'      13 - ?? = rsProcName
'      ?? - ?? = length of bsParm3
'      ?? - ?? = bsParm3
'      ?? - ?? = length of bsParm4
'      ?? - ?? = bsParm4
'   DataOu is as follows:
'       1 -  4 = blParm1
'       5 -  8 = blParm2
'       9 - ?? = length of bsParm3
'      ?? - ?? = bsParm3
'      ?? - ?? = length of bsParm4
'      ?? - ?? = bsParm4
'   Flags: 1=Load, 2=Unload, 4=Don't Unload

   Local lhProcsLibHand as Dword
   Local lhRutAddr as Dword
   Local llRC as Long
   Local llOffset, llLength as Long
   Local llParm1, llParm2 as Long
   Local lsParm3, lsParm4 as String

   ' Check password
   llRC = CheckFileAccesss(">" & mid$(rsDataIn, 13, cvl(rsDataIn, 9)), 16, rlTcpFileNumber)
   if llRC = 0 then

      ' Set parms
      llParm1 = cvl(rsDataIn, 1)
      llParm2 = cvl(rsDataIn, 5)
      llOffset = 13 + cvl(rsDataIn, 9)
      llLength = cvl(rsDataIn, llOffset)
      lsParm3 = mid$(rsDataIn, llOffSet + 4, llLength)
      llOffset = llOffset + llLength + 4
      llLength = cvl(rsDataIn, llOffset)
      lsParm4 = mid$(rsDataIn, llOffSet + 4, llLength)

      ' Check if they passed an entry name
      if len(mid$(rsDataIn, 13 + 1, cvl(rsDataIn, 9) - 1)) then
         ' Yes we have an entry name so load and get address
         lhProcsLibHand = LoadLibrary("SQLiteningProcs" & left$(mid$(rsDataIn, 13, cvl(rsDataIn, 9)), 1))
         lhRutAddr = GetProcAddress(lhProcsLibHand, parse$(mid$(rsDataIn, 13 + 1, cvl(rsDataIn, 9) - 1), $BS, 1))
         if lhRutAddr then
            call dword lhRutAddr using UsingRunProc(rhDab, rlTcpFileNumber, llParm1, llParm2, lsParm3, lsParm4) to llRC
         else
            llRC = -19
         end if
         ' Free the lib if we can
         if isfalse (rlFlags and 4) then FreeLibrary(lhProcsLibHand)
      else
         ' No entry name then just load or free lib
         if (rlFlags and 1) then lhProcsLibHand = LoadLibrary("SQLiteningProcs" & left$(mid$(rsDataIn, 13, cvl(rsDataIn, 9)), 1))
         if (rlFlags and 2) then
            lhProcsLibHand = GetModuleHandle("SQLiteningProcs" & left$(mid$(rsDataIn, 13, cvl(rsDataIn, 9)), 1))
            FreeLibrary(lhProcsLibHand)
         end if
      end if
   end if

   'Build returning data out and return
   wsDataOut = mkl$(llParm1) & mkl$(llParm2) & mkl$(len(lsParm3)) & lsParm3 & mkl$(len(lsParm4)) & lsParm4
   function = llRC

End Function

Now to answer your question.  Yes it would be best to keep your high use
procs, including SQLite custom function, in a single separate library so
it can be loaded and unloaded.  The SQLite custom functions must stay in
memory and you will get a performance gain by also keeping high use ones
in memory.  You probably don't want to waste the memory on low use procs. 


Note that you can now load and unload the library with seperate calls to
RunProc.  If, for example, your library is suffix "T" and your entry is
"CreateFunction" then the first line below will load the Dll, the second
line will create the custom function, while the third line (run when your
are done with costom function) will unload the library. 

Code Select Expand

   slRunProc "T", 0, 0, "", "", "L"
   slRunProc "TCreateFunction", 0, 0, "", ""
   slRunProc "T", 0, 0, "", "", "U"

Another way to accomplish the same thing with one less call to the server is
to use the "u" modchar on the call to create the custom function (shown in
line one below) and then unload the library, when you no longer need it,
with line two. 

Code Select Expand

   slRunProc "TCreateFunction", 0, 0, "", "", "u"
   slRunProc "T", 0, 0, "", "", "U"

[Bern Ertl]

The following three programs need changing and compiling.

First and third modifications won't compile without a DECLARE for GetModuleHandle (easily found in Win32API.INC).

[Bern Ertl]

Fred, am I reading your code correctly?  It looks to me like if I don't use the "u" modchar when calling a library that was loaded with "L", it will unload it.

Also, in SQLiteningServer.Bas, shouldn't:

Code Select Expand

' Check if they passed an entry name
      if len(mid$(rsDataIn, 13 + 1, cvl(rsDataIn, 9) - 1)) then
         ' Yes we have an entry name so load and get address
         lhProcsLibHand = LoadLibrary("SQLiteningProcs" & left$(mid$(rsDataIn, 13, cvl(rsDataIn, 9)), 1))
         lhRutAddr = GetProcAddress(lhProcsLibHand, parse$(mid$(rsDataIn, 13 + 1, cvl(rsDataIn, 9) - 1), $BS, 1))

First check if the DLL is already loaded before calling LoadLibrary?  Or does LoadLibrary do that internally?

[Fred Meier]

You are right, the DECLARE for GetModuleHandle is needed in the two
modifications.  I have them in my copies, just forget to tell you. 

No, it will not leave memory.  The OS keeps a use count for Dll's.  Each
LoadLibrary will increase it while each FreeLibrary will decrease it.  The
Dll will not be removed from memory until the count is zero.  So if you
slRunProc with "L" modchar it will do a LoadLibrary(+1) so use count is
now one.  If you then slRunProc with no modchar it will do a
LoadLibrary(+1)(no disk IO) and a FreeLibrary(-1) so use count is still
one and Dll will remain in memory.  It will remain in memory until
slRunProc with "U" modchar. 

[Bern Ertl]

Thanks.  It's clear now.