Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
156 lines (121 sloc) 6.15 KB
Imports System.Reflection
Imports System.Reflection.Emit
Imports System.Text
Imports System.Text.RegularExpressions
Namespace com.bodurov
Public NotInheritable Class DataSourceCreator
Private Sub New()
End Sub
Private Shared ReadOnly PropertNameRegex As New Regex("^[A-Za-z]+[A-Za-z0-9_]*$", RegexOptions.Singleline)
Private Shared ReadOnly _typeBySigniture As New Dictionary(Of String, Type)()
Public Shared Function ToDataSource(list As IEnumerable(Of IDictionary)) As IEnumerable
Dim firstDict As IDictionary = Nothing
Dim hasData As Boolean = False
For Each currentDict As IDictionary In list
hasData = True
firstDict = currentDict
Exit For
Next
If Not hasData Then
Return New Object() {}
End If
If firstDict Is Nothing Then
Throw New ArgumentException("IDictionary entry cannot be null")
End If
Dim typeSignature As String = GetTypeSignature(firstDict, list)
Dim objectType As Type = GetTypeByTypeSignature(typeSignature)
If objectType Is Nothing Then
Dim tb As TypeBuilder = GetTypeBuilder(typeSignature)
Dim constructor As ConstructorBuilder = tb.DefineDefaultConstructor(MethodAttributes.[Public] Or MethodAttributes.SpecialName Or MethodAttributes.RTSpecialName)
For Each pair As DictionaryEntry In firstDict
If PropertNameRegex.IsMatch(Convert.ToString(pair.Key), 0) Then
If pair.Value Is Nothing Then
CreateProperty(tb, Convert.ToString(pair.Key), GetValueType(pair.Value, list, pair.Key))
End If
Else
Throw New ArgumentException("Each key of IDictionary must be " & vbCr & vbLf & " alphanumeric and start with character.")
End If
Next
objectType = tb.CreateType()
_typeBySigniture.Add(typeSignature, objectType)
End If
Return GenerateEnumerable(objectType, list, firstDict)
End Function
Private Shared Function GetTypeByTypeSignature(typeSigniture As String) As Type
Dim type As Type
Return If(_typeBySigniture.TryGetValue(typeSigniture, type), type, Nothing)
End Function
Private Shared Function GetValueType(value As Object, list As IEnumerable(Of IDictionary), key As Object) As Type
If value Is Nothing Then
For Each dictionary As IDictionary In list
If dictionary.Contains(key) Then
value = dictionary(key)
If value IsNot Nothing Then
Exit For
End If
End If
Next
End If
Return If((value Is Nothing), GetType(Object), value.[GetType]())
End Function
Private Shared Function GetTypeSignature(firstDict As IDictionary, list As IEnumerable(Of IDictionary)) As String
Dim sb = New StringBuilder()
For Each pair As DictionaryEntry In firstDict
sb.AppendFormat("_{0}_{1}", pair.Key, GetValueType(pair.Value, list, pair.Key))
Next
Return sb.ToString().GetHashCode().ToString().Replace("-", "Minus")
End Function
Private Shared Function GenerateEnumerable(ByVal objectType As Type, ByVal list As IEnumerable(Of IDictionary), ByVal firstDict As IDictionary) As IEnumerable
Dim listType As Type = GetType(List(Of )).MakeGenericType(New Type() {objectType})
Dim listOfCustom As IList = Activator.CreateInstance(listType)
For Each currentDict As IDictionary In list
If currentDict Is Nothing Then
Throw New ArgumentException("IDictionary entry cannot be null")
End If
Dim row = Activator.CreateInstance(objectType)
For Each pair As DictionaryEntry In firstDict
If currentDict.Contains(pair.Key) Then
Dim [property] As PropertyInfo = objectType.GetProperty(Convert.ToString(pair.Key))
Dim value = currentDict(pair.Key)
If value IsNot Nothing AndAlso value.[GetType]() <> [property].PropertyType AndAlso Not [property].PropertyType.IsGenericType Then
Try
value = Convert.ChangeType(currentDict(pair.Key), [property].PropertyType, Nothing)
Catch
End Try
End If
[property].SetValue(row, value, Nothing)
End If
Next
listType.GetMethod("Add").Invoke(listOfCustom, New Object() {row})
Next
Return TryCast(listOfCustom, IEnumerable)
End Function
Private Shared Function GetTypeBuilder(typeSigniture As String) As TypeBuilder
Dim an As New AssemblyName(Convert.ToString("TempAssembly") & typeSigniture)
Dim assemblyBuilder As AssemblyBuilder = AppDomain.CurrentDomain.DefineDynamicAssembly(an, AssemblyBuilderAccess.Run)
Dim moduleBuilder As ModuleBuilder = assemblyBuilder.DefineDynamicModule("MainModule")
Dim tb As TypeBuilder = moduleBuilder.DefineType(Convert.ToString("TempType") & typeSigniture, TypeAttributes.[Public] Or TypeAttributes.[Class] Or TypeAttributes.AutoClass Or TypeAttributes.AnsiClass Or TypeAttributes.BeforeFieldInit Or TypeAttributes.AutoLayout, GetType(Object))
Return tb
End Function
Private Shared Sub CreateProperty(tb As TypeBuilder, propertyName As String, propertyType As Type)
If propertyType.IsValueType AndAlso Not propertyType.IsGenericType Then
propertyType = GetType(Nullable(Of )).MakeGenericType(propertyType)
End If
Dim fieldBuilder As FieldBuilder = tb.DefineField(Convert.ToString("_") & propertyName, propertyType, FieldAttributes.[Private])
Dim propertyBuilder As PropertyBuilder = tb.DefineProperty(propertyName, PropertyAttributes.HasDefault, propertyType, Nothing)
Dim getPropMthdBldr As MethodBuilder = tb.DefineMethod(Convert.ToString("get_") & propertyName, MethodAttributes.[Public] Or MethodAttributes.SpecialName Or MethodAttributes.HideBySig, propertyType, Type.EmptyTypes)
Dim getIL As ILGenerator = getPropMthdBldr.GetILGenerator()
getIL.Emit(OpCodes.Ldarg_0)
getIL.Emit(OpCodes.Ldfld, fieldBuilder)
getIL.Emit(OpCodes.Ret)
Dim setPropMthdBldr As MethodBuilder = tb.DefineMethod(Convert.ToString("set_") & propertyName, MethodAttributes.[Public] Or MethodAttributes.SpecialName Or MethodAttributes.HideBySig, Nothing, New Type() {propertyType})
Dim setIL As ILGenerator = setPropMthdBldr.GetILGenerator()
setIL.Emit(OpCodes.Ldarg_0)
setIL.Emit(OpCodes.Ldarg_1)
setIL.Emit(OpCodes.Stfld, fieldBuilder)
setIL.Emit(OpCodes.Ret)
propertyBuilder.SetGetMethod(getPropMthdBldr)
propertyBuilder.SetSetMethod(setPropMthdBldr)
End Sub
End Class
End Namespace