Imports System.Reflection

Namespace Messaging

  Public Interface IObjectSerializationCallback
    Sub SerializationStarted(ByVal serialization As Boolean)
    Sub SerializationFinished(ByVal serialization As Boolean)
  End Interface


  ' The class manages serialization and deserialization to / from byte streams representing
  ' CCU request, response and notification messages. The serialization process
  ' is controlled with the CcuSerializable attribute defined here as well.
  Public Class SerializationManager

#Region " Member variables"

    ' Encoding used for String serialization (see Serialize/DeserializeString).
    Private _Encoding As System.Text.Encoding

    ' Tables of serialization / deserialization delegates for primitive data types.
    ' The key is the primitive type's System.Type; the element is the Serialize/Deserialize
    ' delegate instance.
    Private _Serializers As New Hashtable()
    Private _Deserializers As New Hashtable()

#End Region

#Region " Public interface"

    Public Sub New()
      Me.New(System.Text.Encoding.GetEncoding(1250))
    End Sub


    Public Sub New(ByVal stringEncoding As System.Text.Encoding)
      MyBase.New()
      _Encoding = stringEncoding

      _Serializers.Add(GetType(Byte), New SerializeDelegate(AddressOf Me.SerializeByte))
      _Serializers.Add(GetType(Short), New SerializeDelegate(AddressOf Me.SerializeShort))
      _Serializers.Add(GetType(Integer), New SerializeDelegate(AddressOf Me.SerializeInteger))
      _Serializers.Add(GetType(Boolean), New SerializeDelegate(AddressOf Me.SerializeBoolean))
      _Serializers.Add(GetType(String), New SerializeDelegate(AddressOf Me.SerializeString))

      _Deserializers.Add(GetType(Byte), New DeserializeDelegate(AddressOf Me.DeserializeByte))
      _Deserializers.Add(GetType(Short), New DeserializeDelegate(AddressOf Me.DeserializeShort))
      _Deserializers.Add(GetType(Integer), New DeserializeDelegate(AddressOf Me.DeserializeInteger))
      _Deserializers.Add(GetType(Boolean), New DeserializeDelegate(AddressOf Me.DeserializeBoolean))
      _Deserializers.Add(GetType(String), New DeserializeDelegate(AddressOf Me.DeserializeString))
    End Sub


    Public Function Serialize(ByVal obj As Object, ByVal serializationStream As System.IO.Stream) As Object
      ' obj is validated in SerializeObject.
      If serializationStream Is Nothing Then
        Throw New ArgumentNullException("serializationStream")
      End If

      Dim Writer As New System.IO.BinaryWriter(serializationStream)
      Me.SerializeObject(obj, Writer)
      Return obj
    End Function


    ' We always return obj, which allows us to call it this way:
    ' Dim MyObj As MyObject = DirectCast(SerializationManager.Deserialize(New MyObject, Stream), MyObject)
    Public Function Deserialize(ByVal obj As Object, ByVal serializationStream As System.IO.Stream) As Object
      ' obj is validated in SerializeObject.
      If serializationStream Is Nothing Then
        Throw New ArgumentNullException("serializationStream")
      End If

      Dim Reader As New System.IO.BinaryReader(serializationStream)
      Me.DeserializeObject(obj, Reader)
      Return obj
    End Function


#End Region

