Subversion Repositories DevTools

Rev

Blame | Last modification | View Log | RSS feed 

<%@LANGUAGE="VBSCRIPT"%>
<%
'=====================================================
'   release_stats_rest.asp
'
'   REST API(ish) interfaceo to extract Release Stats from Release Manager
'   This page will return JSON output
'
'   Parameters
'   rtag_id=nnn         - Release Tag
'   ignore=n            - 0 ignore none, else ignore COTS, SDK (default=1)
'   group=n             - 0 no group, 1 group (default 1)
'   summary=n           - 0 All data, 1 just summary (default 0)
'   json=n              - 0 CSV, 1JSON (default CSV)
'
'   The output is pure JSON
'   There are two sections
'   info : {}       - Internal data about the process
'   data : {}       - Build and Test results
'=====================================================
%>
<%
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

Dim parRtagId
Dim parIgnore
Dim parGroup
Dim parSummary
Dim parJson

' 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)

'
' Global Data
'
Dim projName
Dim relName
Dim sDateTime
Dim dataSet

' Constants
'   Names of the Fields
'
Const fDate = "Date"
Const fRtagId = "RtagId"
Const fPname ="Project Name"
Const fRname = "Release Name"
Const fGroup = "Group"
Const fTPkgs = "Total Packages"
Const fTTested = "Packages with Tests"
Const fTTests = "Total Unit Tests"
Const fTLoc = "Total Lines of Code"
Const fpkg = "Package"
Const fTests = "Tests"
Const fLoc = "LoC"

'
'   Get parameters
parRtagId = RequestDefault("rtag_id", 0)
parIgnore = RequestDefault("ignore", 1)
parGroup = RequestDefault("group", 1)
parSummary = RequestDefault("summary",0)
parJson = RequestDefault("json",0)


'
'   Attempt to be helpful
'
If parRtagId = 0 Then
    Response.Write "<html>" & vbCrLf
    Response.Write "<body>" & vbCrLf
    Response.Write "<br>release_stats_rest.asp is designed to be used by automation scripts" & vbCrLf
    Response.Write "<br>It will accept the following parameters" & vbCrLf
    Response.Write "<br>rtag_id=nnn     - Specify Release to Process (mandatory)" & vbCrLf
    Response.Write "<br>ignore=0|1      - Ignore COTS and TOOL packages. Ignore packages provided by an SDK (default ignore)" & vbCrLf
    Response.Write "<br>group=0|1       - Output All or by Base View (default by Base View)" & vbCrLf
    Response.Write "<br>summary=0|1     - Display summary only (default ALL)" & vbCrLf
    Response.Write "<br>json=0|1        - Display CSV or JSON (default json)" & vbCrLf
    Response.Write "" & vbCrLf
    Response.Write "</body>" & vbCrLf
    Response.Write "</html>" & vbCrLf
    Response.End
End If



'
'   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
If parJson = 0 Then
    Call DumpAsCsv
Else
    Response.Write oJSON.JSONoutput()
End If

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

'--------------------------------------------------------------------------------
'
'   Create or re-use structure to handle a given BaseView
'   
Function getGroupHeader( dataSet, sBaseView)
        If NOT dataSet.Exists(sBaseView) Then
            Dim vset
            Set vset =  newDataSet(sBaseView,dataSet )

            vset(fDate) = sDateTime
            vset(fRtagId) = parRtagId
            vset(fPname) = projName
            vset(fRname) = relName
            vset(fGroup) = sBaseView 
            vset(fTPkgs) = 0
            vset(fTLoc) = 0
            vset(fTTested) = 0
            vset(fTTests) = 0
       End If
       Set getGroupHeader = dataSet.Item(sBaseView)
End Function

'--------------------------------------------------------------------------------
'
'   Create or re-use structure to store detailed data for given basename
'   
Function getGroupData( dVset)
        If NOT dVset.Exists("DATA") Then
            Set getGroupData =  newDataSet("DATA",dVset )
       End If
       Set getGroupData = dVset.Item("DATA")
End Function
        
'------------------------------------------------------------------------------
'
'   Get Project Name and Release name for the rtag being processed
'
Sub getProjectReleaseName
    SqlQry = "select p.PROJ_NAME, rt.RTAG_NAME from RELEASE_TAGS rt, PROJECTS p WHERE rt.PROJ_ID = p.PROJ_ID and rt.RTAG_ID = :RTAG_ID"
    On Error Resume Next
    objEH.ErrorRedirect = FALSE
    objEH.TryORA ( OraSession )

    OraDatabase.Parameters.Add "RTAG_ID", parRtagId, ORAPARM_INPUT, ORATYPE_NUMBER
    Set rsQry = OraDatabase.DbCreateDynaset( SqlQry, ORADYN_DEFAULT )
        OraDatabase.Parameters.Remove "RTAG_ID"

    objEH.CatchORA ( OraSession )

    ' Process one Row
    If objEH.Finally Then
        On Error goto 0
        projName = rsQry("PROJ_NAME")
        relName = rsQry("RTAG_NAME")
    End If
