Gambas 3/Gambas3LeLangage/L'orienté objet avec Gambas/L'introspection
Introspection
modifierGambas est capable de retrouver les caractéristiques d'un objet durant l'exécution d'un programme.
Il peut, par exemple, répondre aux questions suivantes :
- Quelle est la classe qui a été utilisée pour créer l'objet que je traite ?
- Cette classe hérite-elle d'une autre ?
- L'objet peut-il faire ceci ou cela ?
Gambas peut générer des objets. En revanche, créer une toute nouvelle classe dynamiquement semble ne pas être possible.
En revanche, vous pouvez générer un projet (créer des dossiers, des fichiers avec l'extension .class, et ainsi de suite). Après, vous pouvez compiler le projet ainsi créé avec gbc, l'archiver avec gba et enfin l'exécuter avec gbr3 ! Les scripts Gambas (gbs) fonctionnent ainsi.
Ci-dessous, voici du code pour illustrer l'introspection. Ce code affiche l'interface d'une classe. Il est imparfait mais ça donne une bonne idée du concept.
Le plus intéressant est tout en bas, dans le code du module.
Voici la classe de base Symbol représentant un élément de l'interface :
' Gambas class file
' Symbol
Public Const const_SymbolDescription As String = "Symbol"
Property TypeName As String
Property SymbolName As String
Private $sTypeName As String
Private $sSymbolName As String
Private Function TypeName_Read() As String
Return $sTypeName
End
Private Sub TypeName_Write(Value As String)
$sTypeName = Value
End
Private Function SymbolName_Read() As String
Return $sSymbolName
End
Private Sub SymbolName_Write(Value As String)
$sSymbolName = Value
End
Public Function ToString() As String
Return "(" & const_SymbolDescription & ") Name: " & $sSymbolName & ", Type: " & $sTypeName & ". "
End
Puis les classes fille :
- SymConstant représente une constante
' Gambas class file
' SymConstant
Inherits Symbol
Public Const const_SymbolDescription As String = "Constant"
Property IsStatic As Boolean
Property TheValue As Variant
Private $bIsStatic As Boolean
Private $vTheValue As Variant
Private Function IsStatic_Read() As Boolean
Return $bIsStatic
End
Private Sub IsStatic_Write(Value As Boolean)
$bIsStatic = Value
End
Private Function TheValue_Read() As Variant
Return $vTheValue
End
Private Sub TheValue_Write(Value As Variant)
$vTheValue = Value
End
Public Function ToString() As String
Return "(" & const_SymbolDescription & ") Name: " & Me.SymbolName & ", Type: " & Me.TypeName & IIf(Me.IsStatic, ", IsStatic", "") & ", Value: " & Me.TheValue & ". "
End
- SymEvent représente un événement
' Gambas class file
' SymEvent
Inherits Symbol
Public Const const_SymbolDescription As String = "Event"
Property Signature As String
Private $sSignature As String
Private Function Signature_Read() As String
Return $sSignature
End
Private Sub Signature_Write(Value As String)
$sSignature = Value
End
Public Function ToString() As String
Return "(" & const_SymbolDescription & ") Name: " & Me.SymbolName & ", Type: " & Me.TypeName & ", Signature: " & Me.Signature & ". "
End
- SymMethod représente une méthode
' Gambas class file
' SymMethod
Inherits Symbol
Public Const const_SymbolDescription As String = "Method"
Property IsStatic As Boolean
Property Signature As String
Private $bIsStatic As Boolean
Private $sSignature As String
Private Function IsStatic_Read() As Boolean
Return $bIsStatic
End
Private Sub IsStatic_Write(Value As Boolean)
$bIsStatic = Value
End
Private Function Signature_Read() As String
Return $sSignature
End
Private Sub Signature_Write(Value As String)
$sSignature = Value
End
Public Function ToString() As String
Return "(" & const_SymbolDescription & ") Name: " & Me.SymbolName & ", Type: " & Me.TypeName & IIf(Me.IsStatic, ", IsStatic", "") & ", Signature: " & Me.Signature & ". "
End
- SymProperty représente une propriété
' Gambas class file
' SymProperty
Inherits Symbol
Public Const const_SymbolDescription As String = "Property"
Property IsStatic As Boolean
Property IsReadOnly As Boolean
Private $bIsStatic As Boolean
Private $bIsReadOnly As Boolean
Private Function IsStatic_Read() As Boolean
Return $bIsStatic
End
Private Sub IsStatic_Write(Value As Boolean)
$bIsStatic = Value
End
Private Function IsReadOnly_Read() As Boolean
Return $bIsReadOnly
End
Private Sub IsReadOnly_Write(Value As Boolean)
$bIsReadOnly = Value
End
Public Function ToString() As String
Return "(" & const_SymbolDescription & ") Name: " & Me.SymbolName & ", Type: " & Me.TypeName & IIf(Me.IsStatic, ", IsStatic", "") & IIf(Me.IsReadOnly, ", IsReadOnly", "") & ". "
End
- SymVariable représente une variable
' Gambas class file
' SymVariable
Inherits Symbol
Public Const const_SymbolDescription As String = "Variable"
Property IsStatic As Boolean
Property TheValue As Variant
Private $bIsStatic As Boolean
Private $vTheValue As Variant
Private Function IsStatic_Read() As Boolean
Return $bIsStatic
End
Private Sub IsStatic_Write(Value As Boolean)
$bIsStatic = Value
End
Private Function TheValue_Read() As Variant
Return $vTheValue
End
Private Sub TheValue_Write(Value As Variant)
$vTheValue = Value
End
Public Function ToString() As String
Return "(" & const_SymbolDescription & ") Name: " & Me.SymbolName & ", Type: " & Me.TypeName & IIf(Me.IsStatic, ", IsStatic", "") & ", Value: " & Me.TheValue & ". "
End
En enfin, voici le code principal du module de démarrage :
' Gambas module file
' Module1
Public Sub Main()
Dim hClass As Class
Dim hParentClass As Class
Dim sClassName As String
Dim i As Integer
Dim sSymbolName As String
Dim symConst As SymConstant
Dim symEvnt As SymEvent
Dim symMeth As SymMethod
Dim symProp As SymProperty
Dim symVar As SymVariable
Dim constants As New SymConstant[]
Dim events As New SymEvent[]
Dim methods As New SymMethod[]
Dim properties As New SymProperty[]
Dim variables As New SymVariable[]
sClassName = "Component" ' <<-- Give the name of the class here
Print "Starting the analysis for the class \"" & sClassName & "\" ... "
Print "(Remember that we cannot see the private symbols of the class.) "
Try hClass = Classes[sClassName]
If Error Then
Error.Clear
Try hClass = Class.Load(sClassName)
If Error Then
Error.Clear
Print "The class \"" & sClassName & "\" does not exists or the component is not loaded. "
Quit
Else
Print "This is a standard class. "
Endif
Else
Print "The class " & sClassName & " is Static Created! "
Endif
hParentClass = hClass.Parent
If hParentClass Then
Print "The class " & sClassName & " inherits from class " & hParentClass.Name & ". "
Else
Print "No inheritance detected. "
Endif
For i = 0 To hClass.Symbols.Count - 1
sSymbolName = hClass.Symbols[i]
Select Case hClass[sSymbolName].Kind
Case Class.Event
symEvnt = New SymEvent
With symEvnt
.SymbolName = sSymbolName
.TypeName = GetTypeFrom(hClass[sSymbolName].Type)
.Signature = GetTypeFrom(hClass[sSymbolName].Signature)
End With
events.Add(symEvnt, events.Count)
Case Class.Constant
symConst = New SymConstant
With symConst
.SymbolName = sSymbolName
.TypeName = GetTypeFrom(hClass[sSymbolName].Type)
.IsStatic = CBool(hClass[sSymbolName].Static)
.TheValue = hClass[sSymbolName].Value
End With
constants.Add(symConst, constants.Count)
Case Class.Method
symMeth = New SymMethod
With symMeth
.SymbolName = sSymbolName
.TypeName = GetTypeFrom(hClass[sSymbolName].Type)
.IsStatic = CBool(hClass[sSymbolName].Static)
.Signature = GetTypeFrom(hClass[sSymbolName].Signature)
End With
methods.Add(symMeth, methods.Count)
Case Class.Property
symProp = New SymProperty
With symProp
.SymbolName = sSymbolName
.TypeName = GetTypeFrom(hClass[sSymbolName].Type)
.IsStatic = CBool(hClass[sSymbolName].Static)
.IsReadOnly = CBool(hClass[sSymbolName].ReadOnly)
End With
properties.Add(symProp, properties.Count)
Case Class.Variable
symVar = New SymVariable
With symVar
.SymbolName = sSymbolName
.TypeName = GetTypeFrom(hClass[sSymbolName].Type)
.IsStatic = CBool(hClass[sSymbolName].Static)
.TheValue = hClass[sSymbolName].Value
End With
variables.Add(symVar, variables.Count)
Case Else
Print hClass.Symbols[i] & " is something else. "
Error.Raise("This should not happend! Unrecognized type of symbol. ")
End Select
Next
For Each symConst In constants
Print symConst.ToString()
Next
For Each symEvnt In events
Print symEvnt.ToString()
Next
For Each symMeth In methods
Print symMeth.ToString()
Next
For Each symProp In properties
Print symProp.ToString()
Next
For Each symVar In variables
Print symVar.ToString()
Next
End
Public Function GetTypeFrom(Value As String) As String
Dim result As String = ""
Dim i As Integer
If Value Then
If Value = "_Settings_Keys" Then
result &= "|" & Trim(Value) & "|"
Else If Value = ".Symbol" Then
result &= "|" & Trim(Value) & "|"
Else If Value = "Args" Then
result &= "|" & Trim(Value) & "|"
Else If Value = "Class" Then
result &= "|" & Trim(Value) & "|"
Else If Value = "Env" Then
result &= "|" & Trim(Value) & "|"
Else If Value = "Stream;" Then
result &= "|" & Trim(Value) & "|"
Else If Value = "String[]" Then
result &= "|" & Trim(Value) & "|"
Else If Value = "Component" Then
result &= "|" & Trim(Value) & "|"
Else
For i = 1 To Len(Value)
Select Case Right(Left(Value, i), 1)
Case ";"
result &= "|Optional Flag|"
Case "b"
result &= "|Boolean|"
Case "f"
result &= "|Float|"
Case "i"
result &= "|Integer|"
Case "l"
result &= "|Long|"
Case "o"
result &= "|Objet|"
Case "s"
result &= "|String|"
Case "v"
result &= "|Variant|"
Case Else
Error.Raise("à implémenter : \"" & Value & "\" !")
End Select
Next
Endif
Else
result = "|Void|"
Endif
Return result
End
Essayez d'analyser diverses classes :
- Settings
- application
- Component
- Etc