Objekte durch Reflection in XML speichern

Übersicht BlitzMax, BlitzMax NG Codearchiv & Module

Neue Antwort erstellen

ZEVS

Betreff: Objekte durch Reflection in XML speichern

 BeitragMi, Dez 26, 2012 14:07
Antworten mit Zitat
Benutzer-Profile anzeigen
Manchem ist es sicherlich schonmal vorgekommen, dass er seine Objekte nicht immer hässlich hardgecodet erzeugen will. Andererseits sind Speicher- und Laderoutinen nicht immer einfach zu schreiben und vor allem aufwändig. Ich habe deshalb einen kleinen Code geschrieben, der das Problem allgemein löst.
Gegeben ist irgendein Objekt, z.B.
BlitzMax: [AUSKLAPPEN] 
Type TPlayer

	Field age:Int
	Field name$

End Type

Wenn wir einen Player in XML speichern wollen, könnte dies so gehen:
Code: [AUSKLAPPEN]
<TPlayer><age>12</age><name>John</name></TPlayer>

Mein Code kann aber noch mehr. Gegeben sei folgender Typ:
BlitzMax: [AUSKLAPPEN] 
Type TPlayer

	Field age:Int
	Field name$
	Field opponent:TPlayer

End Type

Dies könnte man so speichern wollen:
Code: [AUSKLAPPEN]
<TPlayer><age>12</age><name>John</name><opponent>
   <age>20</age><name>Billy</name>
</opponent></TPlayer>

Oft genug hat man aber sogar folgendes:
BlitzMax: [AUSKLAPPEN] 
Type TPlayer

	Field age:Int
	Field name$
	Field opponent:TPlayer
	Field imgSrc$, image:TImage

End Type

Ich hoffe, ihr wollt das image nicht Byte für Byte in XML speichern. Stattdessen wollt ihr die imgSrc dort speichern und das Bild dann daraus laden. Alles kein Problem:
BlitzMax: [AUSKLAPPEN] 
Type TPlayer

	Field age:Int
	Field name$
	Field opponent:TPlayer
	Field imgSrc$, image:TImage
	
	Method __sleep$[]()
	
				'die Felder, die wir speichern wollen
		Return ["age", "name", "imgSrc", "opponent"] ' Das Feld image speichern wir nicht im XML
		
	End Method

	Method __wakeup()	

		Self.image = LoadImage(Self.imgSrc)
		
	End Method
	
End Type