End Sub

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

    If parRtagId <= 0 Then
        result = -2
        infoSet("error") = 1
        infoSet("emsgSummary") = "Invalid rtag_id"
        Exit Sub
    End If

    '   Setup common data
    '       Calc timestamp for data
    '       Get Project and Release Name
    '           Use globals to pass data
    Dim date : date = Now
    sDateTime = Year(date) & Right(String(2, "0") & Month(date), 2) & Right(String(2, "0") & Day(date), 2)
    Call getProjectReleaseName 

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

    On Error Resume Next
    objEH.ErrorRedirect = FALSE
    objEH.TryORA ( OraSession )

    OraDatabase.Parameters.Add "RTAG_ID", parRtagId, ORAPARM_INPUT, ORATYPE_NUMBER
    SqlQry =  GetQuery("release_stats.sql")
    Set rsQry = OraDatabase.DbCreateDynaset( SqlQry, ORADYN_DEFAULT )
        OraDatabase.Parameters.Remove "RTAG_ID"

    objEH.CatchORA ( OraSession )

    ' Process each row and return required fields to the user
    If objEH.Finally Then
    On Error goto 0

    Dim includeThis

    Do While (NOT rsQry.BOF) AND (NOT rsQry.EOF)
         includeThis = TRUE

        Dim pvId, buildId, buildTime, lastBuild, codeLines, isDeployable, viewName, isSdk, tcount, pVersion, pName, pExt

        pvId = rsQry("pv_id")
        tcount = NiceInt(rsQry("test_count"), 0)
        buildId = rsQry("build_id")
        buildTime = rsQry("build_time")
        If isNull(buildTime) Then buildTime = ""
        lastBuild = rsQry("lastBuild")
        If isNull(lastBuild) Then lastBuild = ""
        codeLines = NiceCLng(rsQry("code_lines"),0)
        If isNull(codeLines) Then codeLines = ""
        isDeployable = rsQry("is_deployable")
        If isNull(isDeployable) Then isDeployable = "N"
        viewName = rsQry("view_name")
        isSdk = rsQry("isSdk")
        pVersion = rsQry("pkg_version")
        pName = rsQry("pkg_name")
        pExt = rsQry("v_ext")

        ' Ignore some packages
        If parIgnore > 0 Then
            If isSdk = "Y" Then
                includeThis = FALSE
            End If
            Dim oRE, bMatch
            Set oRE = New RegExp
            oRE.IgnoreCase = True
            oRE.Pattern = ".cots$|.tool$"
            bMatch = oRE.Test(pVersion)
            If bMatch Then
                includeThis = FALSE
            End If
        End If

        ' Process active elements
        If includeThis Then

            If parGroup = 0 Then
                viewName = "ALL"
            End If

        ' Things for oJSON object
        '   obj(field) = data       (Will create a hash entry)
        '   newObj = oJSON.AddToCollection( obj ) (Will create an array)

        Dim dGroup : Set dGroup = getGroupHeader (dataSet, viewName)
        If parSummary = 0 Then
            Dim dData : Set dData = getGroupData(dGroup)
            Dim dEl :  Set dEl = oJSON.AddToCollection( dData )
            dEl(fpkg) = pName
            dEl(fTests) = tcount
            dEl(fLoc) = codeLines
        End If

        dGroup(fTPkgs) = dGroup(fTPkgs) + 1
        dGroup(fTLoc) = dGroup(fTLoc) + codeLines 
        If tcount > 0 Then
            dGroup(fTTested) = dGroup(fTTested) + 1
            dGroup(fTTests) = dGroup(fTTests) + tcount 
        End If

        End If
    rsQry.MoveNext
    Loop

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

Sub csvAdd( sName, sData, byRef sHdr, byRef sDtr)
    sHdr = sHdr & "," & sName
    sDtr = sDtr & "," & sData
End Sub
'--------------------------------------------------------------------------------
'
'   Dump the data in CSV format
Sub DumpAsCsv
    On Error goto 0
    dim gKeys : gKeys = dataSet.Keys
    Dim ii,jj,kk
    Dim mHdr
    Dim sFullData

    for ii=0 to dataSet.Count-1
        ' Process one Base View
        Dim hdr, dtr
        hdr = ""
        dtr = ""
        Dim dGroup : Set dGroup = dataSet.Item(gKeys(ii))
        Dim hList: hList = Array(fDate, fRtagId, fPname, fRname, fGroup, fTPkgs, fTTested, fTTests,fTLoc)
        For jj=0 to Ubound(hList)
            Call csvAdd(hList(jj), dGroup(hList(jj)), hdr, dtr)   
        Next

        If  dGroup.Exists("DATA")Then
            Dim dData : Set dData = dGroup("DATA")
            dim dKeys : dKeys = dData.Keys
            For kk=0 to Ubound(dKeys)
                Dim dEl : Set dEl = dData(dKeys(kk))
                Dim eList: eList = Array(fpkg, fTests, fLoc )
                For jj=0 to Ubound(eList)
                    Call csvAdd(eList(jj), dEl(eList(jj)), hdr, dtr)   
                Next
            Next
        End If

        hdr = Mid(hdr, 2, Len(hdr)-1)
        dtr = Mid(dtr, 2, Len(dtr)-1)

        If Len(hdr) > Len(mHdr) Then
            mHdr = hdr
        End If
        sFullData = sFullData & dtr & vbCrLf  
    next

    Response.Write mHdr & vbCrLf
    Response.Write sFullData & vbCrLf

End Sub
%>