' this file originally came from FogBugz support or FogBugs stackexchange

' Change to top level URL for bugz server - must contain trailing slash
Dim BUGZ_URL: BUGZ_URL = "https://YOUR_FB_ON_DEMAND_NAME.fogbugz.com/"

' ixRepository for this repo in FogBugz. (Not required.)
Dim IXREPOSITORY: IXREPOSITORY="3"

' Perforce provides one free "automation" or "background" user license 
' to allow scripts like this one to authenticate. You can contact them 
' at support@perforce.com to request this free user license. 
Dim P4USERNAME: P4USERNAME = "YourP4User" 

' If you have passwords enabled in Perforce, provide the password below, for 
' the free "background" user license. Otherwise, leave it blank. 
Dim P4PASSWORD: P4PASSWORD = "YourP4Password"

' If this is set to 1 (default), only the changelist will appear in FogBugz,
' and not a list of all files changed.  If set to 0, all files will appear
' in FogBugz
Dim CHANGELIST_ONLY: CHANGELIST_ONLY = 0

' Localized strings used when sending the changelist to FogBugz.  Translating
' these will change how changelists appear in FogBugz
Dim FB_CHANGELIST_LATIN: FB_CHANGELIST_LATIN = "Changelist"
Dim FB_FILES_LATIN: FB_FILES_LATIN = "Files"
Dim FB_FILE_LATIN: FB_FILE_LATIN = "File"

Sub LogIt( s )
	' To debug, change False to True on the line below
	If False Then
		Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
		Dim f: Set f = fso.OpenTextFile("C:\p4log.txt", 8, True)
		f.WriteLine s
		f.Close
		Set f = Nothing
		Set fso = Nothing
	End If
End Sub

Dim args: Set args = WScript.Arguments.UnNamed

If args.Count <> 2 Then
'	WScript.Echo "usage cscript.exe [scriptname].vbs %changelist% %serverport% %client% "
	WScript.Echo "usage cscript.exe [scriptname].vbs %changelist% %serverport% "
	WScript.Quit 1
End If

Dim ChangeList: ChangeList = args(0)
Dim ServerPort: ServerPort = args(1)
'Dim Client: Client = args(2)

'Dim p4: p4 = "cmd /c p4 -c " & Client & _ 
Dim p4: p4 = "cmd /c p4 " & _ 
			" -p " & ServerPort & _ 
			" -u " & P4USERNAME 
If Len(P4PASSWORD) > 0 Then p4 = p4 & " -P " & P4PASSWORD
			
' Get log information "p4 -p port -c client describe -s changenum"
LogIt "ChangeList: " & ChangeList
LogIt "ServerPort: " & ServerPort
'LogIt "Client: " & Client
LogIt "P4USERNAME: " & P4USERNAME
LogIt "P4PASSWORD:" & P4PASSWORD
LogIt "p4: " & p4

Dim WshShell
Set WshShell = CreateObject("WScript.Shell")

Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")

Dim tmpFile
tmpFile = GetTempFileName

Dim re: Set re = New RegExp
Dim matches, match

'
' Strip trailing slash from BUGZ_URL
'
re.Global = True
re.Pattern = "/$"
BUGZ_URL = re.Replace( BUGZ_URL, "" )

'
' Get real hostname
'
'Dim sHostInfo
'WshShell.Run p4 & " client -o > " & tmpFile,,true
'Dim f: Set f = fso.opentextfile(tmpFile)
'If Not f.atendofstream Then sHostInfo = f.ReadAll
'f.Close
'
're.IgnoreCase = True
're.Pattern = "\nHost:\s*(\S+)"
'Set matches = re.Execute(sHostInfo)
'
'If matches.Count > 0 Then
'   Set match = matches(0)
'   LogIt "Found host: " & match.SubMatches(0)
'   p4 = p4 & " -H " & match.SubMatches(0) & " "
'End If
'
'LogIt "p4: " & p4

'
' Get Bug ID if it's there
'
Dim sLogInfo
WshShell.Run p4 & " describe -s " & ChangeList & " > " & tmpFile,,true

Set f = fso.opentextfile(tmpFile)
If Not f.atendofstream Then sLogInfo = f.ReadAll
f.Close

LogIt "sLogInfo: " & sLogInfo

re.IgnoreCase = True
re.Global = True
're.Pattern = "\s*BUG[ZS]*\s*IDs*\s*[#:; ]+((\d+[ ,:;#]*)+)"
re.Pattern = "\s*\[CASE\s*[#:;= ]+((\d+[ ,:;#]*)+)\]"

Dim ixBug: ixBug = 0
Dim i
Dim bugIDString: bugIDString = ""
Set matches = re.Execute(sLogInfo)
If matches.Count > 0 Then
   LogIt("Found id matches in STDIN: " & matches.Count)
   For i = 0 To (matches.Count - 1)
      Set match = matches(i)
      If Len(bugIDString) > 0 Then bugIDString = bugIDString & ","
      bugIDString = bugIDString & match.SubMatches(0)
   Next
