Changeset 465


Ignore:
Timestamp:
Mar 8, 2008, 4:52:01 PM (16 years ago)
Author:
dai
Message:

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

Location:
trunk
Files:
1 added
5 edited

Legend:

Unmodified
Added
Removed

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

    r452 r465  
    33
    44
     5Class ParserException
     6    Inherits System.Exception
     7Public
     8    Sub ParserException( message As String )
     9        Exception( message )
     10    End Sub
     11End Class
     12
    513Class Parser
     14    xmlString As String
     15    currentIndex As Long
     16
     17    doc As System.Xml.XmlDocument
     18
     19    Static Const tokenLPar = &H3C       ' <
     20    Static Const tokenRPar = &H3E       ' >
     21    Static Const tokenSlash = &H2F  ' /
     22    Static Const xmlHeaderStr = "<?xml"
     23    Static Const commentHeader = "<!--"
     24    Static Const cdataHeader = "<![CDATA["
     25    Static Const dtdHeader = "<!"
     26    Static Const versionAttributeName = "version"
     27    Static Const encodingAttributeName = "encoding"
     28
     29    Static Function IsAlpha( c As Char ) As Boolean
     30        Return ( &H41 <= c and c <= &H5A or &H61 <= c and c <= &H7A )
     31    End Function
     32
     33    Static Function IsUnderscore( c As Char ) As Boolean
     34        Return ( c = &H5F )
     35    End Function
     36
     37    Static Function IsNumber( c As Char ) As Boolean
     38        Return ( &H30 <= c and c <= &H39 )
     39    End Function
     40
     41    Static Function IsWhiteSpace( c As Char ) As Boolean
     42        If c = &H20 Then
     43            ' 空白
     44            Return True
     45        ElseIf c = &H09 Then
     46            ' タブ文字
     47            Return True
     48        ElseIf c = &H0A or c = &H0D Then
     49            ' 改行
     50            Return True
     51        End If
     52        ' その他
     53        Return False
     54    End Function
     55
     56    Sub ts()
     57        MessageBox(0,xmlString.Substring(currentIndex),"test",0)
     58    End Sub
     59
     60    Function StringWordEquals( src As String ) As Boolean
     61        Dim nextChar = xmlString[currentIndex + src.Length] As Char
     62        Return ( xmlString.Substring( currentIndex, src.Length ) = src and Not (IsAlpha( nextChar ) or IsUnderscore( nextChar ) or IsNumber( nextChar ) ) )
     63    End Function
     64
     65    Function ReadName() As String
     66        Dim startIndex = currentIndex
     67
     68        Dim c = xmlString[currentIndex] As Char
     69
     70        If Not( IsAlpha( c ) or IsUnderscore( c ) ) Then
     71            Throw New ParserException( Ex"タグ名がアルファベットまたはアンダースコアから始まっていない" )
     72        End If
     73
     74        While IsAlpha( c ) or IsUnderscore( c ) or IsNumber( c )
     75            currentIndex++
     76            c = xmlString[currentIndex] As Char
     77        Wend
     78
     79        Return xmlString.Substring( startIndex, currentIndex - startIndex )
     80    End Function
     81
     82    Function ReadStringInDoubleQuotes() As String
     83        ' '\"'分を進める
     84        currentIndex++
     85
     86        Dim startIndex = currentIndex
     87        Dim endIndex = 0 As Long
     88
     89        Do
     90            If xmlString[currentIndex] = 0 Then
     91                Throw New ParserException( Ex"属性の値の閉じ側のダブルクォートが存在しない" )
     92            End If
     93
     94            If xmlString[currentIndex] = &H and xmlString[currentIndex+1] = &H22 Then
     95                ' エスケープシーケンス付きのダブルクォートは無視
     96                currentIndex += 2
     97                Continue
     98            End If
     99
     100            If xmlString[currentIndex] = &H22 Then  ' '\"'
     101                ' 閉じ側のダブルクォート
     102                endIndex = currentIndex
     103                currentIndex++
     104                Exit Do
     105            End If
     106
     107            currentIndex++
     108        Loop
     109
     110        Return xmlString.Substring( startIndex, endIndex - startIndex )
     111    End Function
     112
     113    Function ReadAttribute() As System.Xml.XmlAttribute
     114        Dim attributeName = ReadName()
     115        SkipWhiteSpace()
     116
     117        Dim atr = doc.CreateAttribute( attributeName )
     118
     119        If Not xmlString[currentIndex] = &H3D Then  ' '='
     120            Return atr
     121        End If
     122
     123        currentIndex++ ' '='分を進める
     124        SkipWhiteSpace()
     125
     126        If Not xmlString[currentIndex] = &H22 Then  '\"'
     127            Throw New ParserException( Ex"属性の値がダブルクォートで囲まれていない" )
     128        End If
     129
     130        atr.Value = ReadStringInDoubleQuotes()
     131
     132        Return atr
     133    End Function
     134
     135    Function ReadTextArea() As String
     136        Dim startIndex = currentIndex
     137
     138        While Not ( xmlString[currentIndex] = tokenLPar or xmlString[currentIndex] = 0 )
     139            currentIndex++
     140        Wend
     141
     142        Return xmlString.Substring( startIndex, currentIndex - startIndex )
     143    End Function
     144
     145    Sub SkipWhiteSpace()
     146        While IsWhiteSpace( xmlString[currentIndex] )
     147            currentIndex++
     148        Wend
     149    End Sub
     150
     151    Function ParseDeclaration() As System.Xml.XmlDeclaration
     152        Dim versionStr = Nothing As String
     153        Dim encodingStr = Nothing As String
     154        currentIndex += xmlHeaderStr.Length
     155
     156        SkipWhiteSpace()
     157
     158        Do
     159            If xmlString[currentIndex] = 0 Then
     160                Throw New ParserException( Ex"タグの閉じ括弧が見つからない" )
     161            End If
     162            If xmlString[currentIndex] = tokenRPar Then
     163                currentIndex ++
     164                Exit Do
     165            End If
     166
     167            currentIndex ++
     168        Loop
     169
     170        Return doc.CreateXmlDeclaration( "1.0", "shift-jis", Nothing )
     171    End Function
     172    Function ParseComment() As System.Xml.XmlNode
     173    End Function
     174    Function ParseCData() As System.Xml.XmlNode
     175    End Function
     176    Function ParseDtd() As System.Xml.XmlNode
     177    End Function
     178    Function ParseElement() As System.Xml.XmlElement
     179        ' '<'分を進める
     180        currentIndex++
     181
     182        ' タグ名を取得し、要素を作成
     183        Dim name = ReadName()
     184        Dim xmlElement = doc.CreateElement( name )
     185
     186        SkipWhiteSpace()
     187
     188        Do
     189            If xmlString[currentIndex] = 0 Then
     190                Throw New ParserException( Ex"タグの閉じ括弧が見つからない" )
     191            End If
     192            If xmlString[currentIndex] = tokenRPar or ( xmlString[currentIndex] = tokenSlash and xmlString[currentIndex+1] = tokenRPar ) Then
     193                Exit Do
     194            End If
     195
     196            ' 属性を取得し、要素に追加
     197            xmlElement.Attributes.Add( ReadAttribute() )
     198
     199            SkipWhiteSpace()
     200        Loop
     201
     202        Dim closeTagStr = "</" + xmlElement.LocalName + ">"
     203
     204        If xmlString[currentIndex] = tokenRPar Then ' '>'
     205            ' ">" で閉じられている
     206            currentIndex ++
     207
     208            Do
     209                SkipWhiteSpace()
     210
     211                If xmlString[currentIndex] = 0 Then
     212                    Throw New ParserException( xmlElement.LocalName + Ex"の閉じタグが見つからない" )
     213                End If
     214
     215                If xmlString[currentIndex] = tokenLPar Then ' '<'
     216                    ' タグ
     217                    If StringWordEquals( closeTagStr ) Then
     218                        ' タグが閉じられた
     219                        currentIndex += closeTagStr.Length
     220                        Exit Do
     221                    End If
     222
     223                    xmlElement.AppendChild( ParseNode() )
     224                Else
     225                    ' タグ以外
     226                    xmlElement.AppendChild( doc.CreateTextNode( ReadTextArea() ) )
     227                End If
     228            Loop
     229        Else
     230            ' "/>" で閉じられている
     231            currentIndex += 2
     232        End If
     233
     234        Return xmlElement
     235    End Function
     236
     237    Function ParseNode() As System.Xml.XmlNode
     238        If Not xmlString[currentIndex] = tokenLPar Then
     239            ' "<" で開始できないとき
     240            Throw New ParserException( Ex"\q<\q で開始できない" )
     241        End If
     242
     243        If StringWordEquals( xmlHeaderStr ) Then
     244            ' XMLヘッダ
     245            Return ParseDeclaration()
     246        ElseIf StringWordEquals( commentHeader ) Then
     247            ' コメントヘッダ
     248            Return ParseComment()
     249        ElseIf StringWordEquals( cdataHeader ) Then
     250            ' CDATAヘッダ
     251            Return ParseCData()
     252        ElseIf StringWordEquals( dtdHeader ) Then
     253            ' DTDヘッダ
     254            Return ParseDtd()
     255        Else
     256            ' その他のタグ
     257            Return ParseElement()
     258        End If
     259    End Function
     260
    6261Public
    7     Static Function Parse( xmlString As String, doc As System.Xml.XmlDocument ) As Boolean
    8     End Function
     262
     263    Sub Parser( xmlString As String, doc As System.Xml.XmlDocument )
     264        This.xmlString = xmlString
     265        This.doc = doc
     266    End Sub
     267
     268    Sub Parse()
     269        This.currentIndex = 0
     270        This.doc.RemoveAll()
     271
     272        SkipWhiteSpace()
     273
     274        While currentIndex < xmlString.Length
     275
     276            This.doc.AppendChild( ParseNode() )
     277
     278            SkipWhiteSpace()
     279        Wend
     280    End Sub
     281
     282    Static Sub Parse( xmlString As String, doc As System.Xml.XmlDocument )
     283        Dim parser = New Parser( xmlString, doc )
     284        parser.Parse()
     285    End Sub
    9286End Class
    10287

  • trunk/TestCase/SimpleTestCase/SimpleTestCase.ab

    r457 r465  
    44
    55Dim hStdOut = _System_hConsoleOut
     6
     7Sub Initialize()
     8    ' 初期化関数
     9
     10    ' 一時ディレクトリを空にしておく
     11    Dim tempDir = System.IO.Path.GetDirectoryName( System.Windows.Forms.Application.ExecutablePath ) + "\temp"
     12    If System.IO.Directory.Exists( tempDir ) Then
     13        ' 存在するときは一旦消す
     14        System.IO.Directory.Delete( tempDir, True )
     15    End If
     16    System.IO.Directory.CreateDirectory( tempDir )
     17End Sub
     18
     19Initialize()
    620
    721Dim csbi As CONSOLE_SCREEN_BUFFER_INFO
    … …  
    4054End Sub
    4155
     56Function GetExclusiveTempDirPath( testCaseName As String ) As String
     57    Dim tempDir = System.IO.Path.GetDirectoryName( System.Windows.Forms.Application.ExecutablePath ) + "\temp"
     58    Dim exclusiveTempDirPath = tempDir + "\" + testCaseName
     59
     60    If Not System.IO.Directory.Exists( exclusiveTempDirPath ) Then
     61        ' 無かったら作る
     62        System.IO.Directory.CreateDirectory( exclusiveTempDirPath )
     63    End If
     64
     65    Return exclusiveTempDirPath
     66End Function
     67
    4268Print "Please Enter key"
    4369System.Console.ReadLine()

  • trunk/TestCase/SimpleTestCase/SimpleTestCase.idx

    r432 r465  
    3838#include "XmlTest.ab"
    3939_ClearNamespaceImported
    40 
    41 'リソースファイル
    42 #include "resource.ab"
    43 #resource "SimpleTestCase.rc"
     40#include "SerializeTest.ab"
     41_ClearNamespaceImported

  • trunk/TestCase/SimpleTestCase/SimpleTestCase.pj

    r432 r465  
    2323#DEBUG_EXE_PATH=
    2424
    25 #RESOURCE=SimpleTestCase.rc
     25#RESOURCE=0
    2626
    2727#SOURCE
    … …  
    4444StreamTest.ab
    4545XmlTest.ab
     46SerializeTest.ab

  • trunk/TestCase/SimpleTestCase/XmlTest.ab

    r444 r465  
    33
    44Sub TestMain()
     5    ' 一時ディレクトリを取得
     6    Dim tempDir = GetExclusiveTempDirPath( "XmlTest" )
     7
    58    Dim doc = New System.Xml.XmlDocument()
    6     doc.AppendChild( doc.CreateXmlDeclaration( "1.0", "UTF-8", Nothing ) )
     9    doc.AppendChild( doc.CreateXmlDeclaration( "1.0", "shift-jis", Nothing ) )
    710    doc.AppendChild( doc.CreateElement( "root" ) )
    811    doc.ChildNodes[1].AppendChild( doc.CreateElement( "test" ) )
    … …  
    1518    doc.ChildNodes[1].Attributes.Add( attr2 )
    1619
    17     System.Diagnostics.Debug.WriteLine( doc.OuterXml() )
     20    ' 書いて
     21    doc.Save( tempDir + "\test.xml" )
     22
     23    ' 読んで
     24    Dim clone = New System.Xml.XmlDocument
     25    clone.Load( tempDir + "\test.xml" )
     26
     27    ' 比較してみる
     28    UnitTest( "XmlTest", doc.OuterXml = clone.OuterXml )
    1829End Sub
    1930
Note: See TracChangeset for help on using the changeset viewer.