Subversion Repositories DevTools

<%@LANGUAGE="VBSCRIPT"%>
<%
'=====================================================
'   splunk_build_test_results.asp
'
'   This page is designed to be used by 'splunk'
'   It is a very simple REST style interface
'   It simple produces Build and Unit tests metrics
'
'   The output is pure JSON
'   There are two sections
'   info : {}       - Internal data about the process
'   data : {}       - Build and Test results
'
'   The data section is organised by:
'       Project and then Release
'       Within each release there is:
'           BuildsCompleted
'           BuildsInError
'       Within each of these there is:
'           Count           - Total packages
'           UnitTests       - Total Unit Tests
'           NewVersions     - Subset of Count
'           Ripples         - Subset of Count
'           Other           - Subset of Count
'   The data is for all time
'   [May need to rethink that if processing time blows out]
'
'   Get Requests
'       ?day=n            - Limit result set n days ago
'                             0 == Results since midnight
'                             1 == yesterday
'
'=====================================================
%>
<%
Option explicit
' Essential to get UTF through all the hoops. ie: VÄSTTRAFIK (VTK)
Response.ContentType = "text/html"
Response.AddHeader "Content-Type", "text/html;charset=UTF-8"
Response.CodePage = 65001
Response.CharSet = "UTF-8"
%>
<!--#include file="common/conf.asp"-->
<!--#include file="common/globals.asp"-->
<!--#include file="common/qstr.asp"-->
<!--#include file="common/common_subs.asp"-->
<SCRIPT LANGUAGE="VBScript" RUNAT=SERVER SRC="class/classaspJSON.vbs"></SCRIPT> 
<%
'------------ Variable Definition -------------
Dim result : result = -1
Dim SqlQry
Dim rsQry

' Init the output JSON class
'   Default data will be added at the end
Dim oJSON   : Set oJSON = New aspJSON
Dim infoSet : Set infoSet = newDataSet("info", oJSON.data)

'
'   Perform the bulk of the work within a sub
'       Done so that errors propergate up
'       Using the On Error Resume Next, any error within the routine
'       will cause the routine to exit    
On Error Resume Next
Call DoWork

'
' SQL error detection and reporting
If objEH.LastOraFailed Then
    infoSet("error") = 1
    result = -2
    infoSet("emsgSummary") = objEH.MessageSummary
    infoSet("emsgDetails") = objEH.MessageDetails
    infoSet("SqlQry") = SqlQry
'
'   Detect program errors
ElseIf Err.number <> 0 Then
    result = -3
    infoSet("error") = 2
    infoSet("errnum") = Err.number
    infoSet("errtxt") = Err.description
    infoSet("errsrc") = Err.source
End If

infoSet("result") = result

'Return the object
Response.Write oJSON.JSONoutput()
Set oJSON = Nothing
Call Destroy_All_Objects
' --- End of Mainline
'------------------------------------------------------------------------------
'
'   Create a new collection and add it to an existing colelction
'       sname - Name of the new collection (Key Name)
'       pset  - Parent collection. The collection to add it to
'   Returns a Collection ( Scripting Dictionary)
Function newDataSet(sname, pset)
    Set newDataSet  = oJSON.Collection()
    Set pset(sname) = newDataSet
End Function

'------------------------------------------------------------------------------
'
'   Perform the body of the query
'   Done in a Sub so that errors can be better captured and reported
Sub DoWork

    '   Create a collection to contain the returned data
    '
    Dim dataSet : Set dataSet = newDataSet("data", oJSON.data)

    '
    '   Support time limited query
    '
    Dim repday : repday = NiceInt( Request("day"), -1 )
    Dim limit : limit = ""
    If repday >= 0 Then
        infoSet("day") = repday
        limit = " AND bi.TIMESTAMP > TRUNC(SYSDATE - "& repday &")"
        limit = limit & " AND bi.TIMESTAMP < TRUNC(SYSDATE - "& repday - 1 &")"
    End If


    '   The query
    '
    SqlQry = _
        "SELECT proj_name," &_
        "  rtag_name," &_
        "  state," &_
        "  reason,  " &_
        "  COUNT(reason)   AS rc," &_
        "  SUM(test_count) AS tc" &_
        " FROM" &_
        "  (SELECT pj.PROJ_NAME," &_
        "    RTAG_NAME," &_
        "    DECODE(bi.reason, 'N', 'NewVersion', 'R', 'Ripple', 'T', 'Test', 'P', 'Restored', 'F', 'ForcedRipple', 'Unknown') as REASON," &_
        "    DECODE(bi.state, 'B', 'Buiding', 'C', 'Complete', 'E', 'Error', 'S', 'SysErr', 'Unknown') as STATE," &_
        "    (SELECT COUNT(*) FROM TEST_RUN tr WHERE tr.build_id = bi.build_id ) AS test_count" &_
        "  FROM BUILD_INSTANCES bi," &_
        "    projects pj," &_
        "    RELEASE_TAGS rt" &_
        "  WHERE bi.RTAG_ID = rt.RTAG_ID(+)" &_
        "  AND rt.proj_id   = pj.proj_id(+)" & limit &_
        "  ) group by proj_name, rtag_name, state, reason" &_
        " ORDER BY PROJ_NAME, rtag_name,  state,  reason"

    On Error Resume Next
    objEH.ErrorRedirect = FALSE
    objEH.TryORA ( OraSession )
    Set rsQry = OraDatabase.DbCreateDynaset( SqlQry, ORADYN_DEFAULT )
    objEH.CatchORA ( OraSession )

    ' Process each row and return required fields to the user
    If objEH.Finally Then
    On Error goto 0
        Dim lastProjectName, proj : lastProjectName = ""
        Dim lastReleaseName, rel : lastReleaseName = ""
        Dim dataOk, dataError
        While (NOT rsQry.BOF) AND (NOT rsQry.EOF)
            ' Attempt to speed up access tot he data
            '    Extract all fields for the row
            '    Access fields by index
            Dim fields
            Set fields = rsQry.Fields

            Dim pname    : pname = fields(0)
            Dim rname    : rname = fields(1)
            Dim state    : state = fields(2)
            Dim reason   : reason = fields(3)
            Dim rc       : rc = Clng(fields(4))
            Dim tc       : tc = Clng(fields(5))
            Set fields = nothing

            ' Create new Items as required
            '
            If pname <> lastProjectName Then
                lastProjectName = pname
                Set proj = newDataSet(pname,dataSet )
            End If

            If rname <> lastReleaseName Then 
                Set rel = newDataSet(rname, proj)
                lastReleaseName = rname

                Set dataOk = newDataSet("BuildsCompleted", rel)
                dataOk("Count") = 0
                Set dataError = newDataSet("BuildsInError", rel)      
                dataError("Count") = 0
            End If

            '   Accumulate data
            '
            If state = "Complete" Then
                dataOk(reason)      = dataOk(reason) + rc 
                dataOk("Count")     = dataOk("Count") + rc 
                dataOk("UnitTests") = dataOk("UnitTests") + tc 
            Else
                dataError(reason)      = dataError(reason) + rc 
                dataError("Count")     = dataError("Count") + rc 
                dataError("UnitTests") = dataError("UnitTests") + tc 
            End If
            rsQry.MoveNext
        Wend
    End IF

    rsQry.Close
    Set rsQry = Nothing
    result = 0
End Sub


%>