Subversion Repositories DevTools

Option Explicit
'=====================================================
'        Name:   common_subs.vbs
' Description:   Contains list of common subs and functions
'=====================================================
'-----------------------------------------------------------------------------------------------------------------
' NOTE: This is NOT USED
' It is here only to satisfy Application variable in asp which VBS don't know about
'
' Within IIS these data items are provide by global.asa, which is in the root
' of the IIS server.
'
Function Application( sParam )
   If sParam = "TNS_NAME" Then
      Application = ""
   ElseIf sParam = "RELEASE_MANAGER_LOGIN" Then
      Application = ""
   End If
End Function
'-----------------------------------------------------------------------------------------------------------------
Function ReadFile( SSpath )
   Dim filesys, rfile
   Set filesys = CreateObject("Scripting.FileSystemObject")

   On Error Resume Next
   If filesys.FileExists ( SSpath ) Then
       Set rfile = filesys.OpenTextFile( SSpath, 1, false)
       ReadFile = rfile.ReadAll
       rfile.close
    Else
        Call Raise_Event ( enumEVENT_ERROR, "[sub:ReadFile]", _
                           "File: "& SSpath, _
                           "File not found!", enum_RELEASE_NOTES_FAILED )
    End If

   Call ErrorCheck ( "[sub:ReadFile]", NULL )

   Set filesys = nothing
