VB.NETでもXMLを扱いたい(その5)

jyuch.hatenablog.com

はじめに

今まですごくダラダラやってましたが、今回が最後だと思います。

今回はDOMとXPathを用います。LINQ to XMLはお休みです。

サンプルXML

今回のためにサンプルXMLをかなり改変しました。

<?xml version="1.0" encoding="utf-8" ?>
<mailbox xmlns="http://jyuch.com/mailbox"
         xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
         xsi:schemaLocation="http://jyuch.com/mailbox mailbox.xsd">

  <mail>
    <from name="alice" address ="alice@jyuch.com"/>
    <recipient>
      <to name="bob" address="bob@jyuch.com"/>
    </recipient>
    <subject>
      <text>Hello bob</text>
    </subject>
    <body>
      <text>Who are you?</text>
    </body>
  </mail>

  <mail>
    <from name="bob" address="bob@jyuch.com"/>
    <recipient>
      <to name="alice" address="alice@jyuch.com"/>
      <cc name="charile" address="charlie@jyuch.com"/>
    </recipient>
    <subject>
      <file path="Re_Hello_bob.txt"/>
    </subject>
    <body>
      <text>I fine thank you. And you.</text>
    </body>
  </mail>

  <mail>
    <from name="alice" address="alice@jyuch.com"/>
    <recipient>
      <to name="bob" address="bob@jyuch.com"/>
      <bcc name="dave" address="dave@jyuch.com"/>
    </recipient>
    <subject>
      <text>Re:Re:Hello bob</text>
    </subject>
    <body>
      <file path="I_Fine_Thank_you.txt"/>
    </body>
  </mail>
</mailbox>
Module Module1

    Sub Main()
        Section3()
    End Sub

    Function ReadSchema() As XmlSchema
        Dim xs As XmlSchema
        Using r = New StreamReader("mailbox.xsd")
            xs = XmlSchema.Read(r, Sub(sender, e) Console.WriteLine("{0}:{1}", e.Severity, e.Message))
        End Using
        Return xs
    End Function

    Sub Section3()
        Dim xss = New XmlSchemaSet()
        xss.Add(ReadSchema)

        Dim xdoc = New XmlDocument()
        Using r = New StreamReader("mailbox.xml")
            xdoc.Load(r)
        End Using
        xdoc.Schemas = xss

        xdoc.Validate(Sub(sender, e) Console.WriteLine("{0}:{1}", e.Severity, e.Message))

        Dim table = New XmlNamespaceManager(xdoc.NameTable)
        ' 名前空間の別名を定義
        table.AddNamespace("jm", "http://jyuch.com/mailbox")

        For Each e As XmlNode In xdoc.SelectNodes("jm:mailbox/jm:mail", table)
            Dim from = e.SelectSingleNode("jm:from", table)
            Console.WriteLine("mail/from")
            DisplayAddressAttribute(from)

            Console.WriteLine("mail/recipient/to")
            For Each re As XmlNode In e.SelectNodes("jm:recipient/jm:to", table)
                DisplayAddressAttribute(re)
            Next

            Console.WriteLine("mail/recipient/to")
            For Each re As XmlNode In e.SelectNodes("jm:recipient/jm:to", table)
                DisplayAddressAttribute(re)
            Next

            Console.WriteLine("mail/recipient/cc")
            For Each re As XmlNode In e.SelectNodes("jm:recipient/jm:cc", table)
                DisplayAddressAttribute(re)
            Next

            Console.WriteLine("mail/recipient/bcc")
            For Each re As XmlNode In e.SelectNodes("jm:recipient/jm:bcc", table)
                DisplayAddressAttribute(re)
            Next

            Console.WriteLine("mail/subject")
            Dim subject = e.SelectSingleNode("jm:subject", table)
            If subject.FirstChild.Name = "text" Then
                Console.WriteLine("text:{0}", subject.FirstChild.FirstChild.Value)
            Else
                Console.WriteLine("path:{0}", subject.FirstChild.Attributes.ItemOf("path").Value)
            End If

            Console.WriteLine("mail/body")
            Dim body = e.SelectSingleNode("jm:body", table)
            If body.FirstChild.Name = "text" Then
                Console.WriteLine("text:{0}", body.FirstChild.FirstChild.Value)
            Else
                Console.WriteLine("path:{0}", body.FirstChild.Attributes.ItemOf("path").Value)
            End If

            Console.WriteLine("----------------------------------")
            Console.WriteLine()
        Next
    End Sub

    Sub DisplayAddressAttribute(node As XmlNode)
        Console.WriteLine("name:<{0}> address:<{1}>",
                          node.Attributes.ItemOf("name").Value,
                          node.Attributes.ItemOf("address").Value)
    End Sub

