Imports System
Imports System.CodeDom
Imports System.Collections.Generic
Imports System.IO
Imports System.Text.RegularExpressions
Imports System.Web.Compilation
Imports System.Web.Hosting
Imports System.Xml      

'Modified slightly from the c# at http://www.singular.co.nz/blog/archive/2008/02/03/build-providers-and-strongly-typed-page-urls-in-asp-net.aspx
Namespace StaticContent      

	''' <summary>
	''' Generates a static class for urls within an ASP.NET project
	''' </summary>
	Public Class BuildProvider
		Inherits System.Web.Compilation.BuildProvider      

#Region "Fields"      

		Delegate Function Filter(ByVal info As FileSystemInfo, ByVal include As Regex, ByVal exclude As Regex) As Boolean      

		''' <summary>
		''' Path to the web root for determining urls within the site
		''' </summary>
		Private _basePath As String
		''' <summary>
		''' Whether to convert urls to lowercase - based on your preference
		''' </summary>
		Private _useLowerCaseUrls As Boolean
		''' <summary>
		''' Whether to include the extension of the file in the name
		''' of the member
		''' </summary>
		Private _includeExtension As Boolean      

		''' <summary>
		''' Whether to remove the portion of the path skipped due to minimum depth constraints
		''' of the member
		''' </summary>
		Private _truncatePathToStartingDepth As Boolean      

		''' <summary>
		''' format string for resource value
		''' </summary>
		Private _resourceResolutionFormat As String      

		''' <summary>
		''' Maximum recurring depth for the project - 1 for top level,
		''' 2 for first level of subfolders etc...
		''' </summary>
		Private _maxDepth As Integer = 100
		''' <summary>
		''' Minimum recurring depth for the project - 1 for top level,
		''' 2 for first level of subfolders etc...
		''' the purpose it to not include files that are not deep enough in the tree to worrry about
		''' </summary>
		Private _minDepth As Integer
		''' <summary>
		''' Namespace the generated class will be placed within.
		''' Leave empty to add to the global namesapce e.g. global::Href
		''' </summary>
		Private _namespace As String
		''' <summary>
		''' The name of the main class e.g. Href
		''' </summary>
		Private _className As String      

		''' <summary>
		''' Current depth of recursion
		''' </summary>
		Private _depth As Integer
		''' <summary>
		''' Predicate to determine if a file should be included
		''' </summary>
		Private isValidFile As Filter
		''' <summary>
		''' Predicate to determine if a folder should be included
		''' </summary>
		Private isValidFolder As Filter      

		'rule to check for includes
		Private Shared _includeRule As Regex      

		'rule to check for excludes
		Private Shared _excludeRule As Regex      

#End Region      

#Region "GenerateCode"      

		''' <summary>
		''' Initialises settings from the BuildProvider file, and
		''' generates the appropriate code.
		''' </summary>
		''' <param name="assemblyBuilder"></param>
		Public Overrides Sub GenerateCode(ByVal assemblyBuilder As AssemblyBuilder)      

			' init settings from xml source file
			init()      

			' create root class e.g. global::Href
			Dim root As CodeTypeDeclaration = createStaticClass(_className)
			addSummary(root, "Provides access to urls within the project.")
			Dim members As New Dictionary(Of String, Integer)()
			build(New DirectoryInfo(_basePath), root, members)      

			Dim ns As New CodeNamespace()
			ns.Types.Add(root)      

			' leave blank for global::namespace
			If Not String.IsNullOrEmpty(_namespace) Then
				ns.Name = _namespace
			End If      

			Dim unit As New CodeCompileUnit()
			unit.Namespaces.Add(ns)
			assemblyBuilder.AddCodeCompileUnit(Me, unit)      

		End Sub      

#End Region      

