aulix.com/nhgen

' ========== THE AULIX nHibernate Generator (NHGen) - MyGeneration Extender for Aulix.Common7 framework ==========
'The AUTHOR of this file is Alexander Borisovich Prokopyev, Kurgan, Russia
'More info can be found at the AUTHOR's website:
'   http://aulix.com/nhgen
'   http://aulix.com/resume
'Contact: alexander.prokopyev at aulix dot com
'Copyright (c) Alexander Prokopyev, 2008
'All materials contained in this file are protected by copyright law.
'Nobody except the AUTHOR may alter or remove this copyright notice from copies of the content.
'This is a proprietary software
'The AUTHOR explicitly prohibits to use this source code by any method without a prior
'written hand-signed permission of the AUTHOR.
' ===========================================================
' This is a library to be used from http://www.mygenerationsoftware.com tool
' This extender generates a domain specific extension over generic Aulix.Common7.BL classes
' ===== An example of ZEUS template for aulix.com/adbm =====
'<%#REFERENCE Aulix.NHGeneratorLib.dll%><%
'Public Class GeneratedTemplate
'    Inherits DotNetScriptTemplate
'    Public Sub New(ByVal context As ZeusContext)
'        MyBase.New(context)
'    End Sub
'    '---------------------------------------------------
'    ' Render() is where you want to write your logic
'    '---------------------------------------------------
'    Public Overrides Sub Render()
'        MyMeta.Connect("SQL", "Provider=sqloledb;Data Source=server_host,1433;Initial Catalog=DatabaseManager;User Id=sa;Password=xxx;")
'        Dim CommandLine As String = _
'         " -OutputDir1 Z:\Projects\Aulix\DatabaseManager\Src\NH\ -OutputName1 DatabaseManagerObjects " & _
'         " -Namespace1 Aulix.DatabaseManager -Level1Class1 $1:^(.*)$:aulix_.* "
'        Dim ML As New Aulix.NHGeneratorLib.MainClass
'        ML.Process(MyMeta, CommandLine)
'    End Sub
'End Class
'%>



Imports Aulix.Common7.Utils

'Level of inheritance may be in the range of 0..9
'The program is capable to produce several levels of inheritance provided the arguments for each level are numbered:
'/OutputDirX= the directory where resulting files are placed
'/NamespaceX=
'where X is a level number
'   Class to table mapping is defined by: -LevelXClassY [ClassName]:TableName[(FieldRange)][:ExceptTableName]
'TableName and ExceptTableName can be specified by a regex with only single match possible
'"*" can be used in the ClassName and then the actual matching value from TableName is substitued to the generated name of class.
'But mask use is allowed only for the classes without inheritance. All inherited classes require to be
'explicitelly defined by corresponding separated -LevelXClassY construct.
'FieldRange can be specified in two formats:
'   as an actual range like: Field1..FieldN
'   or as an enumeration like: Field1, Field2, Field3, FieldN
'Example:
' 1) Following is a TestClass2 which inherits TestClass1 and both of them share the same table TestTable1
'       -Level1Class1 [TestClass1]:TestTable1(Id..SomeField1)
'       -Level2Class1 [TestClass2]:TestTable1(SomeField2..SomeField3)
' 2) Following is a group of Aulix classes those do not participate in inheritance (all except aulix_User table):
'       -Level1Class2 Aulix*:aulix_*:aulix_User
'in the above example generated classes will look like: AulixConfiguration, AulixProperty, etc.
'The program is also capable of generating DevExpress grid layout using Description dynamic field taken from MSSQL
'Generation is done for each class and is placed into the same directory where class definition is placed.
'The name of generated layout file looks like: ClassName & "Layout.xml" and is generated for all levels of inherited classes
'Such layout includes columns for related many-to-one columns as combo-box controls.
'This let make development of GUI really RAD.

Public Class MainClass
    Public ShouldDebug As Boolean = False
    Public Function Process(ByVal MyMeta_ As MyMeta.dbRoot, ByVal CommandLine_ As String, ByVal DB_ As MyMeta.IDatabase)
        If ShouldDebug Then
            System.Diagnostics.Debugger.Launch()
        End If
        MyMeta = MyMeta_
        CommandLine = CommandLine_
        DB = DB_
        Main()
    End Function
End Class

