OpenTTD-patches/projects/determineversion.vbs

Option Explicit

' $Id$
'
' This file is part of OpenTTD.
' OpenTTD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, version 2.
' OpenTTD is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
' See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with OpenTTD. If not, see <http://www.gnu.org/licenses/>.

Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")

Sub FindReplaceInFile(filename, to_find, replacement)
	Dim file, data
	Set file = FSO.OpenTextFile(filename, 1, 0, 0)
	data = file.ReadAll
	file.Close
	data = Replace(data, to_find, replacement)
	Set file = FSO.CreateTextFile(filename, -1, 0)
	file.Write data
	file.Close
End Sub

Sub UpdateFile(modified, revision, version, cur_date, filename)
	FSO.CopyFile filename & ".in", filename
	FindReplaceInFile filename, "!!MODIFIED!!", modified
	FindReplaceInFile filename, "!!REVISION!!", revision
	FindReplaceInFile filename, "!!VERSION!!", version
	FindReplaceInFile filename, "!!DATE!!", cur_date
End Sub

Sub UpdateFiles(version)
	Dim modified, revision, cur_date
	cur_date = DatePart("D", Date) & "." & DatePart("M", Date) & "." & DatePart("YYYY", Date)

	If InStr(version, Chr(9)) Then
		revision = Mid(version, InStr(version, Chr(9)) + 1)
		modified = Mid(revision, InStr(revision, Chr(9)) + 1)
		revision = Mid(revision, 1, InStr(revision, Chr(9)) - 1)
		modified = Mid(modified, 1, InStr(modified, Chr(9)) - 1)
		version  = Mid(version, 1, InStr(version, Chr(9)) - 1)
	Else
		revision = 0
		modified = 1
	End If

	UpdateFile modified, revision, version, cur_date, "../src/rev.cpp"
	UpdateFile modified, revision, version, cur_date, "../src/os/windows/ottdres.rc"
End Sub

Function ReadRegistryKey(shive, subkey, valuename, architecture)
	Dim hiveKey, objCtx, objLocator, objServices, objReg, Inparams, Outparams

	' First, get the Registry Provider for the requested architecture
	Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
	objCtx.Add "__ProviderArchitecture", architecture ' Must be 64 of 32
	Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
	Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx)
	Set objReg = objServices.Get("StdRegProv")

	' Check the hive and give it the right value
	Select Case shive
		Case "HKCR", "HKEY_CLASSES_ROOT"
			hiveKey = &h80000000
		Case "HKCU", "HKEY_CURRENT_USER"
			hiveKey = &H80000001
		Case "HKLM", "HKEY_LOCAL_MACHINE"
			hiveKey = &h80000002
		Case "HKU", "HKEY_USERS"
			hiveKey = &h80000003
		Case "HKCC", "HKEY_CURRENT_CONFIG"
			hiveKey = &h80000005
		Case "HKDD", "HKEY_DYN_DATA" ' Only valid for Windows 95/98
			hiveKey = &h80000006
		Case Else
			MsgBox "Hive not valid (ReadRegistryKey)"
	End Select

	Set Inparams = objReg.Methods_("GetStringValue").Inparameters
	Inparams.Hdefkey = hiveKey
	Inparams.Ssubkeyname = subkey
	Inparams.Svaluename = valuename
	Set Outparams = objReg.ExecMethod_("GetStringValue", Inparams,,objCtx)

	ReadRegistryKey = Outparams.SValue
End Function