End Function
'-----------------------------------------------------------------------------------------------------------------
Sub SaveFile( SSpath, SSfilename, SScontent )
   Dim filesys, filetxt
   Set filesys = CreateObject("Scripting.FileSystemObject")
   WScript.Echo "Saving file "& SSpath &"\"& SSfilename &" ..."

   On Error Resume Next
   Set filetxt = filesys.CreateTextFile( SSpath &"\"& SSfilename, True )
   filetxt.WriteLine(SScontent)
   filetxt.Close

   Call ErrorCheck ( "[sub:SaveFile]", NULL )

   WScript.Echo "File Saved: "& SSpath &"\"& SSfilename
   Set filetxt = nothing
   Set filesys = nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub DeleteFile( SSpath )
   Dim filesys
   Set filesys = CreateObject("Scripting.FileSystemObject")
   If filesys.FileExists(SSpath) Then
      filesys.DeleteFile SSpath
   End If
   Set filesys = nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub DeleteFolder( SSpath )
   Dim  filesys
   Set filesys = CreateObject ("Scripting.FileSystemObject")
   If filesys.FolderExists( SSpath ) Then
      filesys.DeleteFolder SSpath, TRUE
   End If
End Sub
'-----------------------------------------------------------------------------------------------------------------
Function Folder_Is_Empty ( sPath )
   Dim filesys, oFolder
   Set filesys = CreateObject("Scripting.FileSystemObject")

   If filesys.FolderExists( sPath ) Then
      Set oFolder = filesys.GetFolder( sPath )
      If ( oFolder.Files.Count + oFolder.SubFolders.Count ) > 0 Then
         Folder_Is_Empty = FALSE
      Else
         Folder_Is_Empty = TRUE
      End If
   Else
      Folder_Is_Empty = TRUE
   End If

End Function
'-----------------------------------------------------------------------------------------------------------------
Function NVL ( SSvalue )
   If IsNull(SSvalue) Or SSvalue = "" Then
      NVL = " "
   Else
      NVL = SSvalue
   End If
End Function
'-----------------------------------------------------------------------------------------------------------------
Function Format_FileName( sPkg_name, sPkg_version, nPv_id )
   Dim name, version
   name =  Replace( sPkg_name, " ", "_")
   version = Replace( sPkg_version, " ", "")
   version = Replace( version, ".", "_")

   Format_FileName = RELESE_NOTES_PERFIX &"_"& nPv_id &"_"& name &"_"& version &".html"
End Function
'-----------------------------------------------------------------------------------------------------------------
Function Get_Application_Path ()
   Dim tempSTR
   tempSTR = WScript.ScriptFullName

   Get_Application_Path = Left( tempSTR, InStrRev( tempSTR, "\", InStrRev( tempSTR, "\" ) -1 ) )
End Function
'-----------------------------------------------------------------------------------------------------------------
Sub Include_File ( SSFile )
   Dim myInclude
   myInclude = ReadFile( SSFile )
   myInclude = Replace ( myInclude, "<%", "" )      ' Remove ASP tags
   myInclude = Replace ( myInclude, "%>", "" )      ' Remove ASP tags
   Execute( myInclude )
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub CRC_cksum ( SSfile_name, outCRC, outSize )
   Dim sysShell, crcDump, oExec, outStdErr, outStrOut, crcARR
   Set sysShell = WScript.CreateObject("WScript.Shell")


   Set oExec = sysShell.Exec( AppPath & CKSUM_EXE &" """& SSfile_name &"""" )

   outStdErr = oExec.StdErr.ReadLine
   outStrOut = oExec.StdOut.ReadLine

   If outStdErr = "" Then
      crcDump = Trim( outStrOut )
      crcDump = Replace ( crcDump, VBNewLine, "" )      ' Remove newline characters
      While InStr( crcDump, "  ") > 0
         crcDump = Replace ( crcDump, "  ", " " )      ' Ensure single space between items
      Wend

      crcARR = Split ( crcDump, " " )    ' Split with space
      outCRC = crcARR(0)
      outSize = crcARR(1)
   Else
      outCRC = -1      ' Error occuerd during cksum. Can be no read permissions
      outSize = -1
   End If

   Set sysShell = nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub CRC_modcrc ( SSfile_name, SSfile_path, outCRC, outSize )
   Dim sysShell, crcDump, oExec, outStdErr, outStrOut, crcARR
   Set sysShell = WScript.CreateObject("WScript.Shell")

   Set oExec = sysShell.Exec( AppPath & MODCRC_EXE &" -m="& SSfile_path & SSfile_name &" -i=thx" )

   outStdErr = oExec.StdErr.ReadLine
   outStrOut = oExec.StdOut.ReadLine

   If outStdErr = "" Then
      crcDump = Trim( outStrOut )
      crcDump = Replace ( crcDump, VBNewLine, "" )      ' Remove newline characters
      While InStr( crcDump, "  ") > 0
         crcDump = Replace ( crcDump, "  ", " " )      ' Ensure single space between items
      Wend

      crcARR = Split ( crcDump, " " )    ' Split with space
      outCRC = crcARR(4)
      outSize = crcARR(6)
   Else
      outCRC = -1      ' Error occuerd during cksum. Can be no read permissions
      outSize = -1
   End If

   Set sysShell = nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub Raise_Event ( eventType, SSlocation, SSvalues, SSerror_message, sDBmsg )
   Dim WshShell, WshNetwork, objArgs, i, agrSTR, SSmsg
   Set WshShell = WScript.CreateObject("WScript.Shell")
   Set WshNetwork = WScript.CreateObject("WScript.Network")

   Set objArgs = WScript.Arguments
   For i = 0 to objArgs.Count - 1
      agrSTR = agrSTR & objArgs(i) & VBNewLine
   Next

   ' Compose Message
   SSmsg = _
   "-- Script Info  --"& VBNewLine &_
   "Host Name: "& WshNetwork.ComputerName & VBNewLine &_
   "Script Name: "& WScript.ScriptName & VBNewLine & VBNewLine &_
   "-- Script Parameters --"& VBNewLine &_
   agrSTR &_
   VBNewLine &_
   "-- Error Location --"& VBNewLine &_
   SSlocation & VBNewLine &_
   VBNewLine &_
   "-- Values --"& VBNewLine &_
   SSvalues & VBNewLine &_
   VBNewLine &_
   "-- Error Message --"& VBNewLine &_
   SSerror_message & VBNewLine

   '-- Raise this message at these places...
   Wscript.Echo SSmsg
   WshShell.LogEvent eventType, SSmsg
   'Call Alert_Admin ( SSmsg )
   '----------------------------------------

   Set WshShell = Nothing

   If Not IsNull(sDBmsg) Then Call Write_To_Release_Notes_Info ( parPv_id, sDBmsg )
   If eventType = enumEVENT_ERROR Then WScript.Quit    ' Only Quit if ERROR

End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub ErrorCheck ( ERRlocation, ERRvals )
   If Err.Number <> 0 Then
      Call Raise_Event ( enumEVENT_ERROR, ERRlocation, ERRvals, Err.Source &" "& Err.Description, enum_RELEASE_NOTES_FAILED  )
   End If
   Err.Clear
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub Alert_Admin ( SSmsg )
   'Call Send_Email ( adminEmail, adminEmail, "Windows Script Alert!", SSmsg )
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub Send_Email ( SSfrom, SSto, SSsubject, SSbody )
   'Dim objCDOMail
   'Set objCDOMail = CreateObject("CDONTS.NewMail")
   ''objCDOMail.From = Request.Form("firstName") & " " & Request.Form("lastName") & " <" & strReturnEmailAddress & ">"
   'objCDOMail.From = SSfrom
   'objCDOMail.To = SSto
   ''objCDOMail.Cc = strCCEmailAddress
   ''objCDOMail.Bcc = strBCCEmailAddress
   'objCDOMail.Subject = SSsubject
   'objCDOMail.BodyFormat = 1             ' 0 = HTML, 1 = Plain
   'objCDOMail.MailFormat = 1             ' 0 = MIME, 1 = Text
   'objCDOMail.Importance = 0             ' 0 = High, 1 = Medium, 2 = Low
   ''objCDOMail.attachFile ("c:\images\mypicture.gif") ' you can also attach files
   'objCDOMail.Body = SSbody
   ''objCDOMail.Send
   'Set objCDOMail = Nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub Get_PV_ID ( SSpkg_name, SSpkg_version, outPV_ID)
   Dim Query_String, rsTemp

   If outPV_ID <> "" Then Exit Sub      ' PV_ID already assigned

   Query_String = _
   " SELECT pv.pv_id"&_
   "   FROM packages pkg,"&_
   "        package_versions pv"&_
   "  WHERE pv.pkg_id = pkg.pkg_id"&_
   "    AND pkg.pkg_name = '"& SSpkg_name &"'"&_
   "    AND pv.pkg_version = '"& SSpkg_version &"'"
   Set rsTemp = OraDatabase.CreateDynaset( Query_String, cint(0))

   If ((NOT rsTemp.BOF) AND (NOT rsTemp.EOF)) Then
      outPV_ID = rsTemp("pv_id")
   Else
      Call Raise_Event ( enumEVENT_ERROR, "[sub:Get_PV_ID]", _
                         "pkg_name: "& SSpkg_name & VBNewLine &_
                         "pkg_version: "& SSpkg_version , _
                         "pkg_name and/or pkg_version not found in Release Manager database!", enum_RELEASE_NOTES_FAILED )
   End If
   rsTemp.Close
   Set rsTemp = Nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Function Get_Package_Type ( NNpv_id )
   Dim Query_String, rsTemp

   Query_String = ReadFile( AppPath & QUERIES_FOLDER & "\package_type.sql" )
   OraDatabase.Parameters.Add "PV_ID", NNpv_id, ORAPARM_INPUT, ORATYPE_NUMBER
   OraDatabase.Parameters.Add "enumBASE_VIEW_PRODUCTS", enumBASE_VIEW_PRODUCTS, ORAPARM_INPUT, ORATYPE_NUMBER
   Set rsTemp = OraDatabase.CreateDynaset( Query_String, cint(0))

   If ((NOT rsTemp.BOF) AND (NOT rsTemp.EOF)) Then
      If Not IsNull( rsTemp("message") ) Then
         Get_Package_Type = Eval(rsTemp("message"))
      Else
         Get_Package_Type = enumPKG_TYPE_GENERIC_DPKG
      End If
   Else
      Get_Package_Type = enumPKG_TYPE_GENERIC_DPKG
   End If

   WScript.Echo "Package Type : "& Get_Package_Type

   OraDatabase.Parameters.Remove "PV_ID"
   OraDatabase.Parameters.Remove "enumBASE_VIEW_PRODUCTS"
   rsTemp.Close
   Set rsTemp = Nothing
End Function
'-----------------------------------------------------------------------------------------------------------------
Sub Get_Pkg_Name_Version ( NNpv_id, outPkg_name, outPkg_version )
   Dim Query_String, rsTemp

   Query_String = _
   " SELECT pkg.pkg_name, pv.pkg_version"&_
   "   FROM packages pkg,"&_
   "        package_versions pv"&_
   "  WHERE pv.pkg_id = pkg.pkg_id"&_
   "    AND pv.pv_id = "& NNpv_id
   Set rsTemp = OraDatabase.CreateDynaset( Query_String, cint(0))

   If ((NOT rsTemp.BOF) AND (NOT rsTemp.EOF)) Then
      outPkg_name = rsTemp("pkg_name")
      outPkg_version = rsTemp("pkg_version")
   Else
      Call Raise_Event ( enumEVENT_ERROR, "[sub:Get_Pkg_Name_Version]", _
                         "PV_ID: "& NNpv_id , _
                         "PV_ID not found in Release Manager database!", enum_RELEASE_NOTES_FAILED )
   End If

   rsTemp.Close
   Set rsTemp = Nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub Check_Requirements_To_Proceed ( nPv_id )
   Dim Query_String, rsPackageVersions, rsRunLevel, rsReleaseConfig, rsReleaseTags

   ' Exit if Release Notyes Generation is forced
   If objArgs.Named.Item("f") <> "" Then Exit Sub

   Query_String = _
   " SELECT pv.release_notes_info, pv.pkg_id"&_
   " FROM package_versions pv"&_
   " WHERE pv.pv_id = "& nPv_id

   Set rsPackageVersions = OraDatabase.CreateDynaset( Query_String, cint(0))

   If rsPackageVersions("release_notes_info") <> enum_RELEASE_NOTES_GENERATING Then
      WScript.Echo "Exiting this job. release_notes_info in [PACKAGE_VERSIONS] table is ("& rsPackageVersions("release_notes_info") &")"
      WScript.Echo "Expected value is ("& enum_RELEASE_NOTES_GENERATING &")"
      Call Raise_Event ( enumEVENT_ERROR, "[sub:Check_Requirements_To_Proceed]", _
                         "PV_ID: "& nPv_id , _
                         "Exiting this job. release_notes_info in [PACKAGE_VERSIONS] table is ("& rsPackageVersions("release_notes_info") &")", NULL )
   End If

   ' Do not proceed if the build daemon is building a version of the package. This is an attempt to make sure that
   ' release notes generation does not cause a problem for the build daemons, such as might be the case if and when
   ' it manipulates file ownership later on, etc (see DEVI-48682). This is not a foolproof method to prevent the problem,
   ' but it should reduce the likelyhood of it occuring
   Dim mustAbort
   mustAbort = FALSE

   Query_String = _
   " SELECT * "&_
   "   FROM run_level rl"&_
   "  WHERE rl.current_pkg_id_being_built = "& rsPackageVersions("pkg_id")

   Set rsRunLevel = OraDatabase.CreateDynaset( Query_String, cint(0))

   'For each run_level table entry...
   Do While (NOT rsRunLevel.BOF) AND (NOT rsRunLevel.EOF) AND (mustAbort = FALSE)

      ' Make sure that the release configuration shows that there is a daemon hostname associated with this
      ' run_level table entry.
      Query_String = _
      " SELECT rtag_id, daemon_hostname"&_
      "   FROM release_config"&_
      "  WHERE rcon_id = "& rsRunLevel("rcon_id")

      Set rsReleaseConfig = OraDatabase.CreateDynaset( Query_String, cint(0))
      If (rsReleaseConfig.RecordCount > 0) AND NOT IsNull(rsReleaseConfig("daemon_hostname")) Then
         ' ought to check the validity of the daemon hostname - will have to wait for these to be configured metadata
         ' before we can do that though, unless we hard-code the valid names here somewhere.
         ' Anyway, the hostname is not null so it looks like the run_level entry is one we cannot dis-regard

         ' if the run level is ACTIVE (3) then abort
         If rsRunLevel("current_run_level") = 3 Then
            mustAbort = TRUE
         Else
            ' run level must be WAITING, PAUSED, etc, so examine the official state of the release to see if
            ' it is still open in some way
            Query_String = _
            " SELECT official"&_
            "   FROM release_tags"&_
            "  WHERE rtag_id = "& rsReleaseConfig("rtag_id")

            Set rsReleaseTags = OraDatabase.CreateDynaset( Query_String, cint(0))
            If (rsReleaseTags.RecordCount > 0) Then
               ' If release is not closed or archived
               If NOT (IsNull(rsReleaseTags("official")) OR (rsReleaseTags("official") = "Y") OR (rsReleaseTags("official") = "A")) Then
                  ' release is still open (OPEN or RESTRICTED, or CCB Mode) so abort
                  mustAbort = TRUE
               End If
            End If
            rsReleaseTags.Close
            Set rsReleaseTags = Nothing
         End If
      End If

      rsReleaseConfig.Close
      Set rsReleaseConfig = Nothing

      rsRunLevel.MoveNext
   Loop

   If (mustAbort) Then
      WScript.Echo "Exiting this job. Build Daemon is currently building this/another version of this package."
      WScript.Echo "Try again later."
      Call Raise_Event ( enumEVENT_ERROR, "[sub:Check_Requirements_To_Proceed]", _
                         "PV_ID: "& nPv_id & VBNewLine & "PKG_ID: "& rsPackageVersions("pkg_id"), _
                         "Exiting this job. Build Daemon is currently building this/another version of this package.", NULL )
   End If

   rsRunLevel.Close
   Set rsRunLevel = Nothing

   rsPackageVersions.Close
   Set rsPackageVersions = Nothing

End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub Write_To_Release_Notes_Info ( nPv_id, sMsg )
    WScript.Echo "Writing message to release_notes_info in [PACKAGE_VERSIONS] table."
    OraSession.BeginTrans

    If IsNULL(sMsg) Then
      WScript.Echo "NULL"
      OraDatabase.ExecuteSQL " UPDATE package_versions "&_
                          "    SET release_notes_info = NULL"&_
                          "  WHERE pv_id = "& nPv_id
    Else
      WScript.Echo sMsg
      OraDatabase.ExecuteSQL " UPDATE package_versions "&_
                          "    SET release_notes_info = '"& sMsg &"'"&_
                          "  WHERE pv_id = "& nPv_id
    End If
    OraSession.CommitTrans
End Sub
'-----------------------------------------------------------------------------------------------------------------
Function FormatTextBox ( SSstr )
   If SSstr <> "" Or NOT IsNull(SSstr) Then
      FormatTextBox = Replace ( SSstr, VBNewLine, "<br>")
   End If
End Function
'-----------------------------------------------------------------------------------------------------------------
Function HTML_Encode ( sSTR )
    Dim tempSTR
    tempSTR = sSTR
    If IsNull( tempSTR ) Or tempSTR = "" Then
        HTML_Encode = ""
    Else
        tempSTR = Replace ( tempSTR, "&", "&amp;" )
        tempSTR = Replace ( tempSTR, "<", "&lt;" )
        tempSTR = Replace ( tempSTR, ">", "&gt;" )
        HTML_Encode = tempSTR
    End If
End Function
'-----------------------------------------------------------------------------------------------------------------------------
Function EuroDate ( dDate )
   ' Ensures Euro Date format DD/MM/YYYY
   If IsNull(dDate) Then Exit Function
   EuroDate = Day(dDate) &"/"& Month(dDate) &"/"& Year(dDate)
End Function
'-----------------------------------------------------------------------------------------------------------------------------
Function EuroDateTime ( dDate )
   ' Ensures Euro DateTime format DD/MM/YYYY H24:MIN:SS
   If IsNull(dDate) Then Exit Function
   EuroDateTime = Day(dDate) &"/"& Month(dDate) &"/"& Year(dDate) &" "& FormatDateTime( dDate, 4 )
End Function

'-----------------------------------------------------------------------------------------------------------------
Sub Get_Release_Info (APV_ID, ByRef ARTAG_ID, ByRef APKG_ID)
   Dim Query_String, rsTemp

   Query_String = _
   " SELECT rc.rtag_id, pv.pkg_id"&_
   " FROM package_versions pv, release_content rc"&_
   " WHERE rc.pv_id = " & APV_ID &_
   " AND pv.pv_id = rc.pv_id"

   Set rsTemp = OraDatabase.CreateDynaset( Query_String, cint(0))

   If ((NOT rsTemp.BOF) AND (NOT rsTemp.EOF)) Then
      ARTAG_ID = rsTemp("rtag_id")
      APKG_ID = rsTemp("pkg_id")
   Else
      Call Raise_Event ( enumEVENT_ERROR, "[sub:Get_Release_Info]", _
                         "PV_ID: "& APV_ID & VBNewLine ,_
                         "pv_id not found in release_content table!", enum_RELEASE_NOTES_FAILED )
   End If
   rsTemp.Close
   Set rsTemp = Nothing
End Sub