End Module
mail/from
name:<alice> address:<alice@jyuch.com>
mail/recipient/to
name:<bob> address:<bob@jyuch.com>
mail/recipient/to
name:<bob> address:<bob@jyuch.com>
mail/recipient/cc
mail/recipient/bcc
mail/subject
text:Hello bob
mail/body
text:Who are you?
----------------------------------

mail/from
name:<bob> address:<bob@jyuch.com>
mail/recipient/to
name:<alice> address:<alice@jyuch.com>
mail/recipient/to
name:<alice> address:<alice@jyuch.com>
mail/recipient/cc
name:<charile> address:<charlie@jyuch.com>
mail/recipient/bcc
mail/subject
path:Re_Hello_bob.txt
mail/body
text:I fine thank you. And you.
----------------------------------

mail/from
name:<alice> address:<alice@jyuch.com>
mail/recipient/to
name:<bob> address:<bob@jyuch.com>
mail/recipient/to
name:<bob> address:<bob@jyuch.com>
mail/recipient/cc
mail/recipient/bcc
name:<dave> address:<dave@jyuch.com>
mail/subject
text:Re:Re:Hello bob
mail/body
path:I_Fine_Thank_you.txt
----------------------------------

個人的にはDOMオンリーイベントとかLINQ to XMLよりもDOMとXPathのと折衷が一番扱いやすいと思っています。 XMLを生成するにはLINQ to XMLは楽なんですけどねぇ。

順を追って見てみましょう。 XPathでは名前空間を省略できません。 また、たとえXMLの先頭で名前空間の別名がつけられていてもその前空間の別名は使えません。 当たり前ですね。 別名なんてXMLを書く人が自由に付けられるのですから、それに依存したコードは書けるべきではありません。

そこで、XmlNamespaceManagerを用いてXPath中に出てくる名前空間の別名を管理してやる必要があります。 ここではhttp://jyuch.com/mailboxという名前空間jmという別名をつけています。

あとは<mail>タグごとに分割して、そのノードコンテキスト内の各要素をXPathから取り出しています。 このノードコンテキスト内というのが結構重要で、ノード階層から横断的に要素を取り出すコードだって書けます。

しかし、ここでは意味のある塊として<mail>ごとのデータを取り出したかったのでこのようにしています。

XPathで目的のノードのXmlNodeを手に入れたらあとは属性をぶっこぬくなり値を取り出すなりご自由にどうぞといった感じです。

ちなみに、横断的なコードはこんな感じです。 ここではXML文章中の<from><to><cc><bcc>を全て取り出しています。

    Sub Section4()
        Dim xss = New XmlSchemaSet()
        xss.Add(ReadSchema)

        Dim xdoc = New XmlDocument()
        Using r = New StreamReader("mailbox.xml")
            xdoc.Load(r)
        End Using
        xdoc.Schemas = xss

        xdoc.Validate(Sub(sender, e) Console.WriteLine("{0}:{1}", e.Severity, e.Message))

        Dim table = New XmlNamespaceManager(xdoc.NameTable)
        table.AddNamespace("jm", "http://jyuch.com/mailbox")

        Dim q = New StringBuilder()
        q.Append("jm:mailbox/jm:mail/jm:from|").
            Append("jm:mailbox/jm:mail/jm:recipient/jm:to|").
            Append("jm:mailbox/jm:mail/jm:recipient/jm:cc|").
            Append("jm:mailbox/jm:mail/jm:recipient/jm:bcc")

        Dim address = xdoc.SelectNodes(q.ToString(), table)

        For Each it As XmlNode In address
            Console.WriteLine(it.Name)
            DisplayAddressAttribute(it)
        Next
    End Sub
from
name:<alice> address:<alice@jyuch.com>
to
name:<bob> address:<bob@jyuch.com>
from
name:<bob> address:<bob@jyuch.com>
to
name:<alice> address:<alice@jyuch.com>
cc
name:<charile> address:<charlie@jyuch.com>
from
name:<alice> address:<alice@jyuch.com>
to
name:<bob> address:<bob@jyuch.com>
bcc
name:<dave> address:<dave@jyuch.com>

おわり