Function DetermineSVNVersion()
	Dim WshShell, version, branch, modified, revision, clean_rev, url, oExec, line, hash
	Set WshShell = CreateObject("WScript.Shell")
	On Error Resume Next

	revision = 0

	' Try TortoiseSVN
	' Get the directory where TortoiseSVN (should) reside(s)
	Dim sTortoise
	' First, try with 32-bit architecture
	sTortoise = ReadRegistryKey("HKLM", "SOFTWARE\TortoiseSVN", "Directory", 32)
	If sTortoise = "" Or IsNull(sTortoise) Then
		' No 32-bit version of TortoiseSVN installed, try 64-bit version (doesn't hurt on 32-bit machines, it returns nothing or is ignored)
		sTortoise = ReadRegistryKey("HKLM", "SOFTWARE\TortoiseSVN", "Directory", 64)
	End If

	' If TortoiseSVN is installed, try to get the revision number
	If sTortoise <> "" Then
		Dim SubWCRev
		Set SubWCRev = WScript.CreateObject("SubWCRev.object")
		SubWCRev.GetWCInfo FSO.GetAbsolutePathName("../"), 0, 0
		revision = SubWCRev.Revision
		version = "r" & revision
		modified = 0
		if SubWCRev.HasModifications then modified = 2
		url = SubWCRev.Url
	End If

	' Looks like there is no TortoiseSVN installed either. Then we don't know it.
	If revision = 0 Then
		' Reset error and version
		Err.Clear
		version = "norev000"
		modified = 0

		' Set the environment to english
		WshShell.Environment("PROCESS")("LANG") = "en"

		' Do we have subversion installed? Check immediatelly whether we've got a modified WC.
		Set oExec = WshShell.Exec("svnversion ../")
		If Err.Number = 0 Then
			' Wait till the application is finished ...
			Do While oExec.Status = 0
			Loop

			line = OExec.StdOut.ReadLine()
			If line <> "exported" Then
				If InStr(line, "M") Then
					modified = 2
				End If

				' And use svn info to get the correct revision and branch information.
				Set oExec = WshShell.Exec("svn info ../")
				If Err.Number = 0 Then
					Do
						line = OExec.StdOut.ReadLine()
						If InStr(line, "URL") Then
							url = line
						End If
						If InStr(line, "Last Changed Rev") Then
							revision = Mid(line, 19)
							version = "r" & revision
						End If
					Loop While Not OExec.StdOut.atEndOfStream
				End If ' Err.Number = 0
			End If ' line <> "exported"
		End If ' Err.Number = 0
	End If ' InStr(version, "$")

	If version <> "norev000" Then
		If InStr(url, "branches") Then
			branch = Mid(url, InStr(url, "branches/") + 9)
		End If
		If InStr(url, "tags") Then
			version = Mid(url, InStr(url, "tags/") + 5)
		End If
	Else ' version <> "norev000"
		' svn detection failed, reset error and try git
		Err.Clear
		Set oExec = WshShell.Exec("git rev-parse --verify HEAD")
		If Err.Number = 0 Then
			' Wait till the application is finished ...
			Do While oExec.Status = 0
			Loop

			If oExec.ExitCode = 0 Then
				hash = oExec.StdOut.ReadLine()
				version = "g" & Mid(hash, 1, 8)
				' Make sure index is in sync with disk
				Set oExec = WshShell.Exec("git update-index --refresh")
				If Err.Number = 0 Then
					' StdOut and StdErr share a 4kB buffer so prevent it from filling up as we don't care about the output
					oExec.StdOut.Close
					oExec.StdErr.Close
					' Wait till the application is finished ...
					Do While oExec.Status = 0
						WScript.Sleep 10
					Loop
				End If
				Set oExec = WshShell.Exec("git diff-index --exit-code --quiet HEAD ../")
				If Err.Number = 0 Then
					' Wait till the application is finished ...
					Do While oExec.Status = 0
					Loop

					If oExec.ExitCode = 1 Then
						modified = 2
					End If ' oExec.ExitCode = 1

					Set oExec = WshShell.Exec("git symbolic-ref HEAD")
					If Err.Number = 0 Then
						line = oExec.StdOut.ReadLine()
						line = Mid(line, InStrRev(line, "/") + 1)
						If line <> "master" Then
							branch = line
						End If ' line <> "master"
					End If ' Err.Number = 0

					Set oExec = WshShell.Exec("git log --pretty=format:%s --grep=" & Chr(34) & "^(svn r[0-9]*)" & Chr(34) & " -1")
					if Err.Number = 0 Then
						revision = Mid(oExec.StdOut.ReadLine(), 7)
						revision = Mid(revision, 1, InStr(revision, ")") - 1)
					End If ' Err.Number = 0
					If revision = "" Then
						' No revision? Maybe it is a custom git-svn clone
						' Reset error number as WshShell.Exec will not do that on success
						Err.Clear
						Set oExec = WshShell.Exec("git log --pretty=format:%b --grep=" & Chr(34) & "git-svn-id:.*@[0-9]*" & Chr(34) & " -1")
						If Err.Number = 0 Then
							revision = oExec.StdOut.ReadLine()
							revision = Mid(revision, InStr(revision, "@") + 1)
							revision = Mid(revision, 1, InStr(revision, " ") - 1)
						End If ' Err.Number = 0
					End If ' revision = ""

					' Check if a tag is currently checked out
					Err.Clear
					Set oExec = WshShell.Exec("git name-rev --name-only --tags --no-undefined HEAD")
					If Err.Number = 0 Then
						' Wait till the application is finished ...
						Do While oExec.Status = 0
						Loop
						If oExec.ExitCode = 0 Then
							version = oExec.StdOut.ReadLine()
							If Right(version, 2) = "^0" Then
								version = Left(version, Len(version) - 2)
							End If
							branch = ""
						End If ' oExec.ExitCode = 0
					End If ' Err.Number = 0
				End If ' Err.Number = 0
			End If ' oExec.ExitCode = 0
		End If ' Err.Number = 0

		If version = "norev000" Then
			' git detection failed, reset error and try mercurial (hg)
			Err.Clear
			Set oExec = WshShell.Exec("hg id -i")
			If Err.Number = 0 Then
				' Wait till the application is finished ...
				Do While oExec.Status = 0
				Loop

				If oExec.ExitCode = 0 Then
					line = OExec.StdOut.ReadLine()
					hash = Left(line, 12)
					version = "h" & Mid(hash, 1, 8)

					' Check if a tag is currently checked out
					Err.Clear
					Set oExec = WshShell.Exec("hg id -t")
					If Err.Number = 0 Then
						line = oExec.StdOut.ReadLine()
						If Len(line) > 0 And Right(line, 3) <> "tip" Then
							version = line
							branch = ""
						End If ' Len(line) > 0 And Right(line, 3) <> "tip"
					End If ' Err.Number = 0

					Err.Clear
					Set oExec = WshShell.Exec("hg status ../")
					If Err.Number = 0 Then
						Do
							line = OExec.StdOut.ReadLine()
							If Len(line) > 0 And Mid(line, 1, 1) <> "?" Then
								modified = 2
								Exit Do
							End If ' Len(line) > 0 And Mid(line, 1, 1) <> "?"
						Loop While Not OExec.StdOut.atEndOfStream

						Set oExec = WshShell.Exec("hg branch")
						If Err.Number = 0 Then
							line = OExec.StdOut.ReadLine()
							If line <> "default" Then
								branch = line
							End If ' line <> "default"
						End If ' Err.Number = 0

						Set oExec = WshShell.Exec("hg log -f -k " & Chr(34) & "(svn r" & Chr(34) & " -l 1 --template " & Chr(34) & "{desc|firstline}\n" & Chr(34) & " --cwd ../")
						If Err.Number = 0 Then
							line = oExec.StdOut.ReadLine()
							If Left(line, 6) = "(svn r" Then
								revision = Mid(line, 7)
								revision = Mid(revision, 1, InStr(revision, ")") - 1)
							End If 'Left(line, 6) = "(svn r"
						End If ' Err.Number = 0

						If revision = "" Then
							' No rev? Maybe it is a custom hgsubversion clone
							Err.Clear
							Set oExec = WshShell.Exec("hg parent --template=" & Chr(34) & "{svnrev}" & Chr(34))
							If Err.Number = 0 Then
								revision = oExec.StdOut.ReadLine()
							End If ' Err.Number = 0
						End If ' revision = ""
					End If ' Err.Number = 0
				End If ' oExec.ExitCode = 0
			End If ' Err.Number = 0
		End If ' version = "norev000"
	End If ' version <> "norev000"

	If version = "norev000" And FSO.FileExists("../.ottdrev") Then
		Dim rev_file
		Set rev_file = FSO.OpenTextFile("../.ottdrev", 1, True, 0)
		DetermineSVNVersion = rev_file.ReadLine()
		rev_file.Close()
	Else
		If modified = 2 Then
			version = version & "M"
		End If

		clean_rev = version
		If branch <> "" Then
			version = version & "-" & branch
		End If

		If version <> "norev000" Then
			DetermineSVNVersion = version & Chr(9) & revision & Chr(9) & modified & Chr(9) & clean_rev
		Else
			DetermineSVNVersion = version
		End If
	End If
End Function

Function IsCachedVersion(ByVal version)
	Dim cache_file, cached_version
	cached_version = ""
	Set cache_file = FSO.OpenTextFile("../config.cache.version", 1, True, 0)
	If Not cache_file.atEndOfStream Then
		cached_version = cache_file.ReadLine()
	End If
	cache_file.Close

	If InStr(version, Chr(9)) Then
		version = Mid(version, 1, Instr(version, Chr(9)) - 1)
	End If

	If version <> cached_version Then
		Set cache_file = fso.CreateTextFile("../config.cache.version", True)
		cache_file.WriteLine(version)
		cache_file.Close
		IsCachedVersion = False
	Else
		IsCachedVersion = True
	End If
End Function

Function CheckFile(filename)
	CheckFile = FSO.FileExists(filename)
	If CheckFile Then CheckFile = (FSO.GetFile(filename).DateLastModified >= FSO.GetFile(filename & ".in").DateLastModified)
End Function

Dim version
version = DetermineSVNVersion
If Not (IsCachedVersion(version) And CheckFile("../src/rev.cpp") And CheckFile("../src/os/windows/ottdres.rc")) Then
	UpdateFiles version
End If