Namespace System
Namespace Xml
Namespace Serialization


Class XmlSerializer
	m_typeInfo As System.TypeInfo


	'----------------------------------------------------------------
	' シリアライズ ロジック
	'----------------------------------------------------------------

	Static Sub SerializeForBasicType( typeInfo As TypeInfo, memoryOffset As LONG_PTR, o As Object, doc As XmlDocument, parentNode As XmlNode )
		Dim valueStr = Nothing As String
		If typeInfo.FullName = "Byte" Then
			valueStr = Str$( GetByte( ObjPtr( o ) + memoryOffset ) As Byte )
		ElseIf typeInfo.FullName = "SByte" Then
			valueStr = Str$( GetByte( ObjPtr( o ) + memoryOffset ) As SByte )
		ElseIf typeInfo.FullName = "Word" Then
			valueStr = Str$( GetWord( ObjPtr( o ) + memoryOffset ) As Word )
		ElseIf typeInfo.FullName = "Integer" Then
			valueStr = Str$( GetWord( ObjPtr( o ) + memoryOffset ) As Integer )
		ElseIf typeInfo.FullName = "DWord" Then
			valueStr = Str$( GetDWord( ObjPtr( o ) + memoryOffset ) As DWord )
		ElseIf typeInfo.FullName = "Long" Then
			valueStr = Str$( GetDWord( ObjPtr( o ) + memoryOffset ) As Long )
		ElseIf typeInfo.FullName = "QWord" Then
			valueStr = Str$( GetQWord( ObjPtr( o ) + memoryOffset ) As QWord )
		ElseIf typeInfo.FullName = "Int64" Then
			valueStr = Str$( GetQWord( ObjPtr( o ) + memoryOffset ) As Int64 )
		ElseIf typeInfo.FullName = "Boolean" Then
			If GetByte( ObjPtr( o ) + memoryOffset ) As Boolean Then
				valueStr = "True"
			Else
				valueStr = "False"
			End If
		ElseIf typeInfo.FullName = "Single" Then
			valueStr = Str$( GetSingle( ObjPtr( o ) + memoryOffset ) As Single )
		ElseIf typeInfo.FullName = "Double" Then
			valueStr = Str$( GetDouble( ObjPtr( o ) + memoryOffset ) As Double )
		ElseIf typeInfo.FullName = "VoidPtr" Then
			valueStr = Str$( Get_LONG_PTR( ObjPtr( o ) + memoryOffset ) )
		Else
			Throw
		End If

		Dim childNode = doc.CreateElement( typeInfo.FullName )
		parentNode.AppendChild( childNode )
		childNode.AppendChild( doc.CreateTextNode( valueStr ) )
	End Sub

	Static Sub SerializeForClass( typeInfo As TypeInfo, o As Object, doc As XmlDocument, parentNode = Nothing As XmlNode )
		If typeInfo.IsClass() and typeInfo.FullName = "System.Object" Then
			' Object型はシリアライズしない
			Return
		End If

		If ActiveBasic.IsNothing( parentNode ) Then
			parentNode = doc
		End If

		Dim memberInfos = typeInfo.GetMembers()

		' 子ノードを生成
		Dim childNode = doc.CreateElement( typeInfo.Name )
		Dim namespaceAttr = doc.CreateAttribute( "namespace" )
		namespaceAttr.Value = typeInfo.Namespace
		childNode.Attributes.Add( namespaceAttr )

		' 親ノードへ追加
		parentNode.AppendChild( childNode )

		If Not ActiveBasic.IsNothing( typeInfo.BaseType ) Then
			' 基底クラスが存在するとき

			' 基底クラスをシリアライズ
			SerializeForClass( typeInfo.BaseType, o, doc, childNode )
		End If

		' メンバをシリアライズ
		Foreach memberInfo In memberInfos
			If memberInfo.MemberType.IsPointer() Then
				Throw
			ElseIf memberInfo.MemberType.IsClass() Then
				SerializeForClass( memberInfo.MemberType, o, doc, childNode )
			ElseIf memberInfo.MemberType.IsValueType() Then
				SerializeForBasicType( memberInfo.MemberType, memberInfo._System_Offset, o, doc, childNode )
			End If
		Next
	End Sub


	'----------------------------------------------------------------
	' デシリアライズ ロジック
	'----------------------------------------------------------------

	Static Sub DeserializeForBasicType( typeInfo As TypeInfo, memoryOffset As LONG_PTR, object As Object, xmlNode As XmlNode )
		If Not xmlNode.ChildNodes.Count = 1 Then
			Throw
		End If

		Dim valueStr = xmlNode.ChildNodes[0].Value
		Dim memberPtr = ObjPtr( object ) + memoryOffset

		If typeInfo.FullName = "Byte" Then
			SetByte( memberPtr, Val( valueStr ) )
		ElseIf typeInfo.FullName = "SByte" Then
			SetByte( memberPtr, Val( valueStr ) )
		ElseIf typeInfo.FullName = "Word" Then
			SetWord( memberPtr, Val( valueStr ) )
		ElseIf typeInfo.FullName = "Integer" Then
			SetWord( memberPtr, Val( valueStr ) )
		ElseIf typeInfo.FullName = "DWord" Then
			SetDWord( memberPtr, Val( valueStr ) )
		ElseIf typeInfo.FullName = "Long" Then
			SetDWord( memberPtr, Val( valueStr ) )
		ElseIf typeInfo.FullName = "QWord" Then
			SetQWord( memberPtr, Val( valueStr ) )
		ElseIf typeInfo.FullName = "Int64" Then
			SetQWord( memberPtr, Val( valueStr ) )
		ElseIf typeInfo.FullName = "Boolean" Then
			If valueStr = "True" Then
				SetByte( memberPtr, 1 )
			ElseIf valueStr = "False" Then
				SetByte( memberPtr, 0 )
			Else
				Throw
			End If
		ElseIf typeInfo.FullName = "Single" Then
			SetSingle( memberPtr, Val( valueStr ) )
		ElseIf typeInfo.FullName = "Double" Then
			SetDouble( memberPtr, Val( valueStr ) )
		ElseIf typeInfo.FullName = "VoidPtr" Then
			Set_LONG_PTR( memberPtr, Val( valueStr ) As LONG_PTR )
		Else
			Throw
		End If
	End Sub

	Function DeserializeForClass( typeInfo As TypeInfo, xmlNode As XmlNode ) As Object
		If typeInfo.IsClass() and typeInfo.FullName = "System.Object" Then
			' Object型にたどり着いた場合

			' 派生クラスのフルネームを元に特定されたクラスを生成し、デフォルトコンストラクタを呼ぶ
			Return ActiveBasic.Core._System_TypeForClass._System_New( m_typeInfo As ActiveBasic.Core._System_TypeForClass )
		End If

		If typeInfo.Name <> xmlNode.LocalName Then
			Throw
		End If

		Dim object = Nothing As Object
		Dim memberInfos = typeInfo.GetMembers()

		If Not ActiveBasic.IsNothing( typeInfo.BaseType ) Then
			' 基底クラスが存在するとき

			' 基底クラスをシリアライズ
			object = DeserializeForClass( typeInfo.BaseType, xmlNode )
		End If

		' メンバをシリアライズ
		Dim childNode = xmlNode.ChildNodes[0] As XmlNode
		Foreach memberInfo In memberInfos
			If ActiveBasic.IsNothing( childNode ) Then
				Throw
			End If

			If memberInfo.MemberType.IsPointer() Then
				Throw
			ElseIf memberInfo.MemberType.IsClass() Then
				Dim memberObject = DeserializeForClass( memberInfo.MemberType, childNode )
				Set_LONG_PTR( ObjPtr( object ) + memberInfo._System_Offset, ObjPtr( memberObject ) As LONG_PTR )
			ElseIf memberInfo.MemberType.IsValueType() Then
				DeserializeForBasicType( memberInfo.MemberType, memberInfo._System_Offset, object, childNode )
			End If

			childNode = childNode.NextSibling
		Next

		If Not ActiveBasic.IsNothing( childNode ) Then
			Throw
		End If

		Return object
	End Function

Public
	Sub XmlSerializer( typeInfo As System.TypeInfo )
		This.m_typeInfo = typeInfo
	End Sub
	Sub ~XmlSerializer()
	End Sub


	/*!
	@brief	XML文書をオブジェクトに逆シリアライズします。
	@author	Daisuke Yamamoto
	*/
	Function Deserialize( stream As System.IO.Stream ) As Object
		Dim doc = New XmlDocument
		doc.Load( stream )
		Return DeserializeForClass( m_typeInfo, doc.ChildNodes[1] )
	End Function

	/*!
	@brief	オブジェクトをXML文書にシリアライズします。
	@author	Daisuke Yamamoto
	*/
	Sub Serialize( stream As System.IO.Stream, o As Object )
		Dim doc = New XmlDocument
		doc.AppendChild( doc.CreateXmlDeclaration( "1.0", "shift-jis", Nothing ) )

		SerializeForClass( m_typeInfo, o, doc )

		' ストリームに保存
		doc.Save( stream )
	End Sub
End Class


End Namespace
End Namespace
End Namespace