#Region "build"      

		''' <summary>
		''' Iterates over the given directory, adding the files as members to
		''' the parent type, then recurses down the folder tree until the max
		''' depth is reached.
		''' </summary>
		''' <param name="dir">The directory to process</param>
		''' <param name="parent">Parent class to add members too</param>
		Private Sub build(ByVal dir As DirectoryInfo, ByVal parent As CodeTypeDeclaration, ByVal members As Dictionary(Of String, Integer))
			If _depth >= _maxDepth Then
				Return
			End If      

			_depth += 1      

			If _depth >= _minDepth Then
				'members' keeps a record of the number of times a
				'member name is repeated within the parent type/class.
				'Pass this to 'ensureUniqueMemberName' to get the name
				'with an index number appended to the end e.g. the second
				'occurrence of "MyProperty" becomes "MyProperty1"       

				' process files:
				' iterate over files and add the member
				' public const string MyfileName = "~/myfileName.aspx";
				'
				Dim files As FileInfo() = dir.GetFiles()
				For Each file As FileInfo In files      

					If isValidFile(file, _includeRule, _excludeRule) Then      

						Dim field As New CodeMemberField()
						field.Name = getName(file)
						ensureUniqueMemberName(members, field)
						field.Type = New CodeTypeReference(GetType(String))
						If String.IsNullOrEmpty(_resourceResolutionFormat) Then
							field.Attributes = MemberAttributes.[Public] Or MemberAttributes.[Const]
							field.InitExpression = getInitExpression(getUrl(file))
						Else
							field.Attributes = MemberAttributes.[Public] Or MemberAttributes.Static
							field.InitExpression = New CodeSnippetExpression(String.Format(Globalization.CultureInfo.InvariantCulture, _resourceResolutionFormat, getUrl(file)))
						End If
						addSummary(field, getUrl(file, False))
						parent.Members.Add(field)
					End If
				Next      

			End If
			'
			' process subfolders:
			' iterate over folders and add a nested class
			'
			Dim subfolders As DirectoryInfo() = dir.GetDirectories()
			For Each folder As DirectoryInfo In subfolders      

				If isValidFolder(folder, _includeRule, _excludeRule) Then      

					If _depth < _minDepth Then
						build(folder, parent, members)
					Else
						Dim nested As CodeTypeDeclaration = createStaticClass(getName(folder))
						addSummary(nested, "Provides access to urls under: {0}", getUrl(folder, False).TrimStart("~"c))
						ensureUniqueMemberName(members, nested)
						build(folder, nested, members)
						' .ctor will have already been added to members
						' so only add to parent if there are additional
						' members present
						If nested.Members.Count > 1 Then
							parent.Members.Add(nested)
						End If
					End If      

				End If
			Next      

			_depth -= 1      

		End Sub      

#End Region      

#Region "init"      

		''' <summary>
		''' Initialises settings from the config file.
		''' </summary>
		''' <example>
		'''
		''' Sample configuration - all nodes and elements are optional, but the file
		''' needs a root node to load as an XmlDocument.
		''' <?xml version="1.0" encoding="utf-8" ?>
		''' <settings
		''' namespace=""
		''' className="Href"
		''' maxDepth="100"
		''' lowercaseUrls="true"
		''' includeExtension="false">
		'''
		''' <files include="\.(aspx|html)$" exclude="\.htm$">
		''' <folders include="" exclude="App_|Bin|Templates">
		''' </settings>
		'''
		''' </example>
		Private Sub init()      

			Try
				_basePath = HostingEnvironment.ApplicationPhysicalPath      

				Dim xml As New XmlDocument()
				Using stream As Stream = VirtualPathProvider.OpenFile(MyBase.VirtualPath)
					xml.Load(stream)
				End Using      

				' code below uses syntax, xml["elementName"] ?? xml.CreateElement( "elementName" );
				' as a lazy initialisation technique, rather than checking for
				' the node and performing alternate initialisation - this keeps
				' it within the same reading context.       

				'
				' general settings
				'
				Dim settings As XmlElement
				If xml("settings") Is Nothing Then
					settings = xml.CreateElement("settings")
				Else
					settings = xml("settings")
				End If      

				_maxDepth = Integer.Parse(getAttributeValue(settings, "maxDepth", "100"), System.Globalization.CultureInfo.InvariantCulture)
				_minDepth = Integer.Parse(getAttributeValue(settings, "minDepth", "0"), System.Globalization.CultureInfo.InvariantCulture)
				_useLowerCaseUrls = Boolean.Parse(getAttributeValue(settings, "lowercaseUrls", "false"))
				_includeExtension = Boolean.Parse(getAttributeValue(settings, "includeExtension", "false"))
				_truncatePathToStartingDepth = Boolean.Parse(getAttributeValue(settings, "truncatePathToStartingDepth", "false"))
				_resourceResolutionFormat = getAttributeValue(settings, "resourceResolutionFormat")
				_namespace = getAttributeValue(settings, "namespace")
				_className = getAttributeValue(settings, "className", "Href")      

				'
				' files settings
				'
				Dim files As XmlElement = Nothing
				If settings("files") Is Nothing Then
					files = xml.CreateElement("files")
				Else
					files = settings("files")
				End If      

				isValidFile = createFilter(getAttributeValue(files, "include", "\.aspx$"), getAttributeValue(files, "exclude"))      

				'
				' folders settings
				'
				Dim folders As XmlElement = Nothing
				If settings("folders") Is Nothing Then
					folders = xml.CreateElement("folders")
				Else
					folders = settings("folders")
				End If      

				isValidFolder = createFilter(getAttributeValue(folders, "include"), getAttributeValue(folders, "exclude", "App_|Bin"))
			Catch ex As Exception
				Console.WriteLine("Error:" + ex.ToString)
				Throw
			End Try
		End Sub      

#End Region      

#Region "getAttributeValue"      

		''' <summary>
		'''
		''' </summary>
		''' <param name="parent"></param>
		''' <param name="name"></param>
		''' <param name="default"></param>
		''' <returns></returns>
		Private Shared Function getAttributeValue(ByVal parent As XmlElement, ByVal name As String, ByVal [default] As String) As String      

			Dim attribute As XmlAttribute = parent.Attributes.ItemOf(name)
			If attribute Is Nothing Then
				Return [default]
			Else
				Return attribute.Value.Trim()
			End If
		End Function      

		''' <summary>
		'''
		''' </summary>
		''' <param name="parent"></param>
		''' <param name="name"></param>
		''' <returns></returns>
		Private Shared Function getAttributeValue(ByVal parent As XmlElement, ByVal name As String) As String      

			Return getAttributeValue(parent, name, Nothing)
		End Function      

