1'
2' ScummVM - Graphic Adventure Engine
3'
4' ScummVM is the legal property of its developers, whose names
5' are too numerous to list here. Please refer to the COPYRIGHT
6' file distributed with this source distribution.
7'
8' This program is free software; you can redistribute it and/or
9' modify it under the terms of the GNU General Public License
10' as published by the Free Software Foundation, version 2
11' of the License.
12'
13' This program is distributed in the hope that it will be useful,
14' but WITHOUT ANY WARRANTY; without even the implied warranty of
15' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the
16' GNU General Public License for more details.
17'
18' You should have received a copy of the GNU General Public License
19' along with this program; if not, write to the Free Software
20' Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
21'
22' Based off OpenTTD determineversion.vbs (released under GPL version 2)
23'
24'/
25
26''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
27' This script tries to determine a revision number based on the current working tree
28' by trying revision control tools in the following order:
29'   - git (with hg-git detection)
30'   - mercurial
31'   - TortoiseSVN
32'   - SVN
33'
34' It then writes a new header file to be included during build, with the revision
35' information, the current branch, the revision control system (when not git) and
36' a flag when the tree is dirty.
37'
38' This is called from the prebuild.cmd batch file
39''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
40
41Option Explicit
42
43' Working copy check priority:
44'   True:   TortoiseSVN -> SVN -> Git -> Hg
45'   False:  Git -> Hg -> TortoiseSVN -> SVN
46Dim prioritySVN: prioritySVN = False
47
48Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
49Dim WshShell : Set WshShell = CreateObject("WScript.Shell")
50
51' Folders
52Dim rootFolder : rootFolder = ""
53Dim targetFolder : targetFolder = ""
54
55' Info variables
56Dim tool : tool = ""
57Dim branch : branch = "trunk"
58Dim revision : revision = ""
59Dim modified : modified = False
60
61' Parse our command line arguments
62If ParseCommandLine() Then
63	' Determine the revision and update the props file with the revision numbers
64	DetermineRevision()
65End If
66
67'////////////////////////////////////////////////////////////////
68'// Revision checking
69'////////////////////////////////////////////////////////////////
70Sub DetermineRevision()
71	Wscript.StdErr.WriteLine "Determining current revision:"
72
73	' Set the current directory to the root folder
74	WshShell.CurrentDirectory = rootFolder
75
76	' Try until we find a proper working copy
77	If (prioritySVN) Then
78		If Not DetermineTortoiseSVNVersion() Then
79			If Not DetermineSVNVersion() Then
80				If Not DetermineGitVersion() Then
81					If Not DetermineHgVersion() Then
82						Wscript.StdErr.WriteLine "Could not determine the current revision, skipping..."
83						OutputRevisionHeader ""
84						Exit Sub
85					End If
86				End If
87			End If
88		End If
89	Else
90		If Not DetermineGitVersion() Then
91			If Not DetermineHgVersion() Then
92				If Not DetermineTortoiseSVNVersion() Then
93					If Not DetermineSVNVersion() Then
94						Wscript.StdErr.WriteLine "Could not determine the current revision, skipping..."
95						OutputRevisionHeader ""
96						Exit Sub
97					End If
98				End If
99			End If
100		End If
101	End If
102
103	Dim outputInfo : outputInfo = "Found revision " & revision & " on branch " & branch
104
105	' Setup our revision string
106	Dim revisionString : revisionString = revision
107
108	If (modified) Then
109		revisionString = revisionString & "-dirty"
110		outputInfo = outputInfo &  " (dirty)"
111	End If
112
113	' If we are not on trunk, add the branch name to the revision string
114	If (branch <> "trunk" And branch <> "master" And branch <> "") Then
115		revisionString = revisionString & "(" & branch & ")"
116	End If
117
118	' Add the DVCS name at the end (when not git)
119	If (tool <> "git") Then
120		revisionString = revisionString & "-" & tool
121		outputInfo = outputInfo & " using " & tool
122	End If
123
124	Wscript.StdErr.WriteLine outputInfo & vbCrLf
125
126	OutputRevisionHeader revisionString
127End Sub
128
129' Output revision header file
130Sub OutputRevisionHeader(str)
131	FSO.CopyFile rootFolder & "\\base\\internal_revision.h.in", targetFolder & "\\internal_revision.h.tmp"
132	FindReplaceInFile targetFolder & "\\internal_revision.h.tmp", "@REVISION@", str
133	CompareFileAndReplace targetFolder & "\\internal_revision.h.tmp", targetFolder & "\\internal_revision.h"
134End Sub
135
136Function DetermineTortoiseSVNVersion()
137	Err.Clear
138	On Error Resume Next
139	DetermineTortoiseSVNVersion = False
140	Wscript.StdErr.Write "   TortoiseSVN...   "
141	tool = "svn"
142
143	' Get the directory where TortoiseSVN (should) reside(s)
144	Dim sTortoise
145
146	' First, try with 32-bit architecture
147	sTortoise = ReadRegistryKey("HKLM", "SOFTWARE\TortoiseSVN", "Directory", 32)
148
149	If sTortoise = "" Or IsNull(sTortoise) Then
150		' No 32-bit version of TortoiseSVN installed, try 64-bit version (doesn't hurt on 32-bit machines, it returns nothing or is ignored)
151		sTortoise = ReadRegistryKey("HKLM", "SOFTWARE\TortoiseSVN", "Directory", 64)
152	End If
153
154	' Check if Tortoise is present
155	If sTortoise = "" Then
156		Wscript.StdErr.WriteLine "TortoiseSVN not installed!"
157		Exit Function
158	End If
159
160	' If TortoiseSVN is installed, try to get the revision number
161	Dim SubWCRev : Set SubWCRev = WScript.CreateObject("SubWCRev.object")
162	SubWCRev.GetWCInfo rootFolder, 0, 0
163
164	' Check if this is a working copy
165	If Not SubWCRev.IsSvnItem Then
166		Wscript.StdErr.WriteLine "Not a working copy!"
167		Exit Function
168	End If
169
170	revision = SubWCRev.Revision
171
172	' Check for modifications
173	If SubWCRev.HasModifications Then modified = True
174
175	If revision = "" Then
176		Wscript.StdErr.WriteLine "No revision found!"
177		Exit Function
178	End If
179
180	DetermineTortoiseSVNVersion = True
181End Function
182
183Function DetermineSVNVersion()
184	Err.Clear
185	On Error Resume Next
186	DetermineSVNVersion = False
187	Wscript.StdErr.Write "   SVN...           "
188	tool = "svn"
189
190	' Set the environment to English
191	WshShell.Environment("PROCESS")("LANG") = "en"
192
193	' Do we have subversion installed? Check immediately whether we've got a modified WC.
194	Dim oExec: Set oExec = WshShell.Exec("svnversion " & rootFolder)
195	If Err.Number <> 0 Then
196		Wscript.StdErr.WriteLine "SVN not installed!"
197		Exit Function
198	End If
199
200	' Wait till the application is finished ...
201	Do While oExec.Status = 0
202		WScript.Sleep 100
203	Loop
204
205	Dim line: line = OExec.StdOut.ReadLine()
206	If line = "exported" Then
207		Wscript.StdErr.WriteLine "Not a working copy!"
208		Exit Function
209	End If
210
211	If InStr(line, "M") Then
212		modified = True
213	End If
214
215	' And use svn info to get the correct revision and branch information.
216	Set oExec = WshShell.Exec("svn info " & rootFolder)
217
218	If Err.Number <> 0 Then
219		Wscript.StdErr.WriteLine "No revision found!"
220		Exit Function
221	End If
222
223	Do
224		line = OExec.StdOut.ReadLine()
225		If InStr(line, "Last Changed Rev") Then
226			revision = Mid(line, 19)
227		End If
228	Loop While Not OExec.StdOut.atEndOfStream
229
230	If revision = 0 Then
231		Wscript.StdErr.WriteLine "No revision found!"
232		Exit Function
233	End If
234
235	DetermineSVNVersion = True
236End Function
237
238Function DetermineGitVersion()
239	Err.Clear
240	On Error Resume Next
241	DetermineGitVersion = False
242	Dim line
243	Wscript.StdErr.Write "   Git...           "
244	tool = "git"
245
246	' First check if we have both a .git & .hg folders (in case hg-git has been set up to have the git folder at the working copy level)
247	If FSO.FolderExists(rootFolder & "/.git") And FSO.FolderExists(rootFolder & "/.hg") Then
248		Wscript.StdErr.WriteLine "Mercurial clone with git repository in tree!"
249		Exit Function
250	End If
251
252	' Set the environment to English
253	WshShell.Environment("PROCESS")("LANG") = "en"
254
255	' Detect if we are using msysgit that has a cmd script in the path instead of an exe...
256	Dim gitPath : gitPath = "git "
257	Dim oExec : Set oExec = WshShell.Exec("git")
258	If Err.Number <> 0 Then
259		gitPath = "git.cmd "
260	End If
261
262	Err.Clear
263	Set oExec = WshShell.Exec(gitPath & "rev-parse --verify HEAD")
264	If Err.Number <> 0 Then
265		Wscript.StdErr.WriteLine "Git not installed!"
266		Exit Function
267	End If
268
269	' Wait till the application is finished ...
270	Do While oExec.Status = 0
271		WScript.Sleep 100
272	Loop
273
274	If oExec.ExitCode <> 0 Then
275		Wscript.StdErr.WriteLine "Error parsing git revision!"
276		Exit Function
277	End If
278
279	' Get the version hash
280	Dim hash : hash = oExec.StdOut.ReadLine()
281
282	' Make sure index is in sync with disk
283	Set oExec = WshShell.Exec(gitPath & "update-index --refresh --unmerged")
284	If Err.Number = 0 Then
285		' Wait till the application is finished ...
286		Do While oExec.Status = 0
287			WScript.Sleep 100
288		Loop
289	End If
290
291	Set oExec = WshShell.Exec(gitPath & "diff-index --quiet HEAD " & rootFolder)
292	If oExec.ExitCode <> 0 Then
293		Wscript.StdErr.WriteLine "Error parsing git revision!"
294		Exit Function
295	End If
296
297	' Wait till the application is finished ...
298	Do While oExec.Status = 0
299		WScript.Sleep 100
300	Loop
301
302	If oExec.ExitCode = 1 Then
303		modified = True
304	End If
305
306	' Get branch name
307	Set oExec = WshShell.Exec(gitPath & "symbolic-ref HEAD")
308	If Err.Number = 0 Then
309		line = oExec.StdOut.ReadLine()
310		line = Mid(line, InStrRev(line, "/") + 1)
311		If line <> "master" Then
312			branch = line
313		End If
314	End If
315
316	' Get revision description
317	Set oExec = WshShell.Exec(gitPath & "describe --match desc/*")
318	If Err.Number = 0 Then
319		line = oExec.StdOut.ReadLine()
320		line = Mid(line, InStr(line, "-") + 1)
321		If line <> "" Then
322			revision = line
323		End If
324	End If
325
326	' Fallback to abbreviated revision number if needed
327	If revision = "" Then
328		revision = Mid(hash, 1, 7)
329	End If
330
331	DetermineGitVersion = True
332End Function
333
334Function DetermineHgVersion()
335	Err.Clear
336	On Error Resume Next
337	DetermineHgVersion = False
338	Wscript.StdErr.Write "   Mercurial...     "
339	tool = "hg"
340
341	Err.Clear
342	Dim oExec: Set oExec = WshShell.Exec("hg parents --template ""{rev}:{node|short}""")
343	If Err.Number <> 0 Then
344		Wscript.StdErr.WriteLine "Mercurial not installed!"
345		Exit Function
346	End If
347
348	' Wait till the application is finished ...
349	Do While oExec.Status = 0
350		WScript.Sleep 100
351	Loop
352
353	If oExec.ExitCode <> 0 Then
354		Wscript.StdErr.WriteLine "Error parsing mercurial revision!"
355		Exit Function
356	End If
357
358	Dim info : info = Split(OExec.StdOut.ReadLine(), ":")
359	Dim version : version = info(0)
360	Dim hash : hash = info(1)
361
362	Set oExec = WshShell.Exec("hg status " & rootFolder)
363	If Err.Number <> 0 Then
364		Wscript.StdErr.WriteLine "Error parsing mercurial revision!"
365		Exit Function
366	End If
367
368	' Check for modifications
369	Do
370		line = OExec.StdOut.ReadLine()
371		If Len(line) > 0 And Mid(line, 1, 1) <> "?" Then
372			modified = True
373			Exit Do
374		End If
375	Loop While Not OExec.StdOut.atEndOfStream
376
377	' Check for branch
378	Set oExec = WshShell.Exec("hg branch")
379	If Err.Number = 0 Then
380		line = OExec.StdOut.ReadLine()
381		If line <> "default" Then
382			branch = line
383		End If
384	End If
385
386	' Check for SVN clone
387	Set oExec = WshShell.Exec("hg log -f -l 1 --template ""{svnrev}\n"" --cwd " & rootFolder)
388	If Err.Number = 0 Then
389		revision = Mid(OExec.StdOut.ReadLine(), 7)
390		revision = Mid(revision, 1, InStr(revision, ")") - 1)
391		tool = "svn-hg"
392	End If
393
394	' Fallback to abbreviated revision number
395	If revision = "" Then
396		revision = version & "(" & hash & ")"
397	End If
398
399	DetermineHgVersion = True
400End Function
401
402'////////////////////////////////////////////////////////////////
403'// Utilities
404'////////////////////////////////////////////////////////////////
405Function ParseCommandLine()
406	ParseCommandLine = True
407
408	If Wscript.Arguments.Count <> 2 Then
409		Wscript.StdErr.WriteLine "[Error] Invalid number of arguments (was: " & Wscript.Arguments.Count & ", expected: 2)"
410
411		ParseCommandLine = False
412		Exit Function
413	End If
414
415	' Get our arguments
416	rootFolder = Wscript.Arguments.Item(0)
417	targetFolder = Wscript.Arguments.Item(1)
418
419	' Check that the folders are valid
420	If Not FSO.FolderExists(rootFolder) Then
421		Wscript.StdErr.WriteLine "[Error] Invalid root folder (" & rootFolder & ")"
422
423		ParseCommandLine = False
424		Exit Function
425	End If
426
427	If Not FSO.FolderExists(targetFolder) Then
428		Wscript.StdErr.WriteLine "[Error] Invalid target folder (" & targetFolder & ")"
429
430		ParseCommandLine = False
431		Exit Function
432	End If
433
434	' Set absolute paths
435	rootFolder = FSO.GetAbsolutePathName(rootFolder)
436	targetFolder = FSO.GetAbsolutePathName(targetFolder)
437End Function
438
439Function ReadRegistryKey(shive, subkey, valuename, architecture)
440	Dim hiveKey, objCtx, objLocator, objServices, objReg, Inparams, Outparams
441
442	' First, get the Registry Provider for the requested architecture
443	Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
444	objCtx.Add "__ProviderArchitecture", architecture ' Must be 64 of 32
445	Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
446	Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx)
447	Set objReg = objServices.Get("StdRegProv")
448
449	' Check the hive and give it the right value
450	Select Case shive
451		Case "HKCR", "HKEY_CLASSES_ROOT"
452			hiveKey = &h80000000
453		Case "HKCU", "HKEY_CURRENT_USER"
454			hiveKey = &H80000001
455		Case "HKLM", "HKEY_LOCAL_MACHINE"
456			hiveKey = &h80000002
457		Case "HKU", "HKEY_USERS"
458			hiveKey = &h80000003
459		Case "HKCC", "HKEY_CURRENT_CONFIG"
460			hiveKey = &h80000005
461		Case "HKDD", "HKEY_DYN_DATA" ' Only valid for Windows 95/98
462			hiveKey = &h80000006
463		Case Else
464			MsgBox "Hive not valid (ReadRegistryKey)"
465	End Select
466
467	Set Inparams = objReg.Methods_("GetStringValue").Inparameters
468	Inparams.Hdefkey = hiveKey
469	Inparams.Ssubkeyname = subkey
470	Inparams.Svaluename = valuename
471	Set Outparams = objReg.ExecMethod_("GetStringValue", Inparams,,objCtx)
472
473	ReadRegistryKey = Outparams.SValue
474End Function
475
476Sub FindReplaceInFile(filename, to_find, replacement)
477	Dim file, data
478	Set file = FSO.OpenTextFile(filename, 1, 0, 0)
479	data = file.ReadAll
480	file.Close
481	data = Replace(data, to_find, replacement)
482	Set file = FSO.CreateTextFile(filename, -1, 0)
483	file.Write data
484	file.Close
485End Sub
486
487Sub CompareFileAndReplace(src_filename, dst_filename)
488	Dim file, src_data, dst_data
489	Set file = FSO.OpenTextFile(src_filename, 1, 0, 0)
490	src_data = file.ReadAll
491	file.Close
492	Set file = FSO.OpenTextFile(dst_filename, 1, 0, 0)
493	dst_data = file.ReadAll
494	file.Close
495	If StrComp(src_data, dst_data, vbBinaryCompare) <> 0 Then
496		' Files are different, overwrite the destination
497		FSO.CopyFile src_filename, dst_filename, True
498	End If
499	' Remove temporary source
500	FSO.DeleteFile src_filename
501End Sub
502