#Region " Implementation"

    Private Sub SerializeObject(ByVal obj As Object, ByVal writer As System.IO.BinaryWriter)
      ' Imput validation. writer is validated through ASSERT because its controlled by this class' code,
      Debug.Assert(Not writer Is Nothing)
      If obj Is Nothing Then
        Throw New ArgumentNullException("obj")
      End If

      ' Does the object have the CcuSerializable atribute? 
      CheckTypeIsSerializable(obj.GetType())

      If TypeOf obj Is IObjectSerializationCallback Then
        DirectCast(obj, IObjectSerializationCallback).SerializationStarted(True)
      End If

      ' Get a list of serializable fields a serialize them out to the stream in order of declaration.
      Dim Fields As FieldAttrPairCollection = Me.GetSerializableFields(obj)
      ' We treat it as a failure when an object is marked as serializable and it doesn't have
      ' any serializable fields defined.
      If Fields.Count = 0 Then
        Throw New SerializationException(String.Format("Object {0} is declared CcuSerializable but it declares no CcuSerializable fields.", _
         obj.GetType().FullName))
      End If
      Dim Pair As FieldAttrPair
      For Each Pair In Fields
        Me.SerializeField(obj, Pair.Field, Pair.Attr, writer)
      Next

      If TypeOf obj Is IObjectSerializationCallback Then
        DirectCast(obj, IObjectSerializationCallback).SerializationFinished(True)
      End If
    End Sub


    Private Sub DeserializeObject(ByVal obj As Object, ByVal reader As System.IO.BinaryReader)
      Debug.Assert(Not reader Is Nothing)
      Debug.Assert(Not obj Is Nothing)      ' checked by caller

      CheckTypeIsSerializable(obj.GetType())

      If TypeOf obj Is IObjectSerializationCallback Then
        DirectCast(obj, IObjectSerializationCallback).SerializationStarted(False)
      End If

      ' Get a list of serializable fields and set them to the values read from the serialization stream.
      Dim Fields As FieldAttrPairCollection = Me.GetSerializableFields(obj)
      Dim Pair As FieldAttrPair
      For Each Pair In Fields
        Me.DeserializeField(obj, Pair.Field, Pair.Attr, reader)
      Next

      If TypeOf obj Is IObjectSerializationCallback Then
        DirectCast(obj, IObjectSerializationCallback).SerializationFinished(False)
      End If
    End Sub


    Private Sub DeserializeField(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal reader As System.IO.BinaryReader)
      '  Enum types will be deserializedas its base type. 
      Dim FieldType As System.Type = field.FieldType
      If field.FieldType.IsEnum Then
        FieldType = System.Enum.GetUnderlyingType(field.FieldType)
      End If

      ' Get the deserializer for a primitive type.
      Dim Deserializer As DeserializeDelegate = DirectCast(_Deserializers(FieldType), DeserializeDelegate)
      If Not Deserializer Is Nothing Then
        ' We have primitive type. Deserialize bail out.
        Deserializer.Invoke(obj, field, attr, reader)
        Return
      End If

      Me.CheckFieldIsNotPrimitive(obj, field)

      ' The field can be an IList or a composite (nested) serializable object.
      ' By a convention the field must not be Nothing.
      Dim Value As Object = field.GetValue(obj)
      If Value Is Nothing Then
        Throw New SerializationException(String.Format("The value of field {0} on object {1} must not be Nothing.", field.Name, obj.GetType().FullName))
      End If

      If attr.ListItemType Is Nothing Then
        ' This is a nested type; deserialize it calling itself recursively and quit.
        Me.DeserializeObject(Value, reader)
        Return
      End If

      ' Here we know that the field had better to support IList.
      If Not GetType(IList).IsAssignableFrom(field.FieldType) Then
        Throw New SerializationException(String.Format("The field {0} on object {1} does not support the required IList interface.", field.Name, obj.GetType().FullName))
      End If

      Dim List As IList = DirectCast(Value, IList)

      ' Not sure if this should be here. If the List already contains some members and the client wants
      ' just add the deserialized members to it, the Clear makes it impossible.
      ' BUT, it avoids problems when the client reuses one object instance for deserialization two or more times.
      List.Clear()

      ' By convention, the number of list element that will be deserialized should have been already
      ' deserialized into a field named by attr.ListLengthFieldName,
      Dim LengthField As FieldInfo = obj.GetType().GetField(attr.ListLengthFieldName, BindingFlags.IgnoreCase Or BindingFlags.Instance Or BindingFlags.NonPublic Or BindingFlags.Public)
      If LengthField Is Nothing Then
        Throw New SerializationException(String.Format("The list length field {0} on object {1} does not exist.", attr.ListLengthFieldName, obj.GetType().FullName))
      End If

      ' Items should have a default, parameterless constructor (by convention:-).
      Dim ListItemCtor As ConstructorInfo = attr.ListItemType.GetConstructor(New System.Type() {})
      If ListItemCtor Is Nothing Then
        Throw New SerializationException(String.Format("The list field {0} on object {1} is of type {2}, which has no default Public constructor.", _
         field.Name, obj.GetType().FullName, attr.ListItemType.FullName))
      End If

      ' Get he number of items to be deserialized and do it!
      Dim NumItemsToDeserialize As Integer = CInt(LengthField.GetValue(obj))
      Dim Item As Object, EmptyParams As Object() = New Object() {}
      Do While NumItemsToDeserialize > 0
        Item = ListItemCtor.Invoke(EmptyParams)
        Me.DeserializeObject(Item, reader)
        List.Add(Item)
        NumItemsToDeserialize -= 1
      Loop
    End Sub


    Private Sub SerializeField(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal writer As System.IO.BinaryWriter)
      '  Enums are serialized as their base types. 
      Dim FieldType As System.Type = field.FieldType
      If field.FieldType.IsEnum Then
        FieldType = System.Enum.GetUnderlyingType(field.FieldType)
      End If

      ' Is the field primitive?
      Dim Serializer As SerializeDelegate = DirectCast(_Serializers(FieldType), SerializeDelegate)
      If Not Serializer Is Nothing Then
        ' Serialize the primitive type and quit.
        Serializer.Invoke(obj, field, attr, writer)
        Return
      End If

      ' If the field is still of primitive type, the client applied the CcuSerializable attribute
      ' to an unsupported primitive type.
      Me.CheckFieldIsNotPrimitive(obj, field)

      ' The field is IList or a nested object.
      Dim Value As Object = field.GetValue(obj)
      If attr.ListItemType Is Nothing Then
        ' Deserialize the nested type calling itself recursivelly.
        Me.SerializeObject(Value, writer)
        Return
      End If

      ' This field field should support IList, or else?!
      If Not GetType(IList).IsAssignableFrom(field.FieldType) Then
        Throw New SerializationException(String.Format("The field {0} on object {1} does not support the required IList interface.", field.Name, obj.GetType().FullName))
      End If

      ' Convention: list must not be Nothing.
      Dim List As IList = DirectCast(Value, IList)
      If List Is Nothing Then
        Throw New SerializationException(String.Format("The value of field {0} on object {1} must not be Nothing.", field.Name, obj.GetType().FullName))
      End If

      ' Check for the max. allowed element count as defined in the associated CcuSerializable instance.
      If List.Count > attr.MaxListLength Then
        Throw New SerializationException(String.Format("The field {0} on object {1} contains {2} item(s), but max. {3} is declared.", _
         field.Name, obj.GetType().FullName, List.Count, attr.MaxListLength))
      End If

      ' Everything OK, serialize!
      Dim Item As Object
      For Each Item In List
        If Not Item.GetType() Is attr.ListItemType Then
          Throw New SerializationException(String.Format("The field {0} on object {1} contains item(s), which is not of type {2}.", _
           field.Name, obj.GetType().FullName, attr.ListItemType.FullName))
        End If
        Me.SerializeObject(Item, writer)
      Next
    End Sub



    ' Serialization and deserialization delegates and procedures for the supported primitive types.

    Private Delegate Sub SerializeDelegate(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal writer As System.IO.BinaryWriter)
    Private Delegate Sub DeserializeDelegate(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal reader As System.IO.BinaryReader)

    Private Sub SerializeByte(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal writer As System.IO.BinaryWriter)
      Dim Value As Byte = CByte(field.GetValue(obj))
      writer.Write(Value)
    End Sub
    Private Sub DeserializeByte(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal reader As System.IO.BinaryReader)
      Dim Value As Byte = reader.ReadByte()
      field.SetValue(obj, Value)
    End Sub


    Private Sub SerializeShort(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal writer As System.IO.BinaryWriter)
      Dim Value As Short = CShort(field.GetValue(obj))
      writer.Write(Value)
    End Sub
    Private Sub DeserializeShort(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal reader As System.IO.BinaryReader)
      Dim Value As Short = reader.ReadInt16()
      field.SetValue(obj, Value)
    End Sub


    Private Sub SerializeInteger(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal writer As System.IO.BinaryWriter)
      Dim Value As Integer = CInt(field.GetValue(obj))
      writer.Write(Value)
    End Sub
    Private Sub DeserializeInteger(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal reader As System.IO.BinaryReader)
      Dim Value As Integer = reader.ReadInt32()
      field.SetValue(obj, Value)
    End Sub


    Private Sub SerializeBoolean(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal writer As System.IO.BinaryWriter)
      Dim Value As Boolean = CBool(field.GetValue(obj))
      Dim b As Byte = 0
      If Value Then
        b = 1
      End If
      writer.Write(b)
    End Sub
    Private Sub DeserializeBoolean(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal reader As System.IO.BinaryReader)
      Dim Value As Byte = reader.ReadByte()
      If Value = 0 Then
        field.SetValue(obj, False)
      Else
        field.SetValue(obj, True)
      End If
    End Sub


    Private Sub SerializeString(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal writer As System.IO.BinaryWriter)
      Dim Value As String = CStr(field.GetValue(obj))
      ' We've to always fill attr.MaxStringLength bytes and the terminating byte must be NULL.
      ' If the string is longer, we simply truncate it.
      If Value.Length > (attr.MaxStringLength - 1) Then
        Value = Value.Substring(0, attr.MaxStringLength - 1)
      End If
      Dim Bytes() As Byte = _Encoding.GetBytes(Value)
      debug.Assert( Bytes.Length <= (attr.MaxStringLength - 1))
      ' Write out what we have in the string.
      writer.Write(Bytes, 0, Bytes.Length)
      ' Now as much NULL bytes as needed.
      Dim i As Integer
      For i = 1 To (attr.MaxStringLength - Bytes.Length)
        writer.Write(CByte(0))
      Next
    End Sub
    Private Sub DeserializeString(ByVal obj As Object, ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute, ByVal reader As System.IO.BinaryReader)
      ' Always read up to attr.MaxStringLength or to first NULL byte.
      Dim Bytes() As Byte = reader.ReadBytes(attr.MaxStringLength)
      Dim NullIndex As Integer = Array.IndexOf(Bytes, CByte(0))
      If NullIndex < 0 Then
        NullIndex = Bytes.Length - 1
      End If
      Dim Value As String = _Encoding.GetString(Bytes, 0, NullIndex)
      field.SetValue(obj, Value)
    End Sub


