tracking_kits/Tests/TrackingDataImport_TestHarness.vbs

Option Explicit

Const ForReading = 1
Const TristateTrue = -1

Dim fso:Set fso = CreateObject("Scripting.FileSystemObject")
Dim scriptDir: scriptDir = fso.GetParentFolderName(WScript.ScriptFullName)
Dim repoRoot: repoRoot = fso.GetParentFolderName(scriptDir)
Dim sourcePath: sourcePath = fso.BuildPath(repoRoot, "ImportService\\TrackingDataImport.vbs")
Dim objFSO
Dim DataDirectory

Dim functionNames
functionNames = Array( _
    "PadLeft", _
    "CheckForFiles", _
    "Truncate", _
    "PadString", _
    "CleanNull", _
    "Assign", _
    "Choice", _
    "CompressArray", _
    "TrimLeadingZeros", _
    "PushNonEmptyToBottom", _
    "GetState", _
    "GetCityFromLine" _
)

LoadFunctions sourcePath, functionNames

Dim passed: passed = 0
Dim failed: failed = 0

Dim q: q = Chr(34)
AssertEqual Truncate("abcdef", 3), q & "abc" & q & ",", "Truncate trims and quotes"
AssertEqual Truncate("ab", 3), q & "ab" & q & ",", "Truncate short string"

AssertEqual PadLeft("7", 3, "0"), "007", "PadLeft pads"
AssertEqual PadLeft("1234", 3, "0"), "1234", "PadLeft no pad when longer"

AssertEqual PadString("ab", 4), "ab  ", "PadString right pads"
AssertEqual PadString("abcd", 4), "abcd", "PadString same length"
AssertEqual PadString(Null, 3), "   ", "PadString null"

AssertEqual CleanNull(Null), "", "CleanNull null"
AssertEqual CleanNull("x"), "x", "CleanNull value"

Dim arr
arr = Array("", "a", "", "b")
arr = CompressArray(arr)
AssertArrayEqual arr, Array("a", "b", "", ""), "CompressArray moves blanks to end"

AssertEqual TrimLeadingZeros("000123"), "123", "TrimLeadingZeros removes leading zeros"
AssertEqual TrimLeadingZeros("0000"), "", "TrimLeadingZeros all zeros"

Dim arr2
arr2 = Array("a", "", "b", "")
PushNonEmptyToBottom arr2
AssertArrayEqual arr2, Array("", "", "a", "b"), "PushNonEmptyToBottom"

AssertEqual GetState("Lansing, MI 48906"), "MI", "GetState matches state"
AssertEqual GetState("No match"), "", "GetState no match"

AssertEqual GetCityFromLine("Lansing, MI 48906"), "Lansing", "GetCityFromLine with comma"
AssertEqual GetCityFromLine("NoComma"), "NoComma", "GetCityFromLine no comma"
AssertEqual GetCityFromLine(Null), "", "GetCityFromLine null"

Dim tempDir
tempDir = fso.BuildPath(repoRoot, "Tests\\_tmp_checkforfiles")
If Not fso.FolderExists(tempDir) Then
    fso.CreateFolder tempDir
End If
Set objFSO = fso
DataDirectory = tempDir
On Error Resume Next
Dim checkResult
checkResult = CheckForFiles()
If Err.Number = 0 Then
    passed = passed + 1
    WScript.Echo "PASS: CheckForFiles runs without error (empty dir)"
Else
    failed = failed + 1
    WScript.Echo "FAIL: CheckForFiles error " & Err.Number & " - " & Err.Description
    Err.Clear
End If
On Error GoTo 0

WScript.Echo ""
WScript.Echo "Passed: " & passed
WScript.Echo "Failed: " & failed
If failed > 0 Then
    WScript.Quit 1
End If

Sub LoadFunctions(ByVal filePath, ByVal names)
    Dim fileText, lines, i, line
    Dim capturing: capturing = False
    Dim endKeyword: endKeyword = ""
    Dim block: block = ""

    If Not fso.FileExists(filePath) Then
        WScript.Echo "FAIL: Source file not found: " & filePath
        WScript.Quit 1
    End If

    With fso.OpenTextFile(filePath, ForReading, False, TristateTrue)
        fileText = .ReadAll
        .Close
    End With

    ' Normalize line endings and remove nulls/BOM that can appear in UTF-16 reads
    fileText = Replace(fileText, ChrW(&HFEFF), "")
    fileText = Replace(fileText, Chr(0), "")
    fileText = Replace(fileText, vbTab, " ")
    fileText = Replace(fileText, vbCrLf, vbLf)
    fileText = Replace(fileText, vbCr, vbLf)
    lines = Split(fileText, vbLf)

    For i = 0 To UBound(lines)
        line = lines(i)
        If Not capturing Then
            Dim nameIndex
            For nameIndex = 0 To UBound(names)
                Dim kind
                If TryStartLine(line, names(nameIndex), kind) Then
                    capturing = True
                    endKeyword = "End " & kind
                    block = block & line & vbCrLf
                    Exit For
                End If
            Next
        Else
            block = block & line & vbCrLf
            If LCase(Trim(line)) = LCase(endKeyword) Then
                capturing = False
                block = block & vbCrLf
            End If
        End If
    Next

    If Len(block) = 0 Then
        ' Fallback: simple text scan for each function/sub
        Dim nameIndex2
        For nameIndex2 = 0 To UBound(names)
            Dim extracted
            extracted = ExtractBlock(fileText, names(nameIndex2))
            If Len(extracted) > 0 Then
                block = block & extracted & vbCrLf & vbCrLf
            End If
        Next
    End If

    If Len(block) = 0 Then
        WScript.Echo "FAIL: No functions loaded from " & filePath
        WScript.Echo "Debug: file length=" & Len(fileText)
        WScript.Quit 1
    End If

    ExecuteGlobal block
