| blob | b72298ea3046c81e222532b69da79fd219884766 |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Services" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === Full documentation is available on https://help.libreoffice.org/ ===
6 REM =======================================================================================================================
8 Option Compatible
9 Option Explicit
11 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
12 ''' SF_Services
13 ''' ===========
15 ''' Implemented as a usual Basic module
16 ''' The ScriptForge framework includes
17 ''' the current ScriptForge library
19 ''' any user/contributor extension wanting to fit into the framework
20 ''' The methods in this module constitute the kernel of the ScriptForge framework
21 ''' - RegisterScriptServices
22 ''' Register for a library the list of services it implements
23 ''' Each library in the framework must implement its own RegisterScriptServices method
25 ''' - RegisterService
26 ''' Register a single service
27 ''' - RegisterEventManager
28 ''' Register a single event manager
29 ''' - CreateScriptService
30 ''' Called by user scripts to get an object giving access to a service or to the event manager
31 '''
32 ''' Detailed user documentation:
33 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_services.html?DbPAR=BASIC
34 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
36 REM ================================================================== EXCEPTIONS
38 Const UNKNOWNSERVICEERROR = "UNKNOWNSERVICEERROR" ' Service not found within the registered services of the given library
39 Const SERVICESNOTLOADEDERROR = "SERVICESNOTLOADEDERROR" ' Failure during the registering of the services of the given library
42 REM ============================================================== PUBLIC MEMBERS
44 ' Defines an entry in in the services dictionary
45 Type _Service
46 ServiceName As String
47 ServiceType As Integer
51 ServiceReference As Object
52 ServiceMethod As String
53 EventManager As Boolean ' True if registered item is an event manager
54 End Type
56 Private vServicesArray As Variant ' List of services registered by a library
58 REM ============================================================== PUBLIC METHODS
60 REM -----------------------------------------------------------------------------
61 Public Function CreateScriptService(Optional ByRef Service As Variant _
62 , ParamArray pvArgs As Variant _
63 ) As Variant
64 ''' Create access to the services of a library for the benefit of a user script
65 ''' A service is to understand either:
66 ''' as a set of methods gathered in a Basic standard module
67 ''' or a set of methods and properties gathered in a Basic class module
68 ''' Args:
70 ''' The library is a Basic library that must exist in the GlobalScope
72 ''' The service is one of the services registered by the library
73 ''' thru the RegisterScriptServices() routine
74 ''' pvArgs: a set of arguments passed to the constructor of the service
75 ''' This is only possible if the service refers to a Basic class module
76 ''' Returns
77 ''' The object containing either the reference of the Basic module
78 ''' or of the Basic class instance
79 ''' Both are Basic objects
80 ''' Returns Nothing if an error occurred.
81 ''' ==>> NOTE: The error can be within the user script creating the new class instance
82 ''' Exceptions:
83 ''' SERVICESNOTLOADEDERROR RegisterScriptService probable failure
84 ''' UNKNOWNSERVICEERROR Service not found
85 ''' Examples
95 ''' => Refers to the Document service instance, implemented in the SFDocuments library, having triggered the event
97 Dim vScriptService As Variant ' Return value
98 Dim vServiceItem As Variant ' A single service (see _Service type definition)
99 Dim vServicesList As Variant ' Output of RegisterScriptServices
100 Dim vSplit As Variant ' Array to split argument in
101 Dim sLibrary As String ' Library part of the argument
102 Dim sService As String ' Service part of the argument
103 Dim vLibrary As Variant ' Dictionary of libraries
104 Dim vService As Variant ' An individual service object
108 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
109 Set vScriptService = Nothing
111 Check:
112 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
114 If Len(Service) = 0 Then GoTo CatchNotFound
115 End If
117 Try:
119 If IsEmpty(_SF_.ServicesList) Then _SF_.ServicesList = SF_Services._NewDictionary()
121 ' Simple parsing of argument
124 If UBound(vSplit) = 0 Then
126 sService = vSplit(0)
127 ' Accept other default values for associated libraries
128 Select Case LCase(sService)
129 Case "document", "calc", "writer", "base", "documentevent", "formevent"
135 Case Else
136 End Select
137 Else
138 sLibrary = vSplit(0)
139 sService = vSplit(1)
140 End If
142 With _SF_.ServicesList
144 ' Load the set of services from the library, if not yet done
145 If Not .Exists(sLibrary) Then
146 If Not SF_Services._LoadLibraryServices(sLibrary) Then GoTo CatchNotLoaded
147 End If
149 ' Find and return the requested service
150 vServicesList = .Item(sLibrary)
151 If Not vServicesList.Exists(sService) Then GoTo CatchNotFound
152 vServiceItem = vServicesList.Item(sService)
153 Select Case vServiceItem.ServiceType
155 vScriptService = vServiceItem.ServiceReference
158 Select Case UCase(sService)
162 Case Else
163 End Select
164 Else ' Call via script provider
165 Set vService = SF_Session._GetScript("Basic", SF_Session.SCRIPTISAPPLICATION, vServiceItem.ServiceMethod)
166 vScriptService = vService.Invoke(Array(pvArgs()), Array(), Array())
167 End If
168 Case Else
169 End Select
171 End With
173 Finally:
174 CreateScriptService = vScriptService
175 SF_Utils._ExitFunction(cstThisSub)
176 Exit Function
177 Catch:
178 GoTo Finally
179 CatchNotFound:
181 GoTo Finally
182 CatchNotLoaded:
184 GoTo Finally
185 End Function ' ScriptForge.SF_Services.CreateScriptService
187 REM -----------------------------------------------------------------------------
188 Public Function RegisterEventManager(Optional ByVal ServiceName As Variant _
189 , Optional ByRef ServiceReference As Variant _
190 ) As Boolean
191 ''' Register into ScriptForge a new event entry for the library
192 ''' from which this method is called
193 ''' MUST BE CALLED ONLY from a specific RegisterScriptServices() method
194 ''' Usually the method should be called only once by library
195 ''' Args:
196 ''' ServiceName: the name of the service as a string. It the service exists
197 ''' already for the library the method overwrites the existing entry
198 ''' ServiceReference: the function which will identify the source of the triggered event
200 ''' Returns:
201 ''' True if successful
202 ''' Example:
203 ''' ' Code snippet stored in a module contained in the SFDocuments library
204 ''' Sub RegisterScriptServices()
205 ''' ' Register the events manager of the library
206 ''' RegisterEventManager("DocumentEvent", "SFDocuments.SF_Register._EventManager")
207 ''' End Sub
208 ''' ' Code snippet stored in a user script
210 ''' Dim myDoc As Object
211 ''' ' To get the document concerned by the event:
212 ''' Set myDoc = CreateScriptService("SFDocuments.DocumentEvent", poEvent)
213 ''' End Sub
215 Dim bRegister As Boolean ' Return value
219 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
220 bRegister = False
222 Check:
223 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
225 If Not SF_Utils._Validate(ServiceReference, "ServiceReference",V_STRING) Then GoTo Finally
226 End If
228 Try:
229 bRegister = _AddToServicesArray(ServiceName, ServiceReference, True)
231 Finally:
232 RegisterEventManager = bRegister
233 SF_Utils._ExitFunction(cstThisSub)
234 Exit Function
235 Catch:
236 GoTo Finally
237 End Function ' ScriptForge.SF_Services.RegisterEventManager
239 REM -----------------------------------------------------------------------------
240 Public Function RegisterService(Optional ByVal ServiceName As Variant _
241 , Optional ByRef ServiceReference As Variant _
242 ) As Boolean
243 ''' Register into ScriptForge a new service entry for the library
244 ''' from which this method is called
245 ''' MUST BE CALLED ONLY from a specific RegisterScriptServices() method
246 ''' Args:
247 ''' ServiceName: the name of the service as a string. It the service exists
248 ''' already for the library the method overwrites the existing entry
249 ''' ServiceReference: either
250 ''' - the Basic module that implements the methods of the service
251 ''' something like: GlobalScope.Library.Module
252 ''' - an instance of the class implementing the methods and properties of the service
254 ''' Returns:
255 ''' True if successful
257 Dim bRegister As Boolean ' Return value
261 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
262 bRegister = False
264 Check:
265 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
267 If Not SF_Utils._Validate(ServiceReference, "ServiceReference", Array(V_STRING, V_OBJECT)) Then GoTo Finally
268 End If
270 Try:
271 bRegister = _AddToServicesArray(ServiceName, ServiceReference, False)
273 Finally:
274 RegisterService = bRegister
275 SF_Utils._ExitFunction(cstThisSub)
276 Exit Function
277 Catch:
278 GoTo Finally
279 End Function ' ScriptForge.SF_Services.RegisterService
281 REM -----------------------------------------------------------------------------
282 Public Sub RegisterScriptServices() As Variant
283 ''' Register into ScriptForge the list of the services implemented by the current library
284 ''' Each library pertaining to the framework must implement its own version of this method
285 ''' This method may be stored in any standard (i.e. not class-) module
286 '''
287 ''' Each individual service is registered by calling the RegisterService() method
288 '''
289 ''' The current version is given as an example
290 '''
291 With GlobalScope.ScriptForge.SF_Services
292 .RegisterService("Array", GlobalScope.ScriptForge.SF_Array) ' Reference to the Basic module
293 .RegisterService("Dictionary", "ScriptForge.SF_Services._NewDictionary") ' Reference to the function initializing the service
303 'TODO
304 End With
306 End Sub ' ScriptForge.SF_Services.RegisterScriptServices
308 REM =========================================================== PRIVATE FUNCTIONS
310 REM -----------------------------------------------------------------------------
311 Private Function _AddToServicesArray(ByVal psServiceName As String _
312 , ByRef pvServiceReference As Variant _
313 , ByVal pbEvent As Boolean _
314 ) As Boolean
315 ''' Add the arguments as an additional row in vServicesArray (Public variable)
316 ''' Called from RegisterService and RegisterEvent methods
318 Dim bRegister As Boolean ' Return value
319 Dim lMax As Long ' Number of rows in vServicesArray
321 bRegister = False
323 Check:
324 ' Ignore when method is not called from RegisterScriptServices()
325 If IsEmpty(vServicesArray) Or IsNull(vServicesArray) Or Not IsArray(vServicesArray) Then GoTo Finally
327 Try:
331 Else
333 End If
334 vServicesArray(lMax, 0) = psServiceName
335 vServicesArray(lMax, 1) = pvServiceReference
336 vServicesArray(lMax, 2) = pbEvent
337 bRegister = True
339 Finally:
340 _AddToServicesArray = bRegister
341 Exit Function
342 End Function ' ScriptForge.SF_Services._AddToServicesArray
344 REM -----------------------------------------------------------------------------
345 Private Function _FindModuleFromMethod(ByVal psLibrary As String _
346 , ByVal psMethod As String _
347 ) As String
348 ''' Find in the given library the name of the module containing
350 ''' Args:
351 ''' psLibrary: the name of the Basic library
352 ''' psMethod: the method to locate
353 ''' Returns:
354 ''' The name of the module or a zero-length string if not found
357 Dim sCategory As String
358 Dim vLanguages As Variant ' "Basic", "Python", ... programming languages
359 Dim sLanguage As String
360 Dim vLibraries As Variant ' Library names
361 Dim sLibrary As String
362 Dim vModules As Variant ' Module names
363 Dim sModule As String ' Return value
364 Dim vMethods As Variant ' Method/properties/subs/functions
365 Dim sMethod As String
366 Dim oRoot As Object ' com.sun.star.script.browse.BrowseNodeFactory
367 Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
369 _FindModuleFromMethod = ""
370 Set oRoot = SF_Utils._GetUNOService("BrowseNodeFactory").createView(com.sun.star.script.browse.BrowseNodeFactoryViewTypes.MACROORGANIZER)
372 ' Exploration is done via tree nodes
373 If Not IsNull(oRoot) Then
374 If oRoot.hasChildNodes() Then
375 vCategories = oRoot.getChildNodes()
376 For i = 0 To UBound(vCategories)
377 sCategory = vCategories(i).getName()
378 ' Consider "My macros & Dialogs" and "LibreOffice Macros & Dialogs" only
380 If vCategories(i).hasChildNodes() Then
381 vLanguages = vCategories(i).getChildNodes()
382 For j = 0 To UBound(vLanguages)
383 sLanguage = vLanguages(j).getName()
384 ' Consider Basic libraries only
386 If vLanguages(j).hasChildNodes() Then
387 vLibraries = vLanguages(j).getChildNodes()
388 For k = 0 To UBound(vLibraries)
389 sLibrary = vLibraries(k).getName()
390 ' Consider the given library only
391 If sLibrary = psLibrary Then
392 If vLibraries(k).hasChildNodes() Then
393 vModules = vLibraries(k).getChildNodes()
394 For l = 0 To UBound(vModules)
395 sModule = vModules(l).getName()
396 ' Check if the module contains the targeted method
397 If vModules(l).hasChildNodes() Then
398 vMethods = vModules(l).getChildNodes()
399 For m = 0 To UBound(vMethods)
400 sMethod = vMethods(m).getName()
401 If sMethod = psMethod Then
402 _FindModuleFromMethod = sModule
403 Exit Function
404 End If
405 Next m
406 End If
407 Next l
408 End If
409 End If
410 Next k
411 End If
412 End If
413 Next j
414 End If
415 End If
416 Next i
417 End If
418 End If
420 End Function ' ScriptForge.SF_Services._FindModuleFromMethod
422 REM -----------------------------------------------------------------------------
423 Private Function _LoadLibraryServices(ByVal psLibrary As String) As Boolean
424 ''' Execute psLibrary.RegisterScriptServices() and load its services into the persistent storage
425 ''' Args:
426 ''' psLibrary: the name of the Basic library
427 ''' Library will be loaded if not yet done
428 ''' Returns:
429 ''' True if success
430 ''' The list of services is loaded directly into the persistent storage
433 Dim vServicesList As Variant ' Dictionary of services
434 Dim vService As Variant ' Single service entry in dictionary
435 Dim vServiceItem As Variant ' Single service in vServicesArray
436 Dim sModule As String ' Name of module containing the RegisterScriptServices method
437 Dim i As Long
440 Try:
441 _LoadLibraryServices = False
443 vServicesArray = Array()
446 ' Direct call
447 ScriptForge.SF_Services.RegisterScriptServices()
448 Else
449 ' Register services via script provider
450 If GlobalScope.BasicLibraries.hasByName(psLibrary) Then
451 If Not GlobalScope.BasicLibraries.isLibraryLoaded(psLibrary) Then
452 GlobalScope.BasicLibraries.LoadLibrary(psLibrary)
453 End If
454 Else
455 GoTo Finally
456 End If
457 sModule = SF_Services._FindModuleFromMethod(psLibrary, cstRegister)
458 If Len(sModule) = 0 Then GoTo Finally
459 SF_Session.ExecuteBasicScript(, psLibrary & "." & sModule & "." & cstRegister)
460 End If
462 ' Store in persistent storage
463 ' - Create list of services for the current library
464 Set vServicesList = SF_Services._NewDictionary()
466 Set vService = New _Service
467 With vService
468 .ServiceName = vServicesArray(i, 0)
469 vServiceItem = vServicesArray(i, 1)
470 If VarType(vServiceItem) = V_STRING Then
471 .ServiceType = 2
472 .ServiceMethod = vServiceItem
473 Set .ServiceReference = Nothing
474 Else ' OBJECT
475 .ServiceType = 1
476 .ServiceMethod = ""
477 Set .ServiceReference = vServiceItem
478 End If
479 .EventManager = vServicesArray(i, 2)
480 End With
481 vServicesList.Add(vServicesArray(i, 0), vService)
482 Next i
483 ' - Add the new dictionary to the persistent dictionary
484 _SF_.ServicesList.Add(psLibrary, vServicesList)
485 _LoadLibraryServices = True
486 vServicesArray = Empty
488 Finally:
489 Exit Function
490 End Function ' ScriptForge.SF_Services._LoadLibraryServices
492 REM -----------------------------------------------------------------------------
493 Public Function _NewDictionary() As Variant
494 ''' Create a new instance of the SF_Dictionary class
495 ''' Returns: the instance or Nothing
497 Dim oDict As Variant
499 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
501 Check:
503 Try:
504 Set oDict = New SF_Dictionary
505 Set oDict.[Me] = oDict
507 Finally:
508 Set _NewDictionary = oDict
509 Exit Function
510 Catch:
511 Set oDict = Nothing
512 GoTo Finally
513 End Function ' ScriptForge.SF_Services._NewDictionary
515 REM -----------------------------------------------------------------------------
516 Public Function _NewL10N(Optional ByVal pvArgs As Variant) As Variant
517 ''' Create a new instance of the SF_L10N class
518 ' Args:
519 ''' FolderName: the folder containing the PO files in SF_FileSystem.FileNaming notation
520 ''' Locale: locale of user session (default) or any other valid la{nguage]-CO[UNTRY] combination
521 ''' The country part is optional. Valid are f.i. "fr", "fr-CH", "en-US"
522 ''' Encoding: The character set that should be used
523 ''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml
524 ''' Note that LibreOffice probably does not implement all existing sets
526 ''' Locale2: fallback Locale to select if Locale po file does not exist (typically "en-US")
528 ''' Returns: the instance or Nothing
529 ''' Exceptions:
530 ''' UNKNOWNFILEERROR The PO file does not exist
532 Dim oL10N As Variant ' Return value
533 Dim sFolderName As String ' Folder containing the PO files
534 Dim sLocale As String ' Passed argument or that of the user session
535 Dim sLocale2 As String ' Alias for Locale2
536 Dim oLocale As Variant ' com.sun.star.lang.Locale
537 Dim sPOFile As String ' PO file must exist
538 Dim sEncoding As String ' Alias for Encoding
539 Dim sEncoding2 As String ' Alias for Encoding2
541 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
543 Check:
544 If IsMissing(pvArgs) Then pvArgs = Array()
545 sPOFile = ""
546 sEncoding = ""
549 sFolderName = pvArgs(0)
550 sLocale = ""
553 sLocale = pvArgs(1)
554 End If
555 If Len(sLocale) = 0 Then ' Called from Python, the Locale argument may be the zero-length string
558 End If
562 sEncoding = pvArgs(2)
563 Else
565 End If
566 sLocale2 = ""
569 sLocale2 = pvArgs(3)
570 End If
573 sEncoding2 = pvArgs(4)
574 Else
576 End If
579 If Not SF_FileSystem.FileExists(sPOFile) Then
581 ' Try the fallback
583 If Not SF_FileSystem.FileExists(sPOFile) Then GoTo CatchNotExists
584 sEncoding = sEncoding2
585 End If
586 End If
587 End If
589 Try:
590 Set oL10N = New SF_L10N
591 Set oL10N.[Me] = oL10N
592 oL10N._Initialize(sPOFile, sEncoding)
594 Finally:
595 Set _NewL10N = oL10N
596 Exit Function
597 Catch:
598 Set oL10N = Nothing
599 GoTo Finally
600 CatchNotExists:
602 GoTo Finally
603 End Function ' ScriptForge.SF_Services._NewL10N
605 REM -----------------------------------------------------------------------------
606 Public Function _NewTimer(Optional ByVal pvArgs As Variant) As Variant
607 ''' Create a new instance of the SF_Timer class
608 ''' Args:
610 ''' Returns: the instance or Nothing
612 Dim oTimer As Variant ' Return value
613 Dim bStart As Boolean ' Automatic start ?
615 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
617 Check:
618 If IsMissing(pvArgs) Then pvArgs = Array()
620 bStart = False
621 Else
623 bStart = pvArgs(0)
624 End If
625 Try:
626 Set oTimer = New SF_Timer
627 Set oTimer.[Me] = oTimer
628 If bStart Then oTimer.Start()
630 Finally:
631 Set _NewTimer = oTimer
632 Exit Function
633 Catch:
634 Set oTimer = Nothing
635 GoTo Finally
636 End Function ' ScriptForge.SF_Services._NewTimer
638 REM ============================================== END OF SCRIPTFORGE.SF_SERVICES
639 </script:module>