Else
   fso.DeleteFile tmpFile
   WScript.Quit 0
End If

LogIt "ixBug = " & bugIDString

'
' Get change description 
'
Dim sChangeInfo
WshShell.Run p4 & " files @" & ChangeList & "," & ChangeList & " > " & tmpFile,,true

Dim sFile, sRev, sRev2, http
On Error Resume Next
 Set http = CreateObject("Microsoft.XMLHTTP")
If Err.Number <> 0 Then
 Set http = CreateObject("MSXML2.ServerXMLHTTP")
End If
On Error Goto 0

If http Is Nothing Then
	LogIt "FAILURE! Couldn't create XMLHTTP object"
End If

Set f = fso.OpenTextFile( tmpFile )

Dim bugIDlist
bugIDString = Replace(bugIDString, " ", ",")
bugIDString = Replace(bugIDString, ":", ",")
bugIDString = Replace(bugIDString, ";", ",")
bugIDString = Replace(bugIDString, "#", ",")
bugIDlist = split(bugIDString, ",")

LogIt "reading: " & tmpFile

Dim cFiles: cFiles = 0
While Not f.AtEndOfStream
	LogIt "it wasn't empty"
	sChangeInfo = f.ReadLine
	LogIt "Examining line: " & sChangeInfo
	re.Pattern = "([^#]*)#([^ ]*) -"
	Set matches = re.Execute(sChangeInfo)
	If matches.Count > 0 Then
		LogIt "Match found!"
		If CHANGELIST_ONLY Then
			cFiles = cFiles + 1
		Else
			Set match = matches(0)
			sFile = match.SubMatches(0)
			sRev2 = match.SubMatches(1)
			sRev = sRev2 - 1

			For Each ixBug in bugIDList
			   If IsNumeric(ixBug) Then
				ixBug = CLng(ixBug)
	
				If ixBug > 0 Then
					LogIt "Adding files for Bug ID#" & ixBug & "..."

					http.Open "GET", BUGZ_URL & "/cvsSubmit.asp" & _
						"?ixBug=" & ixBug & "&sFile=" & sFile & "&sPrev=" & sRev & "&sNew=" & sRev2 & "&ixRepository=" & ixRepository, False
					http.Send
					If http.responseText = "OK" Then
						LogIt "SUCCESS! Bug change entered!"
					Else
						LogIt "FAILURE! Could not submit to server!"
						LogIt "Status Code: " & http.status
						LogIt http.responseText
					End If		
				End If
			   End If
			Next
		End If
		
	Else
		LogIt "Match NOT found!"
	End If
Wend

LogIt "finished reading"

If CHANGELIST_ONLY Then	
	' For changelist, we create a string with the changelist number and the number of files and send that as the file
	If cFiles = 1 Then
		sFile = FB_CHANGELIST_LATIN & " " & ChangeList & " (" & cFiles & " " & FB_FILE_LATIN & ")"
	Else
		sFile = FB_CHANGELIST_LATIN & " " & ChangeList & " (" & cFiles & " " & FB_FILES_LATIN & ")"
	End If

	' Past revision is empty, new revision is the change number
	sRev = ChangeList
	sRev2 = ChangeList

	' Send the changelist for each bug
	For Each ixBug in bugIDList
		If IsNumeric(ixBug) Then
			ixBug = CLng(ixBug)	
	
			If ixBug > 0 Then
				LogIt "Adding changelist for Bug ID#" & ixBug & "..."
				WScript.Echo "Adding changelist for Bug ID#" & ixBug & "..."

				http.Open "GET", BUGZ_URL & "/cvsSubmit.asp" & _
					"?ixBug=" & ixBug & "&sFile=" & SimpleEscape(sFile) & "&sPrev=" & sRev & "&sNew=" & sRev2 & "&ixRepository=" & ixRepository, False
				http.Send
				If http.responseText = "OK" Then
					LogIt "SUCCESS! Bug change entered!"
				Else
					LogIt "FAILURE! Could not submit to server!"
					LogIt "Status Code: " & http.status
					LogIt http.responseText
				End If
			End If
		End If
	Next
End If

f.Close
fso.DeleteFile tmpFile

Function SimpleEscape(s)
	SimpleEscape = Replace(Replace(Replace(s, " ", "%20"), "(", "%28"), ")", "%29")
End Function

Function GetTempFileName
	Dim tfolder
	Const TemporaryFolder = 2
	Set tfolder = fso.GetSpecialFolder(TemporaryFolder)
	GetTempFileName = tfolder & "\" & fso.GetTempName 
'	Dim tname
'	tname = fso.GetTempName
'	GetTempFileName = "C:\Users\Public\Documents\tmp\" & tname 
End Function