Move resolving of action 3 into ResolverObject constructor
[openttd/fttd.git] / projects / determineversion.vbs
blobe738569e3a3c7ecc59bc2c26175d08af6a017a48
1 Option Explicit
3 ' $Id$
5 ' This file is part of OpenTTD.
6 ' 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.
7 ' 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.
8 ' 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/>.
10 Dim FSO
11 Set FSO = CreateObject("Scripting.FileSystemObject")
13 Sub FindReplaceInFile(filename, to_find, replacement)
14 Dim file, data
15 Set file = FSO.OpenTextFile(filename, 1, 0, 0)
16 data = file.ReadAll
17 file.Close
18 data = Replace(data, to_find, replacement)
19 Set file = FSO.CreateTextFile(filename, -1, 0)
20 file.Write data
21 file.Close
22 End Sub
24 Sub UpdateFile(modified, revision, version, cur_date, filename)
25 FSO.CopyFile filename & ".in", filename
26 FindReplaceInFile filename, "!!MODIFIED!!", modified
27 FindReplaceInFile filename, "!!REVISION!!", revision
28 FindReplaceInFile filename, "!!VERSION!!", version
29 FindReplaceInFile filename, "!!DATE!!", cur_date
30 End Sub
32 Sub UpdateFiles(version)
33 Dim modified, revision, cur_date
34 cur_date = DatePart("D", Date) & "." & DatePart("M", Date) & "." & DatePart("YYYY", Date)
36 If InStr(version, Chr(9)) Then
37 revision = Mid(version, InStr(version, Chr(9)) + 1)
38 modified = Mid(revision, InStr(revision, Chr(9)) + 1)
39 revision = Mid(revision, 1, InStr(revision, Chr(9)) - 1)
40 modified = Mid(modified, 1, InStr(modified, Chr(9)) - 1)
41 version = Mid(version, 1, InStr(version, Chr(9)) - 1)
42 Else
43 revision = 0
44 modified = 1
45 End If
47 UpdateFile modified, revision, version, cur_date, "../src/rev.cpp"
48 UpdateFile modified, revision, version, cur_date, "../src/os/windows/ottdres.rc"
49 End Sub
51 Function ReadRegistryKey(shive, subkey, valuename, architecture)
52 Dim hiveKey, objCtx, objLocator, objServices, objReg, Inparams, Outparams
54 ' First, get the Registry Provider for the requested architecture
55 Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
56 objCtx.Add "__ProviderArchitecture", architecture ' Must be 64 of 32
57 Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
58 Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx)
59 Set objReg = objServices.Get("StdRegProv")
61 ' Check the hive and give it the right value
62 Select Case shive
63 Case "HKCR", "HKEY_CLASSES_ROOT"
64 hiveKey = &h80000000
65 Case "HKCU", "HKEY_CURRENT_USER"
66 hiveKey = &H80000001
67 Case "HKLM", "HKEY_LOCAL_MACHINE"
68 hiveKey = &h80000002
69 Case "HKU", "HKEY_USERS"
70 hiveKey = &h80000003
71 Case "HKCC", "HKEY_CURRENT_CONFIG"
72 hiveKey = &h80000005
73 Case "HKDD", "HKEY_DYN_DATA" ' Only valid for Windows 95/98
74 hiveKey = &h80000006
75 Case Else
76 MsgBox "Hive not valid (ReadRegistryKey)"
77 End Select
79 Set Inparams = objReg.Methods_("GetStringValue").Inparameters
80 Inparams.Hdefkey = hiveKey
81 Inparams.Ssubkeyname = subkey
82 Inparams.Svaluename = valuename
83 Set Outparams = objReg.ExecMethod_("GetStringValue", Inparams,,objCtx)
85 ReadRegistryKey = Outparams.SValue
86 End Function
88 Function DetermineSVNVersion()
89 Dim WshShell, version, branch, modified, revision, clean_rev, url, oExec, line, hash
90 Set WshShell = CreateObject("WScript.Shell")
91 On Error Resume Next
93 revision = 0
95 ' Try TortoiseSVN
96 ' Get the directory where TortoiseSVN (should) reside(s)
97 Dim sTortoise
98 ' First, try with 32-bit architecture
99 sTortoise = ReadRegistryKey("HKLM", "SOFTWARE\TortoiseSVN", "Directory", 32)
100 If sTortoise = "" Or IsNull(sTortoise) Then
101 ' No 32-bit version of TortoiseSVN installed, try 64-bit version (doesn't hurt on 32-bit machines, it returns nothing or is ignored)
102 sTortoise = ReadRegistryKey("HKLM", "SOFTWARE\TortoiseSVN", "Directory", 64)
103 End If
105 ' If TortoiseSVN is installed, try to get the revision number
106 If sTortoise <> "" Then
107 Dim SubWCRev
108 Set SubWCRev = WScript.CreateObject("SubWCRev.object")
109 SubWCRev.GetWCInfo FSO.GetAbsolutePathName("../"), 0, 0
110 revision = SubWCRev.Revision
111 version = "r" & revision
112 modified = 0
113 if SubWCRev.HasModifications then modified = 2
114 url = SubWCRev.Url
115 End If
117 ' Looks like there is no TortoiseSVN installed either. Then we don't know it.
118 If revision = 0 Then
119 ' Reset error and version
120 Err.Clear
121 version = "norev000"
122 modified = 0
124 ' Set the environment to english
125 WshShell.Environment("PROCESS")("LANG") = "en"
127 ' Do we have subversion installed? Check immediatelly whether we've got a modified WC.
128 Set oExec = WshShell.Exec("svnversion ../")
129 If Err.Number = 0 Then
130 ' Wait till the application is finished ...
131 Do While oExec.Status = 0
132 Loop
134 line = OExec.StdOut.ReadLine()
135 If line <> "exported" Then
136 If InStr(line, "M") Then
137 modified = 2
138 End If
140 ' And use svn info to get the correct revision and branch information.
141 Set oExec = WshShell.Exec("svn info ../")
142 If Err.Number = 0 Then
144 line = OExec.StdOut.ReadLine()
145 If InStr(line, "URL") Then
146 url = line
147 End If
148 If InStr(line, "Last Changed Rev") Then
149 revision = Mid(line, 19)
150 version = "r" & revision
151 End If
152 Loop While Not OExec.StdOut.atEndOfStream
153 End If ' Err.Number = 0
154 End If ' line <> "exported"
155 End If ' Err.Number = 0
156 End If ' InStr(version, "$")
158 If version <> "norev000" Then
159 If InStr(url, "branches") Then
160 branch = Mid(url, InStr(url, "branches/") + 9)
161 End If
162 If InStr(url, "tags") Then
163 version = Mid(url, InStr(url, "tags/") + 5)
164 End If
165 Else ' version <> "norev000"
166 ' svn detection failed, reset error and try git
167 Err.Clear
168 Set oExec = WshShell.Exec("git rev-parse --verify HEAD")
169 If Err.Number = 0 Then
170 ' Wait till the application is finished ...
171 Do While oExec.Status = 0
172 Loop
174 If oExec.ExitCode = 0 Then
175 hash = oExec.StdOut.ReadLine()
176 version = "g" & Mid(hash, 1, 8)
177 ' Make sure index is in sync with disk
178 Set oExec = WshShell.Exec("git update-index --refresh")
179 If Err.Number = 0 Then
180 ' StdOut and StdErr share a 4kB buffer so prevent it from filling up as we don't care about the output
181 oExec.StdOut.Close
182 oExec.StdErr.Close
183 ' Wait till the application is finished ...
184 Do While oExec.Status = 0
185 WScript.Sleep 10
186 Loop
187 End If
188 Set oExec = WshShell.Exec("git diff-index --exit-code --quiet HEAD ../")
189 If Err.Number = 0 Then
190 ' Wait till the application is finished ...
191 Do While oExec.Status = 0
192 Loop
194 If oExec.ExitCode = 1 Then
195 modified = 2
196 End If ' oExec.ExitCode = 1
198 Set oExec = WshShell.Exec("git symbolic-ref HEAD")
199 If Err.Number = 0 Then
200 line = oExec.StdOut.ReadLine()
201 line = Mid(line, InStrRev(line, "/") + 1)
202 If line <> "master" Then
203 branch = line
204 End If ' line <> "master"
205 End If ' Err.Number = 0
207 Set oExec = WshShell.Exec("git log --pretty=format:%s --grep=" & Chr(34) & "^(svn r[0-9]*)" & Chr(34) & " -1")
208 if Err.Number = 0 Then
209 revision = Mid(oExec.StdOut.ReadLine(), 7)
210 revision = Mid(revision, 1, InStr(revision, ")") - 1)
211 End If ' Err.Number = 0
212 If revision = "" Then
213 ' No revision? Maybe it is a custom git-svn clone
214 ' Reset error number as WshShell.Exec will not do that on success
215 Err.Clear
216 Set oExec = WshShell.Exec("git log --pretty=format:%b --grep=" & Chr(34) & "git-svn-id:.*@[0-9]*" & Chr(34) & " -1")
217 If Err.Number = 0 Then
218 revision = oExec.StdOut.ReadLine()
219 revision = Mid(revision, InStr(revision, "@") + 1)
220 revision = Mid(revision, 1, InStr(revision, " ") - 1)
221 End If ' Err.Number = 0
222 End If ' revision = ""
224 ' Check if a tag is currently checked out
225 Err.Clear
226 Set oExec = WshShell.Exec("git name-rev --name-only --tags --no-undefined HEAD")
227 If Err.Number = 0 Then
228 ' Wait till the application is finished ...
229 Do While oExec.Status = 0
230 Loop
231 If oExec.ExitCode = 0 Then
232 version = oExec.StdOut.ReadLine()
233 If Right(version, 2) = "^0" Then
234 version = Left(version, Len(version) - 2)
235 End If
236 branch = ""
237 End If ' oExec.ExitCode = 0
238 End If ' Err.Number = 0
239 End If ' Err.Number = 0
240 End If ' oExec.ExitCode = 0
241 End If ' Err.Number = 0
243 If version = "norev000" Then
244 ' git detection failed, reset error and try mercurial (hg)
245 Err.Clear
246 Set oExec = WshShell.Exec("hg id -i")
247 If Err.Number = 0 Then
248 ' Wait till the application is finished ...
249 Do While oExec.Status = 0
250 Loop
252 If oExec.ExitCode = 0 Then
253 line = OExec.StdOut.ReadLine()
254 hash = Left(line, 12)
255 version = "h" & Mid(hash, 1, 8)
257 ' Check if a tag is currently checked out
258 Err.Clear
259 Set oExec = WshShell.Exec("hg id -t")
260 If Err.Number = 0 Then
261 line = oExec.StdOut.ReadLine()
262 If Len(line) > 0 And Right(line, 3) <> "tip" Then
263 version = line
264 branch = ""
265 End If ' Len(line) > 0 And Right(line, 3) <> "tip"
266 End If ' Err.Number = 0
268 Err.Clear
269 Set oExec = WshShell.Exec("hg status ../")
270 If Err.Number = 0 Then
272 line = OExec.StdOut.ReadLine()
273 If Len(line) > 0 And Mid(line, 1, 1) <> "?" Then
274 modified = 2
275 Exit Do
276 End If ' Len(line) > 0 And Mid(line, 1, 1) <> "?"
277 Loop While Not OExec.StdOut.atEndOfStream
279 Set oExec = WshShell.Exec("hg branch")
280 If Err.Number = 0 Then
281 line = OExec.StdOut.ReadLine()
282 If line <> "default" Then
283 branch = line
284 End If ' line <> "default"
285 End If ' Err.Number = 0
287 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 ../")
288 If Err.Number = 0 Then
289 line = oExec.StdOut.ReadLine()
290 If Left(line, 6) = "(svn r" Then
291 revision = Mid(line, 7)
292 revision = Mid(revision, 1, InStr(revision, ")") - 1)
293 End If 'Left(line, 6) = "(svn r"
294 End If ' Err.Number = 0
296 If revision = "" Then
297 ' No rev? Maybe it is a custom hgsubversion clone
298 Err.Clear
299 Set oExec = WshShell.Exec("hg parent --template=" & Chr(34) & "{svnrev}" & Chr(34))
300 If Err.Number = 0 Then
301 revision = oExec.StdOut.ReadLine()
302 End If ' Err.Number = 0
303 End If ' revision = ""
304 End If ' Err.Number = 0
305 End If ' oExec.ExitCode = 0
306 End If ' Err.Number = 0
307 End If ' version = "norev000"
308 End If ' version <> "norev000"
310 If version = "norev000" And FSO.FileExists("../.ottdrev") Then
311 Dim rev_file
312 Set rev_file = FSO.OpenTextFile("../.ottdrev", 1, True, 0)
313 DetermineSVNVersion = rev_file.ReadLine()
314 rev_file.Close()
315 Else
316 If modified = 2 Then
317 version = version & "M"
318 End If
320 clean_rev = version
321 If branch <> "" Then
322 version = version & "-" & branch
323 End If
325 If version <> "norev000" Then
326 DetermineSVNVersion = version & Chr(9) & revision & Chr(9) & modified & Chr(9) & clean_rev
327 Else
328 DetermineSVNVersion = version
329 End If
330 End If
331 End Function
333 Function IsCachedVersion(ByVal version)
334 Dim cache_file, cached_version
335 cached_version = ""
336 Set cache_file = FSO.OpenTextFile("../config.cache.version", 1, True, 0)
337 If Not cache_file.atEndOfStream Then
338 cached_version = cache_file.ReadLine()
339 End If
340 cache_file.Close
342 If InStr(version, Chr(9)) Then
343 version = Mid(version, 1, Instr(version, Chr(9)) - 1)
344 End If
346 If version <> cached_version Then
347 Set cache_file = fso.CreateTextFile("../config.cache.version", True)
348 cache_file.WriteLine(version)
349 cache_file.Close
350 IsCachedVersion = False
351 Else
352 IsCachedVersion = True
353 End If
354 End Function
356 Function CheckFile(filename)
357 CheckFile = FSO.FileExists(filename)
358 If CheckFile Then CheckFile = (FSO.GetFile(filename).DateLastModified >= FSO.GetFile(filename & ".in").DateLastModified)
359 End Function
361 Dim version
362 version = DetermineSVNVersion
363 If Not (IsCachedVersion(version) And CheckFile("../src/rev.cpp") And CheckFile("../src/os/windows/ottdres.rc")) Then
364 UpdateFiles version
365 End If