Changeset 465 for trunk/Include/Classes/ActiveBasic/Xml/Parser.ab

Timestamp:

Mar 8, 2008, 4:52:01 PM (17 years ago)

Author:

dai

Message:

・ActiveBasic.Xml.Parserを仮実装。
・SerializeTestのテストケースを追加。
・SimpleTestCaseにおいて、一時ディレクトリを扱えるようにした。
・XmlTestのテストケースを更新。

File:

• trunk/Include/Classes/ActiveBasic/Xml/Parser.ab (modified) (1 diff)

trunk/Include/Classes/ActiveBasic/Xml/Parser.ab

@@ -3 +3 @@
 
 
+Class ParserException
+    Inherits System.Exception
+Public
+    Sub ParserException( message As String )
+        Exception( message )
+    End Sub
+End Class
+
 Class Parser
+    xmlString As String
+    currentIndex As Long
+
+    doc As System.Xml.XmlDocument
+
+    Static Const tokenLPar = &H3C       ' <
+    Static Const tokenRPar = &H3E       ' >
+    Static Const tokenSlash = &H2F  ' /
+    Static Const xmlHeaderStr = "<?xml"
+    Static Const commentHeader = "<!--"
+    Static Const cdataHeader = "<![CDATA["
+    Static Const dtdHeader = "<!"
+    Static Const versionAttributeName = "version"
+    Static Const encodingAttributeName = "encoding"
+
+    Static Function IsAlpha( c As Char ) As Boolean
+        Return ( &H41 <= c and c <= &H5A or &H61 <= c and c <= &H7A )
+    End Function
+
+    Static Function IsUnderscore( c As Char ) As Boolean
+        Return ( c = &H5F )
+    End Function
+
+    Static Function IsNumber( c As Char ) As Boolean
+        Return ( &H30 <= c and c <= &H39 )
+    End Function
+
+    Static Function IsWhiteSpace( c As Char ) As Boolean
+        If c = &H20 Then
+            ' 空白
+            Return True
+        ElseIf c = &H09 Then
+            ' タブ文字
+            Return True
+        ElseIf c = &H0A or c = &H0D Then
+            ' 改行
+            Return True
+        End If
+        ' その他
+        Return False
+    End Function
+
+    Sub ts()
+        MessageBox(0,xmlString.Substring(currentIndex),"test",0)
+    End Sub
+
+    Function StringWordEquals( src As String ) As Boolean
+        Dim nextChar = xmlString[currentIndex + src.Length] As Char
+        Return ( xmlString.Substring( currentIndex, src.Length ) = src and Not (IsAlpha( nextChar ) or IsUnderscore( nextChar ) or IsNumber( nextChar ) ) )
+    End Function
+
+    Function ReadName() As String
+        Dim startIndex = currentIndex
+
+        Dim c = xmlString[currentIndex] As Char
+
+        If Not( IsAlpha( c ) or IsUnderscore( c ) ) Then
+            Throw New ParserException( Ex"タグ名がアルファベットまたはアンダースコアから始まっていない" )
+        End If
+
+        While IsAlpha( c ) or IsUnderscore( c ) or IsNumber( c )
+            currentIndex++
+            c = xmlString[currentIndex] As Char
+        Wend
+
+        Return xmlString.Substring( startIndex, currentIndex - startIndex )
+    End Function
+
+    Function ReadStringInDoubleQuotes() As String
+        ' '\"'分を進める
+        currentIndex++
+
+        Dim startIndex = currentIndex
+        Dim endIndex = 0 As Long
+
+        Do
+            If xmlString[currentIndex] = 0 Then
+                Throw New ParserException( Ex"属性の値の閉じ側のダブルクォートが存在しない" )
+            End If
+
+            If xmlString[currentIndex] = &H and xmlString[currentIndex+1] = &H22 Then
+                ' エスケープシーケンス付きのダブルクォートは無視
+                currentIndex += 2
+                Continue
+            End If
+
+            If xmlString[currentIndex] = &H22 Then  ' '\"'
+                ' 閉じ側のダブルクォート
+                endIndex = currentIndex
+                currentIndex++
+                Exit Do
+            End If
+
+            currentIndex++
+        Loop
+
+        Return xmlString.Substring( startIndex, endIndex - startIndex )
+    End Function
+
+    Function ReadAttribute() As System.Xml.XmlAttribute
+        Dim attributeName = ReadName()
+        SkipWhiteSpace()
+
+        Dim atr = doc.CreateAttribute( attributeName )
+
+        If Not xmlString[currentIndex] = &H3D Then  ' '='
+            Return atr
+        End If
+
+        currentIndex++ ' '='分を進める
+        SkipWhiteSpace()
+
+        If Not xmlString[currentIndex] = &H22 Then  '\"'
+            Throw New ParserException( Ex"属性の値がダブルクォートで囲まれていない" )
+        End If
+
+        atr.Value = ReadStringInDoubleQuotes()
+
+        Return atr
+    End Function
+
+    Function ReadTextArea() As String
+        Dim startIndex = currentIndex
+
+        While Not ( xmlString[currentIndex] = tokenLPar or xmlString[currentIndex] = 0 )
+            currentIndex++
+        Wend
+
+        Return xmlString.Substring( startIndex, currentIndex - startIndex )
+    End Function
+
+    Sub SkipWhiteSpace()
+        While IsWhiteSpace( xmlString[currentIndex] )
+            currentIndex++
+        Wend
+    End Sub
+
+    Function ParseDeclaration() As System.Xml.XmlDeclaration
+        Dim versionStr = Nothing As String
+        Dim encodingStr = Nothing As String
+        currentIndex += xmlHeaderStr.Length
+
+        SkipWhiteSpace()
+
+        Do
+            If xmlString[currentIndex] = 0 Then
+                Throw New ParserException( Ex"タグの閉じ括弧が見つからない" )
+            End If
+            If xmlString[currentIndex] = tokenRPar Then
+                currentIndex ++
+                Exit Do
+            End If
+
+            currentIndex ++
+        Loop
+
+        Return doc.CreateXmlDeclaration( "1.0", "shift-jis", Nothing )
+    End Function
+    Function ParseComment() As System.Xml.XmlNode
+    End Function
+    Function ParseCData() As System.Xml.XmlNode
+    End Function
+    Function ParseDtd() As System.Xml.XmlNode
+    End Function
+    Function ParseElement() As System.Xml.XmlElement
+        ' '<'分を進める
+        currentIndex++
+
+        ' タグ名を取得し、要素を作成
+        Dim name = ReadName()
+        Dim xmlElement = doc.CreateElement( name )
+
+        SkipWhiteSpace()
+
+        Do
+            If xmlString[currentIndex] = 0 Then
+                Throw New ParserException( Ex"タグの閉じ括弧が見つからない" )
+            End If
+            If xmlString[currentIndex] = tokenRPar or ( xmlString[currentIndex] = tokenSlash and xmlString[currentIndex+1] = tokenRPar ) Then
+                Exit Do
+            End If
+
+            ' 属性を取得し、要素に追加
+            xmlElement.Attributes.Add( ReadAttribute() )
+
+            SkipWhiteSpace()
+        Loop
+
+        Dim closeTagStr = "</" + xmlElement.LocalName + ">"
+
+        If xmlString[currentIndex] = tokenRPar Then ' '>'
+            ' ">" で閉じられている
+            currentIndex ++
+
+            Do
+                SkipWhiteSpace()
+
+                If xmlString[currentIndex] = 0 Then
+                    Throw New ParserException( xmlElement.LocalName + Ex"の閉じタグが見つからない" )
+                End If
+
+                If xmlString[currentIndex] = tokenLPar Then ' '<'
+                    ' タグ
+                    If StringWordEquals( closeTagStr ) Then
+                        ' タグが閉じられた
+                        currentIndex += closeTagStr.Length
+                        Exit Do
+                    End If
+
+                    xmlElement.AppendChild( ParseNode() )
+                Else
+                    ' タグ以外
+                    xmlElement.AppendChild( doc.CreateTextNode( ReadTextArea() ) )
+                End If
+            Loop
+        Else
+            ' "/>" で閉じられている
+            currentIndex += 2
+        End If
+
+        Return xmlElement
+    End Function
+
+    Function ParseNode() As System.Xml.XmlNode
+        If Not xmlString[currentIndex] = tokenLPar Then
+            ' "<" で開始できないとき
+            Throw New ParserException( Ex"\q<\q で開始できない" )
+        End If
+
+        If StringWordEquals( xmlHeaderStr ) Then
+            ' XMLヘッダ
+            Return ParseDeclaration()
+        ElseIf StringWordEquals( commentHeader ) Then
+            ' コメントヘッダ
+            Return ParseComment()
+        ElseIf StringWordEquals( cdataHeader ) Then
+            ' CDATAヘッダ
+            Return ParseCData()
+        ElseIf StringWordEquals( dtdHeader ) Then
+            ' DTDヘッダ
+            Return ParseDtd()
+        Else
+            ' その他のタグ
+            Return ParseElement()
+        End If
+    End Function
+
 Public
-    Static Function Parse( xmlString As String, doc As System.Xml.XmlDocument ) As Boolean
-    End Function
+
+    Sub Parser( xmlString As String, doc As System.Xml.XmlDocument )
+        This.xmlString = xmlString
+        This.doc = doc
+    End Sub
+
+    Sub Parse()
+        This.currentIndex = 0
+        This.doc.RemoveAll()
+
+        SkipWhiteSpace()
+
+        While currentIndex < xmlString.Length
+
+            This.doc.AppendChild( ParseNode() )
+
+            SkipWhiteSpace()
+        Wend
+    End Sub
+
+    Static Sub Parse( xmlString As String, doc As System.Xml.XmlDocument )
+        Dim parser = New Parser( xmlString, doc )
+        parser.Parse()
+    End Sub
 End Class