<%@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" %> <% '------------ 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 "" & vbCrLf Response.Write "" & vbCrLf Response.Write "
release_stats_rest.asp is designed to be used by automation scripts" & vbCrLf Response.Write "
It will accept the following parameters" & vbCrLf Response.Write "
rtag_id=nnn - Specify Release to Process (mandatory)" & vbCrLf Response.Write "
ignore=0|1 - Ignore COTS and TOOL packages. Ignore packages provided by an SDK (default ignore)" & vbCrLf Response.Write "
group=0|1 - Output All or by Base View (default by Base View)" & vbCrLf Response.Write "
summary=0|1 - Display summary only (default ALL)" & vbCrLf Response.Write "
json=0|1 - Display CSV or JSON (default json)" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & 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 %>