#End Region


#Region " Private helpers"

    Private Function GetSerializableFields(ByVal obj As Object) As FieldAttrPairCollection
      ' BindingFlags.FlattenHierarchy works for static fields only, so we have to enumerate
      ' all the ancestor types. In addition, we have to enumerate from the base type up to the
      ' current type in order to get the serializable fields in the correct order.

      ' Get the object's types from most-specialized to base.
      Dim ObjTypes As New ArrayList()
      Dim ObjType As System.Type = obj.GetType()
      Do While Me.TypeIsSerializable(ObjType)
        ObjTypes.Add(ObjType)
        ObjType = ObjType.BaseType
      Loop

      ' Now enumerate ObjTypes backwards to get the fields in correct order.
      Dim Fields As New FieldAttrPairCollection
      Dim i As Integer
      For i = ObjTypes.Count - 1 To 0 Step -1
        ObjType = DirectCast(ObjTypes(i), System.Type)
        Dim FieldInfos() As FieldInfo = ObjType.GetFields(BindingFlags.Instance Or BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.FlattenHierarchy)
        Dim fi As FieldInfo
        For Each fi In FieldInfos
          Dim FieldAttrs() As Object = fi.GetCustomAttributes(GetType(CcuSerializableAttribute), inherit:=True)
          If FieldAttrs.Length > 0 Then
            Fields.Add(New FieldAttrPair(fi, DirectCast(FieldAttrs(0), CcuSerializableAttribute)))
          End If
        Next
      Next

      Return Fields
    End Function


    Private Class FieldAttrPair
      Public ReadOnly Field As FieldInfo
      Public ReadOnly Attr As CcuSerializableAttribute

      Public Sub New(ByVal field As FieldInfo, ByVal attr As CcuSerializableAttribute)
        Me.Field = field
        Me.Attr = attr
      End Sub
    End Class


    Private Class FieldAttrPairCollection
      Inherits CollectionBase

      Default Public ReadOnly Property Item(ByVal index As Integer) As FieldAttrPair
        Get
          Return DirectCast(Me.List.Item(index), FieldAttrPair)
        End Get
      End Property


      Public Function Add(ByVal p As FieldAttrPair) As Integer
        Return Me.List.Add(p)
      End Function
    End Class


    Private Sub CheckTypeIsSerializable(ByVal type As System.Type)
      If Not Me.TypeIsSerializable(type) Then
        Throw New SerializationException(String.Format("Class {0} does not have the CcuSerializable attribute.", type.FullName))
      End If
    End Sub


    Private Function TypeIsSerializable(ByVal type As System.Type) As Boolean
      Dim ObjectAttrs() As Object = type.GetCustomAttributes(GetType(CcuSerializableAttribute), inherit:=True)
      Return ObjectAttrs.Length > 0
    End Function


    Private Sub CheckFieldIsNotPrimitive(ByVal obj As Object, ByVal field As FieldInfo)
      If field.FieldType.IsPrimitive Then
        Throw New SerializationException(String.Format("The type of field {0} on object {1} is not supported ({2}).", _
         field.Name, obj.GetType().FullName, field.FieldType.FullName))
      End If
    End Sub

