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] [EINKLAPPEN] Type TPlayer
Field age:Int Field name$
End Type
Wenn wir einen Player in XML speichern wollen, könnte dies so gehen:
Code: [AUSKLAPPEN] [EINKLAPPEN] <TPlayer><age>12</age><name>John</name></TPlayer>
Mein Code kann aber noch mehr. Gegeben sei folgender Typ:
BlitzMax: [AUSKLAPPEN] [EINKLAPPEN] Type TPlayer
Field age:Int Field name$ Field opponent:TPlayer
End Type
Dies könnte man so speichern wollen:
Code: [AUSKLAPPEN] [EINKLAPPEN] <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] [EINKLAPPEN] 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] [EINKLAPPEN] Type TPlayer
Field age:Int Field name$ Field opponent:TPlayer Field imgSrc$, image:TImage Method __sleep$[]() Return ["age", "name", "imgSrc", "opponent"] 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] [EINKLAPPEN] SuperStrict
Type TPlayer
Field age:Int Field name$ Field opponent:TPlayer Field imgSrc$, image:TImage Method __sleep$[]() DebugLog "sleep" Return ["age", "name", "imgSrc", "opponent"] End Method
Method __wakeup() 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")
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
Function XMLEntities$(str$)
str = Replace(str, "&" , "&" ) str = Replace(str, "<" , "<" ) str = Replace(str, ">" , ">" ) str = Replace(str, "~q", """)
Return str
End Function
Function XMLRemoveEntities$(str$)
str = Replace(str, "<" , "<" ) str = Replace(str, ">" , ">" ) str = Replace(str, """, "~q") str = Replace(str, "&" , "&" )
Return str
End Function
Function ConvertObject$(o:Object)
If Not o Then Return "Null"
Local tid:TTypeId = TTypeId.ForObject(o) Local name$ = tid.Name() Local str$ Local fields:TList Local smth:TMethod = tid.FindMethod("__sleep") If smth Then Local result$[] = String[] (smth.Invoke(o, New Object[0])) fields = New TList For Local fname$ = EachIn result 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 fields = tid.EnumFields() EndIf For Local fld:TField = EachIn fields Local fname$ = fld.Name() str :+ "<"+fname+">" Select fld.TypeId() 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))
Default str :+ ConvertObject(fld.Get(o)) End Select str :+ "</"+fname+">" Next Return str End Function
Function ObjectToXML$(o:Object)
Local tid:TTypeId = TTypeId.ForObject(o) Local name$ = tid.Name()
Return "<"+name+">"+ConvertObject(o)+"</"+name+">" End Function
Function ConvertXML:Object(markup$, tid:TTypeId)
If markup.Trim().ToLower() = "null" Then Return Null Local o:Object = tid.NewObject() Repeat markup = markup.Trim() If markup = "" Then Exit If markup[0] <> Asc("<") Then RuntimeError "Error in XML Setup" Local pos:Int = markup.Find(">") If pos = -1 Then RuntimeError "Error in XML Setup" Local name$ = markup[1..pos] If Not name Then RuntimeError "Error in XML Setup" Local fld:TField = tid.FindField(name) If Not fld Then RuntimeError "Referring to unknown field "+name+" of type "+tid.Name() Local open:Int = 1 Local start:Int = pos+1 pos = 0 Repeat pos = markup.Find("<", pos+1) If pos = -1 Or pos = markup.length-1 Then RuntimeError "Error in XML Setup" If markup[pos+1] = Asc("/") Then open :- 1 Else open :+ 1 EndIf Until open = 0 Local slice$ = markup[pos+2..pos+2+name.length] If slice <> name Then RuntimeError "Error in XML Setup" Local innerMarkup$ = markup[start..pos] 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) Default fld.Set o, ConvertXML(innerMarkup, fld.TypeId()) End Select markup = markup[pos+3+name.length..] Forever Local wmth:TMethod = tid.FindMethod("__wakeup") If wmth Then wmth.Invoke(o, New Object[0]) EndIf Return o End Function
Function XMLToObject:Object(xml$)
If Not xml.StartsWith("<") Then RuntimeError "Error in XML Markup" Local pos:Int = xml.Find(">") If pos = -1 Then RuntimeError "Error in XML Markup" Local name$ = xml[1..pos] If Not name Then RuntimeError "Error in XML Setup" Local tid:TTypeId = TTypeId.ForName(name) If Not tid Then RuntimeError "Could not find Type "+name If Not xml.EndsWith("</"+name+">") Then RuntimeError "Error in XML Markup" Local innerMarkup$ = xml[pos+1..xml.length-name.length-3] Return ConvertXML(innerMarkup, tid) End Function
ZEVS
Bitte versucht nicht, Arrays zu speichern.
|