Imports System.Text.RegularExpressions
Imports System.Text

''' <summary>
'' 'Dynamic SQL parser
''' </summary>
''' <remarks></remarks>
Public Class DynamicSqlParser
    ''' <summary>
    '' 'Create the DB command
    ''' </summary>
    '' '<param name = "cn"> DB connection </ param>
    ''' <param name="dsql">DynamicSQL</param>
    '' '<param name = "prefix"> Parameter prefix </ param>
    '' '<param name = "params"> Parameter value dictionary </ param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function CreateDbCommand(cn As IDbConnection, dsql As String, prefix As String, params As Dictionary(Of String, Object)) As IDbCommand
        Dim cmd As IDbCommand = cn.CreateCommand

        'Parameter addition
        Dim paramAdder As Action(Of String, Object) =
            Sub(name As String, value As Object)
                If cmd.Parameters.Contains(name) Then Return
                Dim prm As IDbDataParameter = cmd.CreateParameter
                prm.ParameterName = name
                prm.Value = If(value Is Nothing, DBNull.Value, value)
                cmd.Parameters.Add(prm)
            End  Sub

        'Command text substitution
        cmd.CommandText = Read(dsql, prefix, params, paramAdder)
        If cmd.CommandText.Any = False Then cmd.CommandText = dsql

        Return cmd
    End Function

    ''' <summary>
    '' 'Create StaticSQL
    ''' </summary>
    ''' <param name="dsql"></param>
    ''' <param name="prefix">DynamicSQL</param>
    ''' <param name="params">ラメータ接</</param>
    '' '<param name = "paramAdder"> Parameter value dictionary </ param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function Read(dsql As String, prefix As String, params As Dictionary(Of String, Object), paramAdder As Action(Of String, Object)) As String
        Return ReadAsWhereBlock(dsql, prefix, params, paramAdder)
    End Function

    ''' <summary>
    '' 'WHERE block read
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks>
    '' 'If there is no extraction condition, delete the WHERE clause
    ''' </remarks>
    Private Shared Function ReadAsWhereBlock(dsql As String, prefix As String, params As Dictionary(Of String, Object), paramAdder As Action(Of String, Object)) As String
        'WHERE block format
        Const WHERE_BLOCK As String = "/\*ds where\*/.*?(?<where>where)(?<block>.*?)/\*ds end where\*/[ ]?"

        Dim  s  As  New  StringBuilder
        Dim  post  As  Integer  =  0

        'Analyze dsql
        Dim m As Match = Regex.Match(dsql, WHERE_BLOCK, RegexOptions.IgnoreCase Or RegexOptions.Singleline)
        If m.Success = False Then Return ReadAsIfBlock(dsql, prefix, params, paramAdder)

        While m.Success
            Dim g As Group = m.Groups("where")
            Dim block As Group = m.Groups("block")
            Dim parts As String = ReadAsIfBlock(block.Value, prefix, params, paramAdder)

            'Command text
            If String.IsNullOrEmpty(parts) Then
                'If WHERE block is empty, no WHERE clause
                s.AppendFormat("{0} ", dsql.Substring(pos, m.Index - pos))
            Else
                'If the WHERE block is not empty, write a WHERE clause
                s.AppendFormat("{0}{1}{2} ", dsql.Substring(pos, m.Index - pos), g.Value, parts.ToString)
            End If

            'post process
            pos = m.Index + m.Length
            m = m.NextMatch
        End While

        Return s.ToString.TrimEnd
    End Function

    ''' <summary>
    '' 'IF block read
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks>
    '' 'If NULL Erase the conditional expression itself
    ''' </remarks>
    Private Shared Function ReadAsIfBlock(dsql As String, prefix As String, params As Dictionary(Of String, Object), paramAdder As Action(Of String, Object)) As String
        'Format
        Const IF_BLOCK As String = "/\*ds if (?<name>.*?)[ ]?\!\=[ ]?null\*/[ ]?\r\n(?<block>.*?)\r\n/\*ds end if\*/[ ]?"

        Dim  s  As  New  StringBuilder
        Dim  post  As  Integer  =  0

        'Analyze dsql
        Dim m As Match = Regex.Match(dsql, IF_BLOCK, RegexOptions.IgnoreCase Or RegexOptions.Singleline)
        If m.Success = False Then Return ReadAsParamCode(dsql, prefix, params, paramAdder)

        While m.Success
            Dim g As Group = m.Groups("name")
            Dim block As Group = m.Groups("block")
            Dim val = If(params.Keys.Contains(g.Value) = False, Nothing, params.Item(g.Value))
            Dim parts As String = String.Empty

            If Not (val Is Nothing OrElse DBNull.Value.Equals(val)) Then
                parts = ReadAsParamCode(block.Value, prefix, params, paramAdder)
            End If

            'Command text
            If String.IsNullOrEmpty(parts) = False Then
                'Operator (Prefix Format) Processing
                Const PREFIX_OPERATOR_CODE As String = "^(?<space>\s*)(?<operator>(and|or)\s*)(?<code>.*)"

                Dim mPrefix As Match = Regex.Match(parts, PREFIX_OPERATOR_CODE, RegexOptions.IgnoreCase)
                Dim tmp As String = dsql.Substring(pos, m.Index - pos)

                If s.Length = 0 AndAlso String.IsNullOrEmpty(mPrefix.Groups("operator").Value) = False Then
                    s.AppendFormat("{0}{1}{2}", tmp, mPrefix.Groups("space").Value, mPrefix.Groups("code").Value)
                Else
                    s.AppendFormat("{0}{1}", tmp, parts.ToString)
                End If
            End If

            'post process
            pos = m.Index + m.Length
            m = m.NextMatch
        End While

        'Operator (suffix format) processing
        Const SUFFIX_OPERATOR_CODE As String = "(?<code>.*)(?<op>(and|or))\s*$"
        Dim opSuffix As Match = Regex.Match(s.ToString, SUFFIX_OPERATOR_CODE, RegexOptions.IgnoreCase Or RegexOptions.Singleline)
        If opSuffix.Success Then
            Return opSuffix.Groups("code").Value.TrimEnd
        Else
            Return s.ToString.TrimEnd
        End If
    End Function

    ''' <summary>
    '' 'Read parameter code
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks>
    '' '... / * ds condition name * / dummy value ...
    ''' <code>Age Between /*ds minage*/30 AND /*ds maxage*/40</code>
    ''' </remarks>
    Private Shared Function ReadAsParamCode(dsql As String, prefix As String, params As Dictionary(Of String, Object), paramAdder As Action(Of String, Object)) As String
        'Parameter format
        Const PARAM_CODE As String = "/\*ds (?<name>[^ ]+)\*/(?<dummy>[^ ]+)(?<space> ?)"

        Dim  s  As  New  StringBuilder
        Dim  post  As  Integer  =  0

        'Analyze dsql
        Dim m As Match = Regex.Match(dsql, PARAM_CODE, RegexOptions.IgnoreCase)
        If m.Success = False Then Return dsql

        While m.Success
            Dim g As Group = m.Groups("name")
            Dim sp As Group = m.Groups("space")

            Dim val = params.Item(g.Value)
            Dim vals = TryCast(val, ICollection)
            Dim parts As New StringBuilder

            If vals Is Nothing Then
                'standard
                Dim name As String = g.Value
                paramAdder.Invoke(name, val)
                parts.AppendFormat("{0}{1}", prefix, name)
            Else
                'Array
                Dim idx As Integer = 0
                For Each item In vals
                    Dim name As String = String.Format("{0}_{1}", g.Value, idx)
                    paramAdder.Invoke(name, item)
                    parts.AppendDelimiter(", ").AppendFormat("{0}{1}", prefix, name)
                    idx += 1
                Next
                parts.Decorate("({0})")
            End If

            'Command text
            s.AppendFormat("{0}{1}{2}", dsql.Substring(pos, m.Index - pos), parts.ToString, sp.Value)

            'post process
            pos = m.Index + m.Length
            m = m.NextMatch
        End While

        'Add remaining strings as is
        s.Append(dsql.Substring(pos, dsql.Length - pos))

        Return s.ToString.TrimEnd
    End Function
End Class