#End Region
  End Class


  ' In order for a class to be serializable, it must be taggedwith this attribute, as well
  ' as all the serializable class' fields.
  <AttributeUsage(AttributeTargets.Class Or AttributeTargets.Field Or AttributeTargets.Struct, Inherited:=True, AllowMultiple:=False)> _
  Public Class CcuSerializableAttribute
    Inherits Attribute

    ' If _ListItemType is not Nothing, the tagged field implements IList. Serialization walks the list
    ' and serializes the elements. Deserialization clears the list, determines the number of elements
    ' defined by the value of the field named by _ListLengthFieldName.
    Private _ListItemType As System.Type
    Private _ListLengthFieldName As String = String.Empty
    Private _MaxListLength As Integer

    ' Default constructor for tagging primitive types.
    Public Sub New()
      Me.New(Nothing, Nothing, 0)
    End Sub


    ' This constructor should be used to tag String fields.
    Public Sub New(ByVal maxStringLength As Integer)
      Me.New(Nothing, Nothing, maxStringLength)
    End Sub


    ' This constructor is used for IList fields.
    Public Sub New(ByVal listItemType As System.Type, ByVal listLengthField As String, ByVal maxListLength As Integer)
      MyBase.New()
      _ListItemType = listItemType
      _ListLengthFieldName = listLengthField
      _MaxListLength = maxListLength

      If ((listItemType Is Nothing) AndAlso (Not listLengthField Is Nothing)) OrElse _
       ((Not listItemType Is Nothing) AndAlso (listLengthField Is Nothing)) Then
        Throw New ArgumentException("List item type and length field must be both specified.")
      End If
      If maxListLength < 0 Then
        Throw New ArgumentOutOfRangeException("maxListLength")
      End If
    End Sub


    Friend ReadOnly Property ListItemType() As System.Type
      Get
        Return _ListItemType
      End Get
    End Property


    Friend ReadOnly Property ListLengthFieldName() As String
      Get
        Return _ListLengthFieldName
      End Get
    End Property


    Friend ReadOnly Property MaxListLength() As Integer
      Get
        Return _MaxListLength
      End Get
    End Property


    Friend ReadOnly Property MaxStringLength() As Integer
      Get
        Return _MaxListLength
      End Get
    End Property

  End Class

End Namespace