(siehe http://php.net/manual/en/langu...ect.wakeup)
Ich will euch nicht weiter auf die Folter spannen:
BlitzMax: [AUSKLAPPEN] 
SuperStrict

Type TPlayer		'ein Beispiel-Type, den wir in XML umwandeln wollen

	Field age:Int
	Field name$
	Field opponent:TPlayer
	Field imgSrc$, image:TImage
	
	Method __sleep$[]()		' diese Methode wird aufgerufen, wenn wir das Objekt nach XML umwandeln
			' sie gibt diejenigen Felder zurück, die in XML gespeichert werden sollen
	
		DebugLog "sleep"
		Return ["age", "name", "imgSrc", "opponent"] ' Das Feld image speichern wir nicht im XML
		
	End Method

	Method __wakeup()		' diese Methode wird aufgerufen, wenn wir das Objekt aus XML wiederhergestellt haben
	' hier können wir z.B. diejenigen Felder wieder befüllen, die wir in __sleep ausgeschlossen haben.
	
		DebugLog "wakeup"
		Self.image = LoadImage(Self.imgSrc)
		
	End Method
	
End Type

Local player:TPlayer = New TPlayer
Local opponent:TPlayer = New TPlayer
player.age = 12
player.name = "John"
player.imgSrc = "john.png"
player.image = LoadImage("john.png")	' Zum Testen muss dieses Bild nicht unbedingt existieren

opponent.age = 20
opponent.name = "Billy"
opponent.imgSrc = "evil.png"
opponent.image = LoadImage("evil.png")
player.opponent = opponent

Local xml$ = ObjectToXML(player)
Print xml
Local cp:TPlayer = TPlayer(XMLToObject(xml))
DebugStop		'im Debugger das Objekt cp bestaunen


Function XMLEntities$(str$)		'ersetzt die Zeichen mit besonderer Bedeutung in XML durch deren Entities
			'wir wollen schließlich korrektes XML erzeugen

  str = Replace(str, "&" , "&amp;" )
  str = Replace(str, "<" , "&lt;"  )
  str = Replace(str, ">" , "&gt;"  )
  str = Replace(str, "~q", "&quot;")

  Return str

End Function

Function XMLRemoveEntities$(str$)	'die Umkehrfunktion zu XMLEntities

  str = Replace(str, "&lt;"  , "<" )
  str = Replace(str, "&gt;"  , ">" )
  str = Replace(str, "&quot;", "~q")
  str = Replace(str, "&amp;" , "&" )

  Return str

End Function

Function ConvertObject$(o:Object)	'wandelt ein Objekt in XML um
				' (der Benutzer sollte aber lieber ObjectToXML aufrufen)
				' Ein TExampleType mit integer = 100, str = "bla" und samp = Null wird zu
				' <integer>100</integer><samp>Null</samp>
				' integer und samp sind hierbei die Feldnamen (nicht die Typen).
				' str wird nicht gespeichert, da wir dies in __sleep verboten haben (s.o.)

	If Not o Then Return "Null"	'Null-Objekt

	Local tid:TTypeId = TTypeId.ForObject(o)	'Die Type-Id, aus der wir alle Informationen rausholen
	Local name$ = tid.Name()			'Deren Name
	
	Local str$	'Der Ergebnis-String
	
	Local fields:TList	'Die Liste aller Felder, die wir speichern
	
	Local smth:TMethod = tid.FindMethod("__sleep")	'Suche die __sleep-Methode heraus
	If smth Then			'Wenn es eine solche gibt ...
	
		Local result$[] = String[] (smth.Invoke(o, New Object[0]))	'... rufe sie auf ...
		fields = New TList
		For Local fname$ = EachIn result '... und merke die die angegebenen Felder
		
			Local fld:TField = tid.FindField(fname)
			If Not fld Then RuntimeError "__sleep returned field "+fname+", which could not be found in "+name
			fields.AddLast fld
			
		Next
		
	Else	'Wenn es keine __sleep-Methode gibt, speichere einfach alle Felder
	
		fields = tid.EnumFields()
		
	EndIf
	
	For Local fld:TField = EachIn fields	'Nun gehen wir durch alle Felder durch
	
		Local fname$ = fld.Name()
		str :+ "<"+fname+">"	'Anfangs-Tag
	
		Select fld.TypeId()	'Welchen Typ hat das Feld? Entsprechende "Übersetzung" hinten anhängen
		
			Case ByteTypeId, ShortTypeId, IntTypeId
			
				str :+ fld.GetInt(o)
				
			Case LongTypeId
			
				str :+ fld.GetLong(o)

			Case FloatTypeId
			
				str :+ fld.GetFloat(o)
				
			Case DoubleTypeId
			
				str :+ fld.GetDouble(o)
				
			Case StringTypeId
			
				str :+ XMLEntities(fld.GetString(o))	'Auf XML-Entities aufpassen

			Default
			
				str :+ ConvertObject(fld.Get(o))	'Rekursion!
				
		End Select
		str :+ "</"+fname+">"	'abschließendes Tag anfügen
		
	Next
	
		'alle Felder angehängt
	
	Return str
	
End Function

Function ObjectToXML$(o:Object)
				' die Funktion für den öffentlichen Aufruf
				' Ein TExampleType mit integer = 100, str = "bla" und samp = Null wird zu
				' <TExampleType><integer>100</integer><samp>Null</samp></TExampleType>
				' Der innere Teil wird durch ConvertObject erzeugt.

	Local tid:TTypeId = TTypeId.ForObject(o)
	Local name$ = tid.Name()

	Return "<"+name+">"+ConvertObject(o)+"</"+name+">"
	
End Function

Function ConvertXML:Object(markup$, tid:TTypeId)	'Die Umkehrfunktion zu ConvertObject
		' gegeben ist ein XML-Markup sowie eine Type-Id des kodierten Objektes
		' Gegeben ist z.B. markup = "<integer>100</integer><samp>Null</samp>" und tid = TExampleType
		' Daraus baut diese Methode ein Objekt vom Typ TExampleType, füllt dessen Felder integer und samp
		' und ruft zum Abschluss die __wakeup-Methode (falls vorhanden) auf

	If markup.Trim().ToLower() = "null" Then Return Null	'Null-Objekt
	
	Local o:Object = tid.NewObject()	'erstmal eine neue Instanz erzeugen
	Repeat
	
		markup = markup.Trim()
		If markup = "" Then Exit	'Markup leer? D.h. wir sind fertig
		If markup[0] <> Asc("<") Then RuntimeError "Error in XML Setup"	'Erstes Zeichen muss '<' sein
		Local pos:Int = markup.Find(">")		' Ende des ersten Tags
		If pos = -1 Then RuntimeError "Error in XML Setup"	'Ein '<' ohne '>'? Das ist kein XML!
		Local name$ = markup[1..pos]		'Der Name des Felder (z.B. "integer")
		If Not name Then RuntimeError "Error in XML Setup"	' "<>" ist ungültiges XML
		Local fld:TField = tid.FindField(name)	'Das Feld heraussuchen
			' Das Feld sollte zudem auch existieren
		If Not fld Then RuntimeError "Referring to unknown field "+name+" of type "+tid.Name()
		
Rem

Gut, wir wissen, dass das Feld hier anfängt. Aber wo endet es? Wir können leider nicht einfach nach </name> suchen,
da die Typen ja rekursiv aufgebaut sein können
(z.B. <TExampleType> ... <samp><integer>12</integer><samp>Null</samp></samp></TExampleType>).
Deshalb zählen wir einfach, wie viele Elemente wir offen haben. Beginnt ein Tag mit </, so ist es ein schließendes,
sonst ein öffnendes. Wenn wir 0 geöffnete haben, so muss dies das Ende vom Feld sein.

End Rem
		
		Local open:Int = 1
		Local start:Int = pos+1	'Merken, wo das Feld anfing
		pos = 0
		Repeat
		
			pos = markup.Find("<", pos+1)	'Nächstes Tag (sollte vorhanden sein und '<' sollte nicht ganz am Ende sein).
			If pos = -1 Or pos = markup.length-1 Then RuntimeError "Error in XML Setup"
			If markup[pos+1] = Asc("/") Then	'schließend
			
				open :- 1
				
			Else		'öffnend
			
				open :+ 1
				
			EndIf
			
		Until open = 0
		
		'wir haben nun in pos die Stelle des schließenden Tags
		
		Local slice$ = markup[pos+2..pos+2+name.length]	'Es sollte ein schließendes Tag für unser Feld sein
			'(also nicht <integer>42</samp>)
			'                                        ^^^^- dieses schneiden wir heraus
		If slice <> name Then RuntimeError "Error in XML Setup"
		Local innerMarkup$ = markup[start..pos]	'Das, was dazwischen steht
			'Versuche nun, innerMarkup je nach Typ des Feldes in dieses hineinzuschreiben
		Select fld.TypeId()
		
			Case ByteTypeId, ShortTypeId, IntTypeId
			
				fld.SetInt o, Int(innerMarkup)
				
			Case LongTypeId
			
				fld.SetLong o, Long(innerMarkup)
				
			Case FloatTypeId
			
				fld.SetFloat o, Float(innerMarkup)
				
			Case DoubleTypeId
			
				fld.SetFloat o, Double(innerMarkup)
				
			Case StringTypeId
			
				fld.SetString o, XMLRemoveEntities(innerMarkup)	'Achtung! Entities!
				
			Default
			
				fld.Set o, ConvertXML(innerMarkup, fld.TypeId())	'Wieder Rekursion!
				
		End Select
		markup = markup[pos+3+name.length..]	'All das, was wir nun verarbeitet haben, abschneiden
			'd.h. aus <integer>42</integer><samp>Null</samp> wird nun <samp>Null</samp>
	
	Forever
		
		'Fertig: Alle Felder abgearbeitet
	
	Local wmth:TMethod = tid.FindMethod("__wakeup")	'__wakeup heraussuchen und ggf. aufrufen
	If wmth Then
	
		wmth.Invoke(o, New Object[0])
		
	EndIf
	Return o
	
End Function

Function XMLToObject:Object(xml$)
				' die Funktion für den öffentlichen Aufruf
				' gegeben ist ein XML-Markup z.B.
				' <TExampleType><integer>100</integer><samp>Null</samp></TExampleType>
				' Diese Methode findet heraus, dass ein TExampleType kodiert wurde und dekodiert ihn.
				' Damit ist sie das Gegenstück zu ObjectToXML



	If Not xml.StartsWith("<") Then RuntimeError "Error in XML Markup"	'Das Markup sollte mit '<' beginnen
	Local pos:Int = xml.Find(">")					'Finde das Ende des ersten Tags
	If pos = -1 Then RuntimeError "Error in XML Markup"		'dieses sollte existieren
	Local name$ = xml[1..pos]
	If Not name Then RuntimeError "Error in XML Setup"	'und einen vernünftigen, ...
	Local tid:TTypeId = TTypeId.ForName(name)
	If Not tid Then RuntimeError "Could not find Type "+name	'... existierenden Namen haben
	If Not xml.EndsWith("</"+name+">") Then RuntimeError "Error in XML Markup"
			'und das Markup sollte korrekt enden
	Local innerMarkup$ = xml[pos+1..xml.length-name.length-3]		'wir extrahieren alles dazwischen
	Return ConvertXML(innerMarkup, tid)	'und konvertieren es
	
End Function



ZEVS
Bitte versucht nicht, Arrays zu speichern.

Neue Antwort erstellen


Übersicht BlitzMax, BlitzMax NG Codearchiv & Module

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group