' Licensed Materials - Property of IBM Corp.
' IBM UrbanCode Build
' (c) Copyright IBM Corporation 2012, 2014. All Rights Reserved.
'
' U.S. Government Users Restricted Rights - Use, duplication or disclosure restricted by
' GSA ADP Schedule Contract with IBM Corp.
'======================== Functions ========================
Dim tdConnection

Function disconnect()
    If IsObject(tdConnection) Then
        If tdConnection.Connected Then
            tdConnection.Disconnect()
            WScript.StdOut.WriteLine "Connection disconnected"
        End If
        If tdConnection.LoggedIn Then
            tdConnection.Logout()
            WScript.StdOut.WriteLine "Connection logged out"
        End If
        tdConnection.ReleaseConnection()
        WScript.StdOut.WriteLine "Connection released"
    End If
End Function

Function createConnection(serverUrl, username, password, domain, project)
    Dim connectionCreated
    connectionCreated = False
    
    Set tdConnection = CreateObject("TDApiOle80.TDConnection")

    If tdConnection Is Nothing Then
      WScript.StdOut.WriteLine = "Failed to create TDApiOle80.TDConnection Object"
    Else
      tdConnection.InitConnectionEx(serverUrl)
      If tdConnection.Connected = False Then
        WScript.StdOut.WriteLine "Connection failed to Quality Center server " & serverUrl
      Else
        WScript.StdOut.WriteLine "Connection created to Quality Center server " & serverUrl
        tdConnection.Login username, password
        If tdConnection.LoggedIn = False Then
          WScript.StdOut.WriteLine "Connection failed to log in as user " & username
        Else
          WScript.StdOut.WriteLine "Connection logged in as user " & username
          tdConnection.Connect domain, project
          If tdConnection.ProjectConnected = False Then
            WScript.StdOut.WriteLine "Connection failed to open project " & domain & "\" & project
          Else
            WScript.StdOut.WriteLine "Connection opened project " & domain & "\" & project
            connectionCreated = True
          End If
        End If
      End If
    End If
    
    If Not connectionCreated Then
        disconnect()
    End If
    
    createConnection = connectionCreated
End Function

Function escapeInvalidCharacters(string)
    ' Replace &
    string = Replace(string, Chr(38), "&amp;")
    ' Replace <
    string = Replace(string, Chr(60), "&lt;")
    ' Replace >
    string = Replace(string, Chr(62), "&gt;")
    ' Replace double quote
    string = Replace(string, Chr(34), "&quot;")
    ' Replace single quote 
    string = Replace(string, Chr(39), "&apos;")
    
    escapeInvalidCharacters = string
End Function

'======================== Main Script ========================
Dim args
Set args = WScript.Arguments
serverUrl = args.Item(0)
username = args.Item(1)
password = args.Item(2)
domain = args.Item(3)
project = args.Item(4)
testSetPath = args.Item(5)
reportName = args.Item(6)
testSetName = args.Item(7)
jobId = args.Item(8)
outputFile = args.Item(9)

' prepend Root\ to the testSetPath if it is not already there
If InStr(testSetPath, "Root\") = 0 Then
    testSetPath = "Root\" & testSetPath
End If 

connectionCreated = createConnection(serverUrl, username, password, domain, project)
If Not connectionCreated Then
    WScript.Quit 1
End If

Dim testSetTreeManager
Set testSetTreeManager = tdConnection.TestSetTreeManager

Dim testSetFolder
Set testSetFolder = testSetTreeManager.NodeByPath(testSetPath)

Dim testSetList 
Set testSetList = testSetFolder.FindTestSets(testSetName)

If testSetList.Count = 0 Then
    WScript.StdOut.WriteLine "Test Set named '" & testSetName & "' not found."
ElseIf testSetList.Count > 1 Then
    WScript.StdOut.WriteLine "Multiple Test Sets named '" & testSetName & "' were found."
End If

Dim testSet
Set testSet = testSetList.Item(1)
WScript.StdOut.WriteLine "Found test set " & testSet.ID & " for " & testSetPath & "\" & testSetName

Dim testSetTestList
Set testSetTestList = testSet.TSTestFactory.NewList("")
WScript.StdOut.WriteLine "Found " & testSetTestList.Count & " tests"

failed = 0
passed = 0

Dim testSetTest, testLastRun
For i = 1 To testSetTestList.Count
    Set testLastRun = testSetTestList.Item(i).LastRun
    WScript.StdOut.WriteLine testLastRun.Name & " - " & testLastRun.Status 
    If testLastRun.Status = "Passed" Then
        passed = passed + 1
    ElseIf testLastRun.Status = "Failed" Then
        failed = failed + 1
    Else
        WScript.StdOut.WriteLine "Unrecognized test status: " & testLastRun.Status
    End If
Next
WScript.StdOut.WriteLine "Done counting pass/fail (" & passed & " passed, " & failed & " failed)"


Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
Set textFile = fileSystemObject.OpenTextFile(outputFile, 2, True)

Dim steps, step

textFile.Write "<test-report name=""" & escapeInvalidCharacters(reportName) & """"
textFile.Write " type=""HP Quality Center"""
textFile.Write " job-id=""" & escapeInvalidCharacters(jobId) & """"
textFile.Write " successes=""" & escapeInvalidCharacters(passed) & """"
textFile.WriteLine " failures=""" & escapeInvalidCharacters(failed) & """>"
textFile.Write "  <test-suite name=""" & escapeInvalidCharacters(testSetPath) & "\" & escapeInvalidCharacters(testSetName) & """"
textFile.Write " successes=""" & escapeInvalidCharacters(passed) & """"
textFile.WriteLine " failures=""" & escapeInvalidCharacters(failed) & """>"
For i = 1 To testSetTestList.Count
    Set testSetTest = testSetTestList.Item(i)
    Set testLastRun = testSetTest.LastRun
    
    status = ""
    If testLastRun.Status = "Passed" Then
        status = "success"
    ElseIf testLastRun.Status = "Failed" Then
        status = "failure"
    Else
        status = testLastRun.Status
    End If
    
    Set steps = testLastRun.StepFactory.NewList("")
    
    duration = testLastRun.Field("RN_DURATION") * 1000

    textFile.Write "    <test name=""" & escapeInvalidCharacters(testSetTest.Name) & """"
    textFile.Write " result=""" & escapeInvalidCharacters(status) & """"
    textFile.WriteLine " time=""" & escapeInvalidCharacters(duration) & """>"

    textFile.WriteLine "      <message>Host: " & escapeInvalidCharacters(testLastRun.Field("RN_HOST")) & "</message>"
        For j = 1 To steps.Count
            Set step = steps.Item(j)
            textFile.WriteLine "      <message>Step: " & escapeInvalidCharacters(step.Name) & " " & escapeInvalidCharacters(step.Status) & "</message>"
        Next
    textFile.WriteLine "    </test>"
Next
textFile.WriteLine "  </test-suite>"
textFile.WriteLine "</test-report>"

textFile.Close

WScript.StdOut.WriteLine "Completed writing test XML to " & outputFile

disconnect()
WScript.Quit(-666)