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, "
") End If End Function '----------------------------------------------------------------------------------------------------------------- Function HTML_Encode ( sSTR ) Dim tempSTR tempSTR = sSTR If IsNull( tempSTR ) Or tempSTR = "" Then HTML_Encode = "" Else tempSTR = Replace ( tempSTR, "&", "&" ) tempSTR = Replace ( tempSTR, "<", "<" ) tempSTR = Replace ( tempSTR, ">", ">" ) 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