REM ======================================================================================================================= REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === REM === Full documentation is available on https://help.libreoffice.org/ === REM ======================================================================================================================= Option Compatible Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' SF_Services ''' =========== ''' Singleton class implementing the "ScriptForge.Services" service ''' Implemented as a usual Basic module ''' The ScriptForge framework includes ''' the current ScriptForge library ''' a number of "associated" libraries ''' any user/contributor extension wanting to fit into the framework ''' The methods in this module constitute the kernel of the ScriptForge framework ''' - RegisterScriptServices ''' Register for a library the list of services it implements ''' Each library in the framework must implement its own RegisterScriptServices method ''' This method consists in a series of invocations of next 2 methods ''' - RegisterService ''' Register a single service ''' - RegisterEventManager ''' Register a single event manager ''' - CreateScriptService ''' Called by user scripts to get an object giving access to a service or to the event manager ''' ''' Detailed user documentation: ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_services.html?DbPAR=BASIC ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS Const UNKNOWNSERVICEERROR = "UNKNOWNSERVICEERROR" ' Service not found within the registered services of the given library Const SERVICESNOTLOADEDERROR = "SERVICESNOTLOADEDERROR" ' Failure during the registering of the services of the given library Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" ' Source file does not exist REM ============================================================== PUBLIC MEMBERS ' Defines an entry in in the services dictionary Type _Service ServiceName As String ServiceType As Integer ' 0 Undefined ' 1 Basic module ' 2 Method reference as a string ServiceReference As Object ServiceMethod As String EventManager As Boolean ' True if registered item is an event manager End Type Private vServicesArray As Variant ' List of services registered by a library REM ============================================================== PUBLIC METHODS REM ----------------------------------------------------------------------------- Public Function CreateScriptService(Optional ByRef Service As Variant _ , ParamArray pvArgs As Variant _ ) As Variant ''' Create access to the services of a library for the benefit of a user script ''' A service is to understand either: ''' as a set of methods gathered in a Basic standard module ''' or a set of methods and properties gathered in a Basic class module ''' Args: ''' Service: the name of the service in 2 parts "library.service" ''' The library is a Basic library that must exist in the GlobalScope ''' (default = "ScriptForge") ''' The service is one of the services registered by the library ''' thru the RegisterScriptServices() routine ''' pvArgs: a set of arguments passed to the constructor of the service ''' This is only possible if the service refers to a Basic class module ''' Returns ''' The object containing either the reference of the Basic module ''' or of the Basic class instance ''' Both are Basic objects ''' Returns Nothing if an error occurred. ''' ==>> NOTE: The error can be within the user script creating the new class instance ''' Exceptions: ''' SERVICESNOTLOADEDERROR RegisterScriptService probable failure ''' UNKNOWNSERVICEERROR Service not found ''' Examples ''' CreateScriptService("Array") ''' => Refers to ScriptForge.Array or SF_Array ''' CreateScriptService("ScriptForge.Dictionary") ''' => Returns a new empty dictionary; "ScriptForge." is optional ''' CreateScriptService("SFDocuments.Calc") ''' => Refers to the Calc service, implemented in the SFDocuments library ''' CreateScriptService("Dialog", dlgName) ''' => Returns a Dialog instance referring to the dlgName dialog ''' CreateScriptService("SFDocuments.Event", oEvent) ''' => Refers to the Document service instance, implemented in the SFDocuments library, having triggered the event Dim vScriptService As Variant ' Return value Dim vServiceItem As Variant ' A single service (see _Service type definition) Dim vServicesList As Variant ' Output of RegisterScriptServices Dim vSplit As Variant ' Array to split argument in Dim sLibrary As String ' Library part of the argument Dim sService As String ' Service part of the argument Dim vLibrary As Variant ' Dictionary of libraries Dim vService As Variant ' An individual service object Const cstThisSub = "SF_Services.CreateScriptService" Const cstSubArgs = "Service, arg0[, arg1] ..." If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Set vScriptService = Nothing Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(Service, "Service", V_STRING) Then GoTo Catch If Len(Service) = 0 Then GoTo CatchNotFound End If Try: ' Initialize the list of services when CreateScriptService called for the very 1st time If IsEmpty(_SF_.ServicesList) Then _SF_.ServicesList = SF_Services._NewDictionary() ' Simple parsing of argument vSplit = Split(Service, ".") If UBound(vSplit) > 1 Then GoTo CatchNotFound If UBound(vSplit) = 0 Then sLibrary = "ScriptForge" ' Yes, the default value ! sService = vSplit(0) ' Accept other default values for associated libraries Select Case LCase(sService) Case "document", "calc", "writer", "base", "documentevent", "formevent" sLibrary = "SFDocuments" Case "dialog", "dialogevent" : sLibrary = "SFDialogs" Case "database" : sLibrary = "SFDatabases" Case "unittest" : sLibrary = "SFUnitTests" Case "menu", "popupmenu" : sLibrary = "SFWidgets" Case Else End Select Else sLibrary = vSplit(0) sService = vSplit(1) End If With _SF_.ServicesList ' Load the set of services from the library, if not yet done If Not .Exists(sLibrary) Then If Not SF_Services._LoadLibraryServices(sLibrary) Then GoTo CatchNotLoaded End If ' Find and return the requested service vServicesList = .Item(sLibrary) If Not vServicesList.Exists(sService) Then GoTo CatchNotFound vServiceItem = vServicesList.Item(sService) Select Case vServiceItem.ServiceType Case 1 ' Basic module vScriptService = vServiceItem.ServiceReference Case 2 ' Method to call If sLibrary = "ScriptForge" Then ' Direct call Select Case UCase(sService) Case "DICTIONARY" : vScriptService = SF_Services._NewDictionary() Case "L10N" : vScriptService = SF_Services._NewL10N(pvArgs) Case "TIMER" : vScriptService = SF_Services._NewTimer(pvArgs) Case Else End Select Else ' Call via script provider Set vService = SF_Session._GetScript("Basic", SF_Session.SCRIPTISAPPLICATION, vServiceItem.ServiceMethod) vScriptService = vService.Invoke(Array(pvArgs()), Array(), Array()) End If Case Else End Select End With Finally: CreateScriptService = vScriptService SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally CatchNotFound: SF_Exception.RaiseFatal(UNKNOWNSERVICEERROR, "Service", Service, sLibrary, sService) GoTo Finally CatchNotLoaded: SF_Exception.RaiseFatal(SERVICESNOTLOADEDERROR, "Service", Service, sLibrary) GoTo Finally End Function ' ScriptForge.SF_Services.CreateScriptService REM ----------------------------------------------------------------------------- Public Function RegisterEventManager(Optional ByVal ServiceName As Variant _ , Optional ByRef ServiceReference As Variant _ ) As Boolean ''' Register into ScriptForge a new event entry for the library ''' from which this method is called ''' MUST BE CALLED ONLY from a specific RegisterScriptServices() method ''' Usually the method should be called only once by library ''' Args: ''' ServiceName: the name of the service as a string. It the service exists ''' already for the library the method overwrites the existing entry ''' ServiceReference: the function which will identify the source of the triggered event ''' something like: "libraryname.modulename.function" ''' Returns: ''' True if successful ''' Example: ''' ' Code snippet stored in a module contained in the SFDocuments library ''' Sub RegisterScriptServices() ''' ' Register the events manager of the library ''' RegisterEventManager("DocumentEvent", "SFDocuments.SF_Register._EventManager") ''' End Sub ''' ' Code snippet stored in a user script ''' Sub Trigger(poEvent As Object) ' Triggered by a DOCUMENTEVENT event ''' Dim myDoc As Object ''' ' To get the document concerned by the event: ''' Set myDoc = CreateScriptService("SFDocuments.DocumentEvent", poEvent) ''' End Sub Dim bRegister As Boolean ' Return value Const cstThisSub = "SF_Services.RegisterEventManager" Const cstSubArgs = "ServiceName, ServiceReference" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bRegister = False Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(ServiceName, "ServiceName", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(ServiceReference, "ServiceReference",V_STRING) Then GoTo Finally End If Try: bRegister = _AddToServicesArray(ServiceName, ServiceReference, True) Finally: RegisterEventManager = bRegister SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_Services.RegisterEventManager REM ----------------------------------------------------------------------------- Public Function RegisterService(Optional ByVal ServiceName As Variant _ , Optional ByRef ServiceReference As Variant _ ) As Boolean ''' Register into ScriptForge a new service entry for the library ''' from which this method is called ''' MUST BE CALLED ONLY from a specific RegisterScriptServices() method ''' Args: ''' ServiceName: the name of the service as a string. It the service exists ''' already for the library the method overwrites the existing entry ''' ServiceReference: either ''' - the Basic module that implements the methods of the service ''' something like: GlobalScope.Library.Module ''' - an instance of the class implementing the methods and properties of the service ''' something like: "libraryname.modulename.function" ''' Returns: ''' True if successful Dim bRegister As Boolean ' Return value Const cstThisSub = "SF_Services.RegisterService" Const cstSubArgs = "ServiceName, ServiceReference" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bRegister = False Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(ServiceName, "ServiceName", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(ServiceReference, "ServiceReference", Array(V_STRING, V_OBJECT)) Then GoTo Finally End If Try: bRegister = _AddToServicesArray(ServiceName, ServiceReference, False) Finally: RegisterService = bRegister SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_Services.RegisterService REM ----------------------------------------------------------------------------- Public Sub RegisterScriptServices() As Variant ''' Register into ScriptForge the list of the services implemented by the current library ''' Each library pertaining to the framework must implement its own version of this method ''' This method may be stored in any standard (i.e. not class-) module ''' ''' Each individual service is registered by calling the RegisterService() method ''' ''' The current version is given as an example ''' With GlobalScope.ScriptForge.SF_Services .RegisterService("Array", GlobalScope.ScriptForge.SF_Array) ' Reference to the Basic module .RegisterService("Dictionary", "ScriptForge.SF_Services._NewDictionary") ' Reference to the function initializing the service .RegisterService("Exception", GlobalScope.ScriptForge.SF_Exception) .RegisterService("FileSystem", GlobalScope.ScriptForge.SF_FileSystem) .RegisterService("L10N", "ScriptForge.SF_Services._NewL10N") .RegisterService("Platform", GlobalScope.ScriptForge.SF_Platform) .RegisterService("Region", GlobalScope.ScriptForge.SF_Region) .RegisterService("Session", GlobalScope.ScriptForge.SF_Session) .RegisterService("String", GlobalScope.ScriptForge.SF_String) .RegisterService("Timer", "ScriptForge.SF_Services._NewTimer") .RegisterService("UI", GlobalScope.ScriptForge.SF_UI) 'TODO End With End Sub ' ScriptForge.SF_Services.RegisterScriptServices REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- Private Function _AddToServicesArray(ByVal psServiceName As String _ , ByRef pvServiceReference As Variant _ , ByVal pbEvent As Boolean _ ) As Boolean ''' Add the arguments as an additional row in vServicesArray (Public variable) ''' Called from RegisterService and RegisterEvent methods Dim bRegister As Boolean ' Return value Dim lMax As Long ' Number of rows in vServicesArray bRegister = False Check: ' Ignore when method is not called from RegisterScriptServices() If IsEmpty(vServicesArray) Or IsNull(vServicesArray) Or Not IsArray(vServicesArray) Then GoTo Finally Try: lMax = UBound(vServicesArray, 1) + 1 If lMax <= 0 Then ReDim vServicesArray(0 To 0, 0 To 2) Else ReDim Preserve vServicesArray(0 To lMax, 0 To 2) End If vServicesArray(lMax, 0) = psServiceName vServicesArray(lMax, 1) = pvServiceReference vServicesArray(lMax, 2) = pbEvent bRegister = True Finally: _AddToServicesArray = bRegister Exit Function End Function ' ScriptForge.SF_Services._AddToServicesArray REM ----------------------------------------------------------------------------- Private Function _FindModuleFromMethod(ByVal psLibrary As String _ , ByVal psMethod As String _ ) As String ''' Find in the given library the name of the module containing ''' the method given as 2nd argument (usually RegisterScriptServices) ''' Args: ''' psLibrary: the name of the Basic library ''' psMethod: the method to locate ''' Returns: ''' The name of the module or a zero-length string if not found Dim vCategories As Variant ' "user" or "share" library categories Dim sCategory As String Dim vLanguages As Variant ' "Basic", "Python", ... programming languages Dim sLanguage As String Dim vLibraries As Variant ' Library names Dim sLibrary As String Dim vModules As Variant ' Module names Dim sModule As String ' Return value Dim vMethods As Variant ' Method/properties/subs/functions Dim sMethod As String Dim oRoot As Object ' com.sun.star.script.browse.BrowseNodeFactory Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer _FindModuleFromMethod = "" Set oRoot = SF_Utils._GetUNOService("BrowseNodeFactory").createView(com.sun.star.script.browse.BrowseNodeFactoryViewTypes.MACROORGANIZER) ' Exploration is done via tree nodes If Not IsNull(oRoot) Then If oRoot.hasChildNodes() Then vCategories = oRoot.getChildNodes() For i = 0 To UBound(vCategories) sCategory = vCategories(i).getName() ' Consider "My macros & Dialogs" and "LibreOffice Macros & Dialogs" only If sCategory = "user" Or sCategory = "share" Then If vCategories(i).hasChildNodes() Then vLanguages = vCategories(i).getChildNodes() For j = 0 To UBound(vLanguages) sLanguage = vLanguages(j).getName() ' Consider Basic libraries only If sLanguage = "Basic" Then If vLanguages(j).hasChildNodes() Then vLibraries = vLanguages(j).getChildNodes() For k = 0 To UBound(vLibraries) sLibrary = vLibraries(k).getName() ' Consider the given library only If sLibrary = psLibrary Then If vLibraries(k).hasChildNodes() Then vModules = vLibraries(k).getChildNodes() For l = 0 To UBound(vModules) sModule = vModules(l).getName() ' Check if the module contains the targeted method If vModules(l).hasChildNodes() Then vMethods = vModules(l).getChildNodes() For m = 0 To UBound(vMethods) sMethod = vMethods(m).getName() If sMethod = psMethod Then _FindModuleFromMethod = sModule Exit Function End If Next m End If Next l End If End If Next k End If End If Next j End If End If Next i End If End If End Function ' ScriptForge.SF_Services._FindModuleFromMethod REM ----------------------------------------------------------------------------- Private Function _LoadLibraryServices(ByVal psLibrary As String) As Boolean ''' Execute psLibrary.RegisterScriptServices() and load its services into the persistent storage ''' Args: ''' psLibrary: the name of the Basic library ''' Library will be loaded if not yet done ''' Returns: ''' True if success ''' The list of services is loaded directly into the persistent storage Dim vServicesList As Variant ' Dictionary of services Dim vService As Variant ' Single service entry in dictionary Dim vServiceItem As Variant ' Single service in vServicesArray Dim sModule As String ' Name of module containing the RegisterScriptServices method Dim i As Long Const cstRegister = "RegisterScriptServices" Try: _LoadLibraryServices = False vServicesArray = Array() If psLibrary = "ScriptForge" Then ' Direct call ScriptForge.SF_Services.RegisterScriptServices() Else ' Register services via script provider If GlobalScope.BasicLibraries.hasByName(psLibrary) Then If Not GlobalScope.BasicLibraries.isLibraryLoaded(psLibrary) Then GlobalScope.BasicLibraries.LoadLibrary(psLibrary) End If Else GoTo Finally End If sModule = SF_Services._FindModuleFromMethod(psLibrary, cstRegister) If Len(sModule) = 0 Then GoTo Finally SF_Session.ExecuteBasicScript(, psLibrary & "." & sModule & "." & cstRegister) End If ' Store in persistent storage ' - Create list of services for the current library Set vServicesList = SF_Services._NewDictionary() For i = 0 To UBound(vServicesArray, 1) Set vService = New _Service With vService .ServiceName = vServicesArray(i, 0) vServiceItem = vServicesArray(i, 1) If VarType(vServiceItem) = V_STRING Then .ServiceType = 2 .ServiceMethod = vServiceItem Set .ServiceReference = Nothing Else ' OBJECT .ServiceType = 1 .ServiceMethod = "" Set .ServiceReference = vServiceItem End If .EventManager = vServicesArray(i, 2) End With vServicesList.Add(vServicesArray(i, 0), vService) Next i ' - Add the new dictionary to the persistent dictionary _SF_.ServicesList.Add(psLibrary, vServicesList) _LoadLibraryServices = True vServicesArray = Empty Finally: Exit Function End Function ' ScriptForge.SF_Services._LoadLibraryServices REM ----------------------------------------------------------------------------- Public Function _NewDictionary() As Variant ''' Create a new instance of the SF_Dictionary class ''' Returns: the instance or Nothing Dim oDict As Variant If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: Try: Set oDict = New SF_Dictionary Set oDict.[Me] = oDict Finally: Set _NewDictionary = oDict Exit Function Catch: Set oDict = Nothing GoTo Finally End Function ' ScriptForge.SF_Services._NewDictionary REM ----------------------------------------------------------------------------- Public Function _NewL10N(Optional ByVal pvArgs As Variant) As Variant ''' Create a new instance of the SF_L10N class ' Args: ''' FolderName: the folder containing the PO files in SF_FileSystem.FileNaming notation ''' Locale: locale of user session (default) or any other valid la{nguage]-CO[UNTRY] combination ''' The country part is optional. Valid are f.i. "fr", "fr-CH", "en-US" ''' Encoding: The character set that should be used ''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml ''' Note that LibreOffice probably does not implement all existing sets ''' Default = UTF-8 ''' Locale2: fallback Locale to select if Locale po file does not exist (typically "en-US") ''' Encoding2: Encoding of the 2nd Locale file ''' Returns: the instance or Nothing ''' Exceptions: ''' UNKNOWNFILEERROR The PO file does not exist Dim oL10N As Variant ' Return value Dim sFolderName As String ' Folder containing the PO files Dim sLocale As String ' Passed argument or that of the user session Dim sLocale2 As String ' Alias for Locale2 Dim oLocale As Variant ' com.sun.star.lang.Locale Dim sPOFile As String ' PO file must exist Dim sEncoding As String ' Alias for Encoding Dim sEncoding2 As String ' Alias for Encoding2 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If IsMissing(pvArgs) Then pvArgs = Array() sPOFile = "" sEncoding = "" If UBound(pvArgs) >= 0 Then If Not SF_Utils._ValidateFile(pvArgs(0), "Folder (Arg0)", , True) Then GoTo Catch sFolderName = pvArgs(0) sLocale = "" If UBound(pvArgs) >= 1 Then If Not SF_Utils._Validate(pvArgs(1), "Locale (Arg1)", V_STRING) Then GoTo Catch sLocale = pvArgs(1) End If If Len(sLocale) = 0 Then ' Called from Python, the Locale argument may be the zero-length string Set oLocale = SF_Utils._GetUNOService("OfficeLocale") sLocale = oLocale.Language & "-" & oLocale.Country End If If UBound(pvArgs) >= 2 Then If IsMissing(pvArgs(2)) Or IsEmpty(pvArgs(2)) Then pvArgs(2) = "UTF-8" If Not SF_Utils._Validate(pvArgs(2), "Encoding (Arg2)", V_STRING) Then GoTo Catch sEncoding = pvArgs(2) Else sEncoding = "UTF-8" End If sLocale2 = "" If UBound(pvArgs) >= 3 Then If Not SF_Utils._Validate(pvArgs(3), "Locale2 (Arg3)", V_STRING) Then GoTo Catch sLocale2 = pvArgs(3) End If If UBound(pvArgs) >= 4 Then If Not SF_Utils._Validate(pvArgs(4), "Encoding2 (Arg4)", V_STRING) Then GoTo Catch sEncoding2 = pvArgs(4) Else sEncoding2 = "UTF-8" End If If Len(sFolderName) > 0 Then sPOFile = SF_FileSystem.BuildPath(sFolderName, sLocale & ".po") If Not SF_FileSystem.FileExists(sPOFile) Then If Len(sLocale2) = 0 Then GoTo CatchNotExists ' No fallback => error ' Try the fallback sPOFile = SF_FileSystem.BuildPath(sFolderName, sLocale2 & ".po") If Not SF_FileSystem.FileExists(sPOFile) Then GoTo CatchNotExists sEncoding = sEncoding2 End If End If End If Try: Set oL10N = New SF_L10N Set oL10N.[Me] = oL10N oL10N._Initialize(sPOFile, sEncoding) Finally: Set _NewL10N = oL10N Exit Function Catch: Set oL10N = Nothing GoTo Finally CatchNotExists: SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", sPOFile) GoTo Finally End Function ' ScriptForge.SF_Services._NewL10N REM ----------------------------------------------------------------------------- Public Function _NewTimer(Optional ByVal pvArgs As Variant) As Variant ''' Create a new instance of the SF_Timer class ''' Args: ''' [0] : If True, start the timer immediately ''' Returns: the instance or Nothing Dim oTimer As Variant ' Return value Dim bStart As Boolean ' Automatic start ? If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If IsMissing(pvArgs) Then pvArgs = Array() If UBound(pvArgs) < 0 Then bStart = False Else If Not SF_Utils._Validate(pvArgs(0), "Start (Arg0)", V_BOOLEAN) Then GoTo Catch bStart = pvArgs(0) End If Try: Set oTimer = New SF_Timer Set oTimer.[Me] = oTimer If bStart Then oTimer.Start() Finally: Set _NewTimer = oTimer Exit Function Catch: Set oTimer = Nothing GoTo Finally End Function ' ScriptForge.SF_Services._NewTimer REM ============================================== END OF SCRIPTFORGE.SF_SERVICES