#End Region      

#Region "createFilter"      

		''' <summary>
		''' Creates a Predicate for filtering based on the given regex patterns
		''' </summary>
		''' <param name="includePattern"></param>
		''' <param name="excludePattern"></param>
		''' <returns></returns>
		Private Shared Function createFilter(ByVal includePattern As String, ByVal excludePattern As String) As Filter      

			If Not String.IsNullOrEmpty(includePattern) Then
				_includeRule = New Regex(includePattern, RegexOptions.Compiled Or RegexOptions.IgnoreCase)
			End If      

			If Not String.IsNullOrEmpty(excludePattern) Then
				_excludeRule = New Regex(excludePattern, RegexOptions.Compiled Or RegexOptions.IgnoreCase)
			End If      

			Return createFilter(_includeRule, _excludeRule)
		End Function      

		''' <summary>
		''' Creates a Predicate for filtering based on the given regex
		''' </summary>
		''' <param name="include"></param>
		''' <param name="exclude"></param>
		''' <returns></returns>
		Private Shared Function createFilter(ByVal include As Regex, ByVal exclude As Regex) As Filter      

			If include IsNot Nothing AndAlso exclude IsNot Nothing Then
				Return AddressOf ConvertedAnonymousMethod1
			ElseIf include IsNot Nothing Then
				Return AddressOf ConvertedAnonymousMethod3
			ElseIf exclude IsNot Nothing Then
				Return AddressOf ConvertedAnonymousMethod4
			Else
				Return AddressOf ConvertedAnonymousMethod2
			End If
		End Function      

#End Region      

#Region "getInitExpression"      

		''' <summary>
		''' Returns the given value surrounded with quotes.
		''' </summary>
		''' <param name="value"></param>
		''' <returns></returns>
		Private Shared Function getInitExpression(ByVal value As String) As CodeSnippetExpression
			Return New CodeSnippetExpression(String.Concat("""", value, """"))
		End Function      

#End Region      

#Region "getName"      

		''' <summary>
		''' Gets the normalised/escaped member name for the given file
		''' </summary>
		''' <param name="file"></param>
		''' <returns></returns>
		Private Function getName(ByVal file As FileSystemInfo) As String      

			Dim name As String = Path.GetFileNameWithoutExtension(file.Name)      

			If _includeExtension Then
				name += file.Extension.Replace("."c, "_"c)
			End If      

			name = Regex.Replace(name, "[^a-z0-9_]*", String.Empty, RegexOptions.Compiled Or RegexOptions.IgnoreCase)      

			' Ensure pascal casing of the name - not really required
			'name = TextHelper.PascalCase( name );       

			' Escape names not starting with a letter
			If Not Char.IsLetter(name(0)) Then
				name = "_" + name
			End If      

			Return name
		End Function      

#End Region      