End Sub

Function ExtractBlock(ByVal fileText, ByVal name)
    Dim lowerText, lowerName, startPos, endPos, kind, endToken
    lowerText = LCase(fileText)
    lowerName = LCase(name)

    startPos = FindDeclPos(lowerText, lowerName, "function")
    kind = "Function"
    If startPos = 0 Then
        startPos = FindDeclPos(lowerText, lowerName, "sub")
        kind = "Sub"
    End If

    If startPos = 0 Then
        ExtractBlock = ""
        Exit Function
    End If

    endToken = "end " & LCase(kind)
    endPos = InStr(startPos, lowerText, endToken)
    If endPos = 0 Then
        ExtractBlock = ""
        Exit Function
    End If

    endPos = endPos + Len(endToken) - 1
    ExtractBlock = Mid(fileText, startPos, endPos - startPos + 1)
End Function

Function FindDeclPos(ByVal lowerText, ByVal lowerName, ByVal keyword)
    Dim pos, idx, ch, nameLen, nextChar
    nameLen = Len(lowerName)
    pos = InStr(1, lowerText, keyword)
    Do While pos > 0
        idx = pos + Len(keyword)
        Do While idx <= Len(lowerText)
            ch = Mid(lowerText, idx, 1)
            If IsWs(ch) Then
                idx = idx + 1
            Else
                Exit Do
            End If
        Loop
        If LCase(Mid(lowerText, idx, nameLen)) = lowerName Then
            nextChar = Mid(lowerText, idx + nameLen, 1)
            If nextChar = "" Or Not IsNameChar(nextChar) Then
                FindDeclPos = pos
                Exit Function
            End If
        End If
        pos = InStr(pos + 1, lowerText, keyword)
    Loop
    FindDeclPos = 0
End Function

Function IsWs(ByVal ch)
    IsWs = (ch = " " Or ch = vbTab Or ch = vbLf Or ch = vbCr Or AscW(ch) = 160)
End Function

Function IsNameChar(ByVal ch)
    Dim code
    code = AscW(ch)
    IsNameChar = (code >= 48 And code <= 57) Or (code >= 65 And code <= 90) Or (code >= 97 And code <= 122) Or ch = "_"
End Function

Function TryStartLine(ByVal line, ByVal name, ByRef kind)
    Dim lowerLine, lowerName, pos
    lowerLine = LCase(line)
    lowerName = LCase(name)

    pos = FindDeclPos(lowerLine, lowerName, "function")
    If pos > 0 Then
        kind = "Function"
        TryStartLine = True
        Exit Function
    End If

    pos = FindDeclPos(lowerLine, lowerName, "sub")
    If pos > 0 Then
        kind = "Sub"
        TryStartLine = True
        Exit Function
    End If

    TryStartLine = False
End Function

Sub AssertEqual(ByVal actual, ByVal expected, ByVal testName)
    If actual = expected Then
        passed = passed + 1
        WScript.Echo "PASS: " & testName
    Else
        failed = failed + 1
        WScript.Echo "FAIL: " & testName & " | expected=" & FormatValue(expected) & " actual=" & FormatValue(actual)
    End If
End Sub

Sub AssertArrayEqual(ByVal actual, ByVal expected, ByVal testName)
    Dim ok: ok = True
    Dim i
    If (UBound(actual) <> UBound(expected)) Then
        ok = False
    Else
        For i = 0 To UBound(actual)
            If actual(i) <> expected(i) Then
                ok = False
                Exit For
            End If
        Next
    End If

    If ok Then
        passed = passed + 1
        WScript.Echo "PASS: " & testName
    Else
        failed = failed + 1
        WScript.Echo "FAIL: " & testName & " | expected=" & ArrayToString(expected) & " actual=" & ArrayToString(actual)
    End If
End Sub

Function ArrayToString(ByVal arr)
    Dim i, s
    s = "["
    For i = 0 To UBound(arr)
        If i > 0 Then s = s & ", "
        s = s & FormatValue(arr(i))
    Next
    s = s & "]"
    ArrayToString = s
End Function

Function FormatValue(ByVal v)
    If IsNull(v) Then
        FormatValue = "<null>"
    Else
        FormatValue = "\"" & CStr(v) & "\""
    End If
End Function