Imports System.Text.RegularExpressions
Namespace Parsing
Public Enum EntityType
[Namespace]
[Class]
[Structure]
[Enumerator]
[Interface]
[Delegate]
[Sub]
[Function]
[Property]
[Operator]
Field
[Event]
[Const]
None
End Enum
Public Enum EntityCommentType
Generic
Method
[Property]
End Enum
Public Class Entity
Private _Id, _Name As String
Private _Type As EntityType
Private _Declaration As String
Private _Documentation As Comments.DocumentationComment
Private _Parent As Entity
Private _Children As New List(Of Entity)
Private Shared NormalTag As New Regex("\<(?<CommentType>(summary|remarks|see|seealso|returns|value))\>(?<Content>[\w\W]+?)\<\/\k<CommentType>\>", RegexOptions.Multiline)
Private Shared ParamTag As New Regex("\<(?<CommentType>(param|typeparam|exception))\s*(name|cref)\s*\=\s*""(?<ParamName>.+)""\s*\>(?<Content>[\w\W]+?)\<\/\k<CommentType>\>", RegexOptions.Multiline)
Public Property Id() As String
Get
Return _Id
End Get
Set(ByVal value As String)
_Id = value
End Set
End Property
Public Property Name() As String
Get
Return _Name
End Get
Set(ByVal value As String)
_Name = value
End Set
End Property
Public Property Type() As EntityType
Get
Return _Type
End Get
Set(ByVal Value As EntityType)
_Type = Value
End Set
End Property
Public Property Declaration() As String
Get
Return _Declaration
End Get
Set(ByVal Value As String)
_Declaration = Value
End Set
End Property
Public Property Documentation() As Comments.DocumentationComment
Get
Return _Documentation
End Get
Set(ByVal Value As Comments.DocumentationComment)
_Documentation = Value
End Set
End Property
Public Property Parent() As Entity
Get
Return _Parent
End Get
Set(ByVal value As Entity)
_Parent = value
End Set
End Property
Public Property Children() As List(Of Entity)
Get
Return _Children
End Get
Set(ByVal value As List(Of Entity))
_Children = value
End Set
End Property
Friend Function GetComment() As Comments.DocumentationComment
If Me.Type = EntityType.Property Then
Return New Comments.PropertyComment
End If
If Me.Type = EntityType.Function Or Me.Type = EntityType.Sub Or _
Me.Type = EntityType.Delegate Or Me.Type = EntityType.Operator Then
Return New Comments.MethodComment
End If
Return New Comments.GenericComment
End Function
Friend Function GetCommentType() As EntityCommentType
If Me.Type = EntityType.Property Then
Return EntityCommentType.Property
End If
If Me.Type = EntityType.Function Or Me.Type = EntityType.Sub Or _
Me.Type = EntityType.Delegate Or Me.Type = EntityType.Operator Then
Return EntityCommentType.Method
End If
Return EntityCommentType.Generic
End Function
Friend Function IsContainer() As Boolean
Return IsTypeContainer(Me.Type)
End Function
Friend Function IsMemberContainer() As Boolean
Return IsTypeMemberContainer(Me.Type)
End Function
Friend Function IsOneLine() As Boolean
Return IsTypeOneLine(Me.Type)
End Function
Friend Shared Function IsTypeContainer(ByVal Type As EntityType) As Boolean
If Type = EntityType.Class Or Type = EntityType.Namespace Or _
Type = EntityType.Enumerator Or Type = EntityType.Interface Or _
Type = EntityType.Structure Then
Return True
Else
Return False
End If
End Function
Friend Shared Function IsTypeMemberContainer(ByVal Type As EntityType) As Boolean
If Type = EntityType.Function Or Type = EntityType.Property Or _
Type = EntityType.Sub Or Type = EntityType.Operator Then
Return True
Else
Return False
End If
End Function
Friend Shared Function IsTypeOneLine(ByVal Type As EntityType)
If Type = EntityType.Const Or Type = EntityType.Delegate Or Type = EntityType.Event Or Type = EntityType.Field Then
Return True
Else
Return False
End If
End Function
Friend Shared Function CreateFromDeclaration(ByVal Declaration As String) As Entity
Dim Result As New Entity
Dim Id As String = CodeParser.GetNameFromDeclaration(Declaration)
Result.Id = Id
Result.Name = Id
Result.Type = CodeParser.GetTypeFromDeclaration(Declaration)
Result.Declaration = Declaration.Trim
Result.Documentation = Result.GetComment()
Result.Documentation.Summary = "Documentazione assente."
Return Result
End Function
Private Function NormalizeComment(ByVal Content As String) As String
Content = Content.Replace("'''", "")
Content = Content.Replace(vbCrLf, " ")
Content = Content.Replace(" ", " ")
Content = Content.Replace("<example>", "<br><br><i>Esempio:</i><br>")
Content = Content.Replace("</example>", "")
Content = Content.Replace("<list>", "<ul>")
Content = Content.Replace("</list>", "</ul>")
Content = Content.Replace("<item>", "<li>")
Content = Content.Replace("</item>", "</li>")
Content = Content.Replace("<para>", "<p>")
Content = Content.Replace("</para>", "</p>")
Return Content.Trim
End Function
Friend Sub ParseDocumentation(ByVal XmlComments As String)
If String.IsNullOrEmpty(XmlComments) Then
Exit Sub
End If
Dim NormalComments As MatchCollection = NormalTag.Matches(XmlComments)
Dim Doc As Comments.DocumentationComment = Me.GetComment()
Dim C As EntityCommentType = Me.GetCommentType()
For Each NC As Match In NormalComments
Dim CommentType As String = NC.Groups("CommentType").Value
Dim Content As String = NC.Groups("Content").Value
Select Case CommentType
Case "summary"
Doc.Summary = NormalizeComment(Content)
Case "remarks"
Doc.Remarks = NormalizeComment(Content)
Case "see"
Doc.See = NormalizeComment(Content)
Case "seealso"
Doc.SeeAlso = NormalizeComment(Content)
Case "returns"
If Me.Type = EntityType.Function Or Me.Type = EntityType.Property Then
DirectCast(Doc, Comments.MethodComment).Returns = NormalizeComment(Content)
End If
Case "value"
If Me.Type = EntityType.Property Then
DirectCast(Doc, Comments.PropertyComment).Value = NormalizeComment(Content)
End If
End Select
Next
If C = EntityCommentType.Generic Then
Me.Documentation = Doc
Exit Sub
End If
Dim ParamComments As MatchCollection = ParamTag.Matches(XmlComments)
Dim DetailedDoc As Comments.MethodComment = CType(Doc, Comments.MethodComment)
For Each PC As Match In ParamComments
Dim CommentType As String = PC.Groups("CommentType").Value
Dim Content As String = PC.Groups("Content").Value
Dim ParamName As String = PC.Groups("ParamName").Value
Select Case CommentType
Case "param"
DetailedDoc.Params.Add(ParamName, NormalizeComment(Content))
Case "typeparam"
DetailedDoc.TypeParams.Add(ParamName, NormalizeComment(Content))
Case "exception"
DetailedDoc.Exceptions.Add(ParamName, NormalizeComment(Content))
End Select
Next
Me.Documentation = DetailedDoc
End Sub
Public Overrides Function ToString() As String
Return Me.Declaration
End Function
End Class
Public Class ParserResult
Inherits List(Of Entity)
End Class
Public Class CodeParser
Private _Code As String
Private Shared Keywords() As String = New String() _
{"<summary>", "<remarks>", "<see>", "<seealso>", "<returns>", "<value>", _
"<param", "<typeparam", "<exception"}
Private Shared NamespaceRegex As New Regex("Namespace\s+(?<Id>([\w_][\w\d_]*))")
Private Shared ClassRegex As New Regex("(Class|Module)\s+(?<Id>([\w_][\w\d_]*))")
Private Shared EnumRegex As New Regex("Enum\s+(?<Id>([\w_][\w\d_\(\)]*))")
Private Shared StructureRegex As New Regex("Structure\s+(?<Id>([\w_][\w\d_]*))")
Private Shared InterfaceRegex As New Regex("Interface\s+(?<Id>([\w_][\w\d_]*))")
Private Shared DelegateRegex As New Regex("Delegate\s+(Sub|Function)\s+(?<Id>([\w_][\w\d_]*))")
Private Shared SubRegex As New Regex("Sub\s+(?<Id>([\w_][\w\d_]*))\(")
Private Shared FunctionRegex As New Regex("Function\s+(?<Id>([\w_][\w\d_]*))\(")
Private Shared PropertyRegex As New Regex("Property\s+(?<Id>([\w_][\w\d_]*))\(")
Private Shared ConstRegex As New Regex("Const\s+(?<Id>([\w_][\w\d_]*))")
Private Shared FieldRegex As New Regex("(Dim|Private|Public|Friend|Protected|Protected Friend|Static)\s*(Shared)?\s*(ReadOnly|WriteOnly)?\s*(?<Id>([\w_][\w\d_]*))")
Private Shared EventRegex As New Regex("Event\s+(?<Id>([\w_][\w\d_]*))")
Private Shared OperatorRegex As New Regex("Operator\s+(?<Id>(\<|\>|\=|\<\>|\+|\-|\*|\/|\\|\^|\&|\<\<|\>\>|\<\=|\>\=|And|Or|Xor|Not|IsTrue|IsFalse|Like|Mod|CType))\(")
Public Property Code() As String
Get
Return _Code
End Get
Set(ByVal value As String)
_Code = value
End Set
End Property
Sub New(ByVal FileName As String)
Me.
Code = IO.
File.
ReadAllText(FileName
)
End Sub
Sub New()
End Sub
Public Sub Load(ByVal FileName As String)
Dim B As New IO.BinaryReader(New IO.FileStream(FileName, IO.FileMode.Open))
Dim Buffer As New System.Text.StringBuilder
Do While B.BaseStream.Position < B.BaseStream.Length
Dim O As Byte = B.ReadByte
Select Case O
Case 224
Buffer.Append("à")
Case 232
Buffer.Append("è")
Case 236
Buffer.Append("ì")
Case 242
Buffer.Append("ò")
Case 249
Buffer.Append("ù")
Case 233
Buffer.Append("é")
Case Else
Buffer.Append(Chr(O))
End Select
Loop
Me.Code = Buffer.ToString
End Sub
Friend Shared Function GetTypeFromDeclaration(ByVal Declaration As String) As EntityType
If NamespaceRegex.IsMatch(Declaration) Then
Return EntityType.Namespace
End If
If ClassRegex.IsMatch(Declaration) Then
Return EntityType.Class
End If
If EnumRegex.IsMatch(Declaration) Then
Return EntityType.Enumerator
End If
If StructureRegex.IsMatch(Declaration) Then
Return EntityType.Structure
End If
If InterfaceRegex.IsMatch(Declaration) Then
Return EntityType.Interface
End If
If DelegateRegex.IsMatch(Declaration) Then
Return EntityType.Delegate
End If
If SubRegex.IsMatch(Declaration) Then
Return EntityType.Sub
End If
If FunctionRegex.IsMatch(Declaration) Then
Return EntityType.Function
End If
If PropertyRegex.IsMatch(Declaration) Then
Return EntityType.Property
End If
If EventRegex.IsMatch(Declaration) Then
Return EntityType.Event
End If
If ConstRegex.IsMatch(Declaration) Then
Return EntityType.Const
End If
If OperatorRegex.IsMatch(Declaration) Then
Return EntityType.Operator
End If
If FieldRegex.IsMatch(Declaration) Then
Return EntityType.Field
End If
Return EntityType.None
End Function
Friend Shared Function GetNameFromDeclaration(ByVal Declaration As String) As String
Dim Regexes() As Regex = New Regex() _
{NamespaceRegex, ClassRegex, EnumRegex, StructureRegex, InterfaceRegex, _
DelegateRegex, SubRegex, FunctionRegex, PropertyRegex, EventRegex, ConstRegex, _
OperatorRegex, FieldRegex}
Dim M As Match
For Each R As Regex In Regexes
M = R.Match(Declaration)
If M.Success Then
Return M.Groups("Id").Value
End If
Next
Return ""
End Function
Friend Shared Function GetNameFromType(ByVal Type As EntityType)
Select Case Type
Case EntityType.Class
Return "Classe"
Case EntityType.Delegate
Return "Delegato"
Case EntityType.Enumerator
Return "Enumeratore"
Case EntityType.Field
Return "Campo"
Case EntityType.Function
Return "Funzione"
Case EntityType.Interface
Return "Interfaccia"
Case EntityType.Namespace
Return "Spazio dei nomi"
Case EntityType.Property
Return "Proprietà"
Case EntityType.Structure
Return "Struttura"
Case EntityType.Sub
Return "Procedura"
Case EntityType.Event
Return "Evento"
Case EntityType.Const
Return "Costante"
Case EntityType.Operator
Return "Operatore"
Case EntityType.None
Return ""
End Select
Return ""
End Function
Public Function ParseCode() As ParserResult
Dim Result As New ParserResult
Dim Reader As New IO.StringReader(Me.Code)
Dim XmlStarted As Boolean = False
Dim Line As String
Dim TempXml As New System.Text.StringBuilder()
Dim CurrentEntity As Entity = Nothing
Dim CurrentBlock As EntityType = EntityType.None
Do While Reader.Peek >= 0
Line = Reader.ReadLine
If (Not XmlStarted) And (Line.Contains("'''")) Then
'Inzia un commento xml
For Each Keyword As String In Keywords
If Line.Contains(Keyword) Then
XmlStarted = True
Exit For
End If
Next
End If
If (Not XmlStarted) Then
'Inizia un contenitore (classe/namespace/struttura/enumeratore/interfaccia)
'(Not Line.Contains("Private")) And (Not Line.Contains("Protected")) And _
If GetTypeFromDeclaration(Line) <> EntityType.None Then
Dim El As Entity = Entity.CreateFromDeclaration(Line)
If (Not Entity.IsTypeContainer(CurrentBlock)) And _
(El.Type = EntityType.Field Or El.Type = EntityType.Const Or El.Type = EntityType.Event) Then
'Variabili e costanti locali non vengono contate
Else
If Not El.IsOneLine Then
'Nelle interfacce, i membri non hanno corpo, e i
'i membri MustOverride nemmeno
If Not (CurrentBlock = EntityType.Interface Or El.Declaration.Contains("MustOverride")) Then
CurrentBlock = El.Type
End If
End If
If CurrentEntity Is Nothing Then
CurrentEntity = El
Result.Add(El)
Else
El.Parent = CurrentEntity
CurrentEntity.Children.Add(El)
If El.IsContainer Then
CurrentEntity = El
End If
End If
End If
End If
End If
If (XmlStarted) And (Not Line.Contains("'''")) Then
'Attributo custom
If (Line.Contains("<") Or Line.Contains(">")) And (Not Line.Contains("Shared Operator")) Then
Continue Do
End If
'Finisce il commento xml, inizia una dichiarazione
'(Not Line.Contains("Private")) And (Not Line.Contains("Protected")) And _
If GetTypeFromDeclaration(Line) <> EntityType.None Then
Dim El As Entity = Entity.CreateFromDeclaration(Line)
'I "_" continuano la dichiarazione
Do While Line.EndsWith("_")
Line = Reader.ReadLine
El.Declaration &= Line
Loop
El.ParseDocumentation(TempXml.ToString)
If (Not Entity.IsTypeContainer(CurrentBlock)) And _
(El.Type = EntityType.Field Or El.Type = EntityType.Const Or El.Type = EntityType.Event) Then
'Variabili e costanti locali non vengono contate
Else
If Not El.IsOneLine Then
'Nelle interfacce, i membri non hanno corpo, e i
'i membri MustOverride nemmeno
If Not (CurrentBlock = EntityType.Interface Or El.Declaration.Contains("MustOverride")) Then
CurrentBlock = El.Type
End If
End If
If CurrentEntity Is Nothing Then
CurrentEntity = El
Result.Add(El)
Else
El.Parent = CurrentEntity
CurrentEntity.Children.Add(El)
If El.IsContainer Then
CurrentEntity = El
End If
End If
End If
End If
XmlStarted = False
TempXml.Remove(0, TempXml.Length)
End If
If Line.Contains("End Class") Or Line.Contains("End Namespace") Or _
Line.Contains("End Interface") Or Line.Contains("End Enum") Or _
Line.Contains("End Structure") Then
'Finisce un contenitore
CurrentEntity = CurrentEntity.Parent
If CurrentEntity IsNot Nothing Then
CurrentBlock = CurrentEntity.Type
Else
CurrentBlock = EntityType.None
End If
End If
If Line.Contains("End Sub") Or Line.Contains("End Function") Or _
Line.Contains("End Event") Or Line.Contains("End Property") Or Line.Contains("End Operator") Then
CurrentBlock = CurrentEntity.Type
End If
If XmlStarted Then
'Continue il commento xml
TempXml.AppendLine(Line)
End If
Loop
Reader.Close()
Return Result
End Function
End Class
End Namespace