Module MainModule
    'Public ZeusContext As Zeus.ZeusContext
    Public MyMeta As MyMeta.dbRoot
    Public CommandLine As String

    Class ClassDef
        Public Const MaxLevelNumber As Int32 = 9
        Public Const MaxClassNumber As Int32 = 9
        Public ClassName, TableName, ExceptTableName As String
        Public TableNameRX, ExceptTableNameRX As Text.RegularExpressions.Regex
        Public TableNameMatch, ExceptTableNameMatch As Text.RegularExpressions.Match

        Public Function RealClassName(Optional ByVal RealTableName_ As String = "") As String
            If RealTableName_ = "" Then
                RealTableName_ = RealTableName
            End If
            RealClassName = TableNameRX.Replace(RealTableName_, ClassName)
        End Function

        Public RealTableName As String
        Public FromFieldName, ToFieldName As String
        Public FieldList As String
        Public ParentClassDefinition As ClassDef
        Public IsInherited As Boolean
        Public LevelNumber, ClassNumber As Int32
        Public TableDef As MyMeta.ITable
        Public ColumnDef As MyMeta.IColumn
        Public Shared LevelCount As Int32
        Public Shared Items(MaxLevelNumber, MaxClassNumber) As ClassDef
    End Class

    Const AlwaysExcludeTables As String = "dtproperties_, sysconstraints_, syssegments_"
    Dim OutputDir(ClassDef.MaxLevelNumber) As String
    Dim OutputName(ClassDef.MaxLevelNumber) As String
    Dim [Namespace](ClassDef.MaxLevelNumber) As String
    Dim HBM_TS, VB_TS, FirstTime_VB_TS, LayoutTS As Scripting.TextStream
    Public DB As MyMeta.IDatabase


    Sub Main()
        'DB = MyMeta.DefaultDatabase
        Dim PS As New ParameterString(" " & CommandLine, " -", " ")
        Dim I, J As Int32
        For I = 1 To ClassDef.MaxLevelNumber
            OutputDir(I) = PS.Value("OutputDir" & I)
            If IsBlank(OutputDir(I)) Then
                If I = 1 Then
                    Console.Write("Please specify the required parameter: -OutputDir1")
                    Exit Sub
                Else
                    ClassDef.LevelCount = I
                End If
            End If

            OutputName(I) = PS.Value("OutputName" & I)
            If IsBlank(OutputName(I)) Then
                If I = 1 Then
                    OutputName(I) = DB.Name
                Else
                    ClassDef.LevelCount = I
                End If
            End If

            [Namespace](I) = PS.Value("Namespace" & I)
            If IsBlank([Namespace](I)) Then
                If I = 1 Then
                    Console.Write("Please specify the required parameter: -Namespace1")
                    Exit Sub
                Else
                    ClassDef.LevelCount = I
                End If
            End If

            For J = 1 To ClassDef.MaxClassNumber 'All classes on this level
                Dim LBS As String = PS.Value("Level" & I & "Class" & J)
                If IsBlank(LBS) Then
                    ClassDef.Items(I, J) = Nothing
                Else
                    Dim LBSParts() As String = Split(LBS, ":", 3)
                    ClassDef.Items(I, J) = New ClassDef
                    With ClassDef.Items(I, J)
                        Select Case LBSParts.Length
                            Case 1
                                .TableName = LBSParts(0)
                                .ClassName = .TableName & "_"
                            Case 2, 3
                                .TableName = LBSParts(1)
                                .ClassName = LBSParts(0)
                                If LBSParts.Length = 3 Then
                                    .ExceptTableName = LBSParts(2)
                                End If
                        End Select
                        'Postprocessing
                        If .TableName <> "" Then
                            Dim StartingBracketPos As Int32 = InStr(.TableName, "[", CompareMethod.Text)
                            Dim EndingBracketPos As Int32 = InStr(.TableName, "]", CompareMethod.Text)
                            If StartingBracketPos > 0 And EndingBracketPos > 0 Then
                                Dim FieldRange As String = Mid(.TableName, StartingBracketPos + 1, EndingBracketPos - StartingBracketPos - 1)
                                'Currently only from..to is implemented
                                Dim FieldRangeParts() As String = Split(FieldRange, "..")
                                .FromFieldName = FieldRangeParts(0)
                                .ToFieldName = FieldRangeParts(1)
                                .TableName = Left(.TableName, StartingBracketPos - 1)
                            End If
                            .TableNameRX = New Text.RegularExpressions.Regex(.TableName, _
                                Text.RegularExpressions.RegexOptions.IgnoreCase And _
                                Text.RegularExpressions.RegexOptions.Singleline And _
                                Text.RegularExpressions.RegexOptions.ECMAScript)
                            If IsBlank(.ExceptTableName) Then
                                .ExceptTableName = "Table name exclusion is not defined"
                            End If
                            .ExceptTableNameRX = New Text.RegularExpressions.Regex(.ExceptTableName, Text.RegularExpressions.RegexOptions.IgnoreCase And Text.RegularExpressions.RegexOptions.Singleline)
                            .LevelNumber = I
                            .ClassNumber = J
                            If I > 0 And Not IsNothing(ClassDef.Items(I - 1, J)) Then
                                .ParentClassDefinition = ClassDef.Items(I - 1, J)
                                .IsInherited = True
                            Else
                                .IsInherited = False
                            End If
                        End If '.TableName <> ""
                    End With
                End If 'Not IsBlank(LBS)
            Next
        Next

        Dim FSO As New Scripting.FileSystemObject
        For I = 1 To ClassDef.LevelCount
            If Not LevelIsEmpty(I) Then
                HBM_TS = FSO.OpenTextFile(ConcatenatePathParts(OutputDir(I), OutputName(I) & ".hbm.xml"), Scripting.IOMode.ForWriting, True)
                VB_TS = FSO.OpenTextFile(ConcatenatePathParts(OutputDir(I), OutputName(I) & "_.vb"), Scripting.IOMode.ForWriting, True)
                FirstTime_VB_TS = FSO.OpenTextFile(ConcatenatePathParts(OutputDir(I), OutputName(I) & "FirstTime.vb"), Scripting.IOMode.ForWriting, True)
                HBM_TS.WriteLine("<?xml version=""1.0"" encoding=""utf-8"" ?>")
                HBM_TS.WriteLine("<hibernate-mapping xmlns=""urn:nhibernate-mapping-2.2"" default-access=""field"" assembly=""" & [Namespace](I) & """ namespace=""" & [Namespace](I) & """>")
                For Each T As MyMeta.ITable In DB.Tables 'where table_name<>'sysdiagrams'
                    If Not (InStr(AlwaysExcludeTables, T.Name, CompareMethod.Text) > 0) Then
                        Dim CD As ClassDef = FindTableClassDef(I, T.Name)
                        If Not IsNothing(CD) Then
                            ' ------------ Actual file generation
                            CD.TableDef = T
                            If CD.IsInherited Then
                                HBM_TS.WriteLine("  <subclass name=""" & CD.RealClassName & """ lazy=""false""  discriminator-value=""" & CD.RealClassName & """ extends=""" & _
                                    [Namespace](I - 1) & "." & CD.ParentClassDefinition.RealClassName & "," & [Namespace](I - 1) & """>")
                            Else
                                HBM_TS.WriteLine("  <class name=""" & CD.RealClassName(T.Name) & """ table=""" & T.Name & """ lazy=""false"">")
                            End If
                            VB_TS.WriteLine("Public Class " & CD.RealClassName(T.Name) & "_")
                            If CD.IsInherited Then
                                VB_TS.WriteLine("   Inherits " & CD.ParentClassDefinition.RealClassName(T.Name))
                            Else
                                VB_TS.WriteLine("   Inherits NHObject")
                            End If
                            FirstTime_VB_TS.WriteLine("Public Class " & CD.RealClassName(T.Name) & _
                                vbNewLine & "  Inherits " & CD.RealClassName(T.Name) & "_")
                            Dim FieldRangeStarted, FieldRangeEnded As Boolean
                            FieldRangeStarted = False
                            FieldRangeEnded = False
                            Dim ColNumber As Int32 = 0
                            LayoutTS = FSO.OpenTextFile(ConcatenatePathParts(OutputDir(I), OutputName(I) & "_DXLayout_" & T.Name & ".xml"), Scripting.IOMode.ForWriting, True)
                            LayoutTS.WriteLine("<XtraSerializer version=""1.0"" application=""View"">")
                            LayoutTS.WriteLine("    <property name=""Columns"" iskey=""true"" value=""" & CD.TableDef.Columns.Count & """>")
                            For Each CD.ColumnDef In CD.TableDef.Columns
                                ColNumber += 1
                                LayoutTS.WriteLine("        <property name=""Item" & ColNumber & """ isnull=""true"" iskey=""true"">")
                                Dim FieldDescription As String
                                If CD.ColumnDef.Name = "Id" Then
                                    FieldDescription = "Id"
                                Else
                                    FieldDescription = GetExtendedProperty(CD.ColumnDef, "MS_Description")
                                End If
                                LayoutTS.WriteLine("            <property name=""Caption"">" & FieldDescription & "</property>")
                                LayoutTS.WriteLine("            <property name=""ColumnEditName"" />")
                                LayoutTS.WriteLine("            <property name=""FieldName"">" & CD.ColumnDef.Name & "</property>")
                                LayoutTS.WriteLine("            <property name=""Visible"">true</property>")
                                LayoutTS.WriteLine("            <property name=""Name"">" & Replace(CD.ColumnDef.Name, " ", "") & "Col</property>")
                                LayoutTS.WriteLine("            <property name=""VisibleIndex"">" & ColNumber - 1 & "</property>")
                                LayoutTS.WriteLine("        </property>")
                                If CD.ColumnDef.Name = CD.FromFieldName Or CD.FromFieldName = "" Then
                                    FieldRangeStarted = True
                                End If
                                If FieldRangeStarted And Not FieldRangeEnded Then
                                    If CD.ColumnDef.IsInPrimaryKey Then
                                        ProcessProperty(CD, PropertyProcessingType.Id)
                                    ElseIf CD.ColumnDef.IsInForeignKey Then
                                        ProcessProperty(CD, PropertyProcessingType.ManyToOne)
                                    ElseIf Right(CD.ColumnDef.Name, 4) = "_EID" Then
                                        ProcessProperty(CD, PropertyProcessingType.EnumID)
                                    ElseIf CD.ColumnDef.Name = "NHDiscriminator" Then
                                        ProcessProperty(CD, PropertyProcessingType.Discriminator)
                                    Else
                                        Dim CustomType As String = GetExtendedProperty(CD.ColumnDef, "CustomType")
                                        If Not IsBlank(CustomType) Then
                                            ProcessProperty(CD, PropertyProcessingType.CustomType, CustomType)
                                        Else
                                            ProcessProperty(CD, PropertyProcessingType.General)
                                        End If
                                    End If
                                End If
                                If CD.ColumnDef.Name = CD.ToFieldName Then
                                    FieldRangeEnded = True
                                End If
                            Next 'Each CD.ColumnDef In CD.TableDef.Columns
                            LayoutTS.WriteLine("</property></XtraSerializer>")
                            LayoutTS.Close()
                            FirstTime_VB_TS.WriteLine("End Class")
                            VB_TS.WriteLine("End Class")
                            If CD.IsInherited Then
                                HBM_TS.WriteLine("  </subclass>")
                            Else
                                HBM_TS.WriteLine("  </class>")
                            End If
                            Console.WriteLine("Generated class for table: " & T.Name)
                            ' ------------------------------------
                        End If 'Not IsNothing(CD)
                    End If ' Not InStr(AlwaysExcludeTables,...)
                Next ' For Each T
                HBM_TS.WriteLine("</hibernate-mapping>")
                FirstTime_VB_TS.Close()
                VB_TS.Close()
                HBM_TS.Close()
            End If 'Not LevelIsEmpty(I)
        Next
    End Sub
    Function LevelIsEmpty(ByVal ClassLevel As Integer) As Boolean
        For I As Integer = 1 To ClassDef.MaxClassNumber
            If Not IsNothing(ClassDef.Items(ClassLevel, I)) Then
                LevelIsEmpty = False
                Exit Function
            End If
        Next
        LevelIsEmpty = True
    End Function
    Function GetExtendedProperty(ByVal S As MyMeta.Single, ByVal PropertyName As String) As String
        Dim EP As MyMeta.KeyValueCollection = S.DatabaseSpecificMetaData("ExtendedProperties")
        Dim VP As MyMeta.KeyValuePair
        Do While EP.MoveNext()
            VP = EP.Current
            If StrComp(VP.Key, PropertyName, CompareMethod.Text) = 0 Then
                GetExtendedProperty = VP.Value
                Exit Do
            End If
        Loop
    End Function

    'Writes each property to class file based on previously collected information
    Function ProcessProperty(ByVal CD As ClassDef, ByVal PPT As PropertyProcessingType, Optional ByVal Info As String = "")
        Dim PropertyName As String = CD.ColumnDef.Name
        Dim PropertyTypeName As String = CD.ColumnDef.LanguageType
        Select Case PPT
            Case PropertyProcessingType.Id
                HBM_TS.WriteLine("      <id name=""" & CD.ColumnDef.Name & """ column=""" & CD.ColumnDef.Name & """ type=""" & CD.ColumnDef.LanguageType & """ unsaved-value=""0""><generator class=""native""/></id>")
            Case PropertyProcessingType.EnumID
                PropertyTypeName = Left(CD.ColumnDef.Name, Len(CD.ColumnDef.Name) - 4) & "Enum"
                HBM_TS.WriteLine("      <property name=""" & CD.ColumnDef.Name & """/>")
            Case PropertyProcessingType.CustomType
                PropertyTypeName = Info
                HBM_TS.WriteLine("      <property name=""" & CD.ColumnDef.Name & """/>")
            Case PropertyProcessingType.General
                If InStr(CD.ColumnDef.LanguageType, "DateTime", CompareMethod.Text) > 0 Then
                    PropertyTypeName &= " = #1/1/1900#"
                End If
                HBM_TS.WriteLine("      <property name=""" & CD.ColumnDef.Name & """/>")
            Case PropertyProcessingType.Discriminator
                PropertyName = ""
                HBM_TS.WriteLine("      <discriminator column=""NHDiscriminator"" type=""String""/>")
            Case PropertyProcessingType.ManyToOne
                Dim FK As MyMeta.IForeignKey = CD.ColumnDef.ForeignKeys(0)
                Dim RelatedTable As MyMeta.ITable = FK.PrimaryTable
                Dim TableClassDef As ClassDef = FindTableClassDef(CD.LevelNumber, RelatedTable.Name, True)
                If IsNothing(TableClassDef) Then
                    VB_TS.WriteLine("'Error! : TableClassDef corresponding to " & RelatedTable.Name & " has not been found.  PropertyProcessingType has been changed to General. ")
                    ProcessProperty(CD, PropertyProcessingType.General)
                    Exit Function
                Else
                    PropertyTypeName = TableClassDef.RealClassName(RelatedTable.Name)
                    If StrComp(Right(CD.ColumnDef.Name, 2), "Id", CompareMethod.Text) = 0 Then
                        PropertyName = Left(CD.ColumnDef.Name, Len(CD.ColumnDef.Name) - 2)
                    End If
                    HBM_TS.WriteLine("      <many-to-one name=""" & PropertyName & """ column=""" & CD.ColumnDef.Name & """ class=""" & PropertyTypeName & """ />")
                End If
        End Select
        If PropertyName <> "" And PPT <> PropertyProcessingType.Id Then
            VB_TS.WriteLine("   Public [" & PropertyName & "] As " & PropertyTypeName)
        End If
    End Function

    Enum PropertyProcessingType
        Id
        General
        Discriminator
        ManyToOne
        EnumID
        CustomType
    End Enum

    'Finds a class corresponding to a table at a specific inheritance level
    Function FindTableClassDef(ByVal LevelNumber As Int32, ByVal TableName As String, Optional ByVal IncludeLowerLevels As Boolean = False) As ClassDef
        For J As Int32 = 1 To ClassDef.MaxClassNumber
            If Not IsNothing(ClassDef.Items(LevelNumber, J)) Then
                With ClassDef.Items(LevelNumber, J)
                    .TableNameMatch = .TableNameRX.Match(TableName)
                    .ExceptTableNameMatch = .ExceptTableNameRX.Match(TableName)
                    If .TableNameMatch.Success And Not .ExceptTableNameMatch.Success Then
                        If .IsInherited Then
                            .RealTableName = TableName
                            .ParentClassDefinition.RealTableName = TableName
                        End If
                        FindTableClassDef = ClassDef.Items(LevelNumber, J)
                        Exit Function
                    End If
                End With
            End If
        Next
        If IsNothing(FindTableClassDef) And LevelNumber > 1 And IncludeLowerLevels Then
            FindTableClassDef = FindTableClassDef(LevelNumber - 1, TableName, True)
        End If
    End Function
End Module