#Region "getUrl"      

		''' <summary>
		''' Gets the url of the file, relative to the app root
		''' </summary>
		''' <param name="file"></param>
		''' <returns></returns>
		Private Function getUrl(ByVal file As FileSystemInfo) As String
			Return getUrl(file, True)
		End Function      

		''' <summary>
		''' Gets the url of the file, relative to the app root
		''' </summary>
		''' <param name="file"></param>
		''' <param name="allowNormalisation">When true, allows lowercasing of the
		''' url and stripping of default.aspx</param>
		''' <returns></returns>
		Private Function getUrl(ByVal file As FileSystemInfo, ByVal allowNormalisation As Boolean) As String      

			Dim url As String = file.FullName.Substring(_basePath.Length)      

			If allowNormalisation Then      

				If _useLowerCaseUrls Then
					url = url.ToLowerInvariant
				End If      

				If url.EndsWith("default.aspx", StringComparison.OrdinalIgnoreCase) Then
					url = url.Substring(0, url.Length - 12)
				End If
			End If      

			'if this is not a directory and we're supposed to truncate paths after a certain depth, then do so
			If _truncatePathToStartingDepth AndAlso Not System.IO.Directory.Exists(file.FullName) Then
				If _minDepth > 0 Then
					Dim newUrl As New Text.StringBuilder
					Dim directoryPaths As String() = url.Split("\"c)
					Dim max As Int32 = directoryPaths.Length - 1
					For i As Int32 = _minDepth - 1 To max
						newUrl.Append(directoryPaths(i))
						If i < max Then
							newUrl.Append("/")
						End If
					Next
					Return newUrl.ToString
				End If
				Return url.Replace("\", "/")
			Else
				Return String.Concat("~/", url.Replace("\", "/"))
			End If      

		End Function      

#End Region      

#Region "addSummary"      

		''' <summary>
		''' Adds a summary doc comment to the type's comment collection
		''' </summary>
		''' <param name="type"></param>
		''' <param name="format"></param>
		''' <param name="args"></param>
		Private Shared Sub addSummary(ByVal type As CodeTypeMember, ByVal format As String, ByVal ParamArray args As Object())
			addSummary(type.Comments, format, args)
		End Sub      

		''' <summary>
		''' Adds a summary doc comment to the collection
		''' </summary>
		''' <param name="comments"></param>
		''' <param name="format"></param>
		''' <param name="args"></param>
		Private Shared Sub addSummary(ByVal comments As CodeCommentStatementCollection, ByVal format As String, ByVal ParamArray args As Object())      

			comments.Add(New CodeCommentStatement("<summary>", True))
			comments.Add(New CodeCommentStatement(String.Format(Globalization.CultureInfo.InvariantCulture, format, args), True))
			comments.Add(New CodeCommentStatement("</summary>", True))
		End Sub      

#End Region      

#Region "createStaticClass"      

		''' <summary>
		''' Creates a static class type with the given name
		''' </summary>
		''' <param name="name"></param>
		''' <returns></returns>
		Private Shared Function createStaticClass(ByVal name As String) As CodeTypeDeclaration      

			Dim type As New CodeTypeDeclaration(name)
			type.TypeAttributes = type.TypeAttributes Or system.Reflection.TypeAttributes.Sealed
			type.Attributes = MemberAttributes.[Public] Or MemberAttributes.[Static]      

			Dim ctor As New CodeConstructor()
			ctor.Attributes = MemberAttributes.[Private]
			type.Members.Add(ctor)      

			Return type
		End Function      

#End Region      

#Region "ensureUniqueMemberName"      

		''' <summary>
		''' Ensures a unique name within the dictionary to get the name
		''' with an index number appended to the end e.g. the second
		''' occurrence of "MyProperty" becomes "MyProperty1"
		''' </summary>
		''' <remarks>A caveat of this method is where you may have two members like
		''' MyPage.aspx, MyPage.html as well as MyPage1.aspx. A conflict will occur
		''' giving duplicate members i.e. in the same order MyPage, MyPage1 and MyPage1
		''' a second time. The likelihood of such conflicts is possible, with a possible
		''' solution to recurse using ensureUniqueMemberName with the newly generated name,
		''' or enumerate the parent type's Members to see whether there will be a conflict.</remarks>
		''' <param name="members">Dictionary containing the name of the members
		''' in the current namespace as the key + the number of appearances as the value.</param>
		''' <param name="type">The next member to add to the current namespace.</param>
		Private Shared Sub ensureUniqueMemberName(ByVal members As Dictionary(Of String, Integer), ByVal type As CodeTypeMember)      

			Dim key As String = type.Name
			Dim count As Integer
			If members.TryGetValue(key, count) Then      

				type.Name = String.Concat(key, system.Threading.Interlocked.Increment(count))      

				members(key) = count
			Else
				members(key) = 0
			End If
		End Sub      

		Private Shared Function ConvertedAnonymousMethod1(ByVal info As FileSystemInfo, ByVal include As Regex, ByVal exclude As Regex) As Boolean
			Return include.IsMatch(info.FullName) AndAlso Not exclude.IsMatch(info.FullName)
		End Function      

		Private Shared Function ConvertedAnonymousMethod2(ByVal info As FileSystemInfo, ByVal include As Regex, ByVal exclude As Regex) As Boolean
			Return True
		End Function      

		Private Shared Function ConvertedAnonymousMethod3(ByVal info As FileSystemInfo, ByVal include As Regex, ByVal exclude As Regex) As Boolean
			Return include.IsMatch(info.FullName)
		End Function      

		Private Shared Function ConvertedAnonymousMethod4(ByVal info As FileSystemInfo, ByVal include As Regex, ByVal exclude As Regex) As Boolean
			Return Not exclude.IsMatch(info.FullName)
		End Function      

#End Region      

	End Class
End Namespace