PerlでXMLの扱いを学ぶための自作ドリル

Perl XML

モジュールはXML::LibXMLを使用。

問題

XML書き出しスクリプト

name, email, addressを入力して、XMLでファイルに書き出す。（項目名はプロンプトとして表示する。）
実行結果

$ perl output_xml.pl
name : 山田太郎(改行)
email : taro.yamada@xxx.com(改行)
address : 東京(改行)
name : 田中次郎(改行)
email : jiro.tanaka@yyy.com(改行)
address : 大阪(改行)
name : 阿部三郎(改行)
email : saburo.abe@zzz.com(改行)
address : 名古屋(改行)
name : (Ctrl+Dで終了)
$

書き出し結果ファイル(output_xxxxxxxxxx.xml)

<?xml version="1.0" encoding="UTF-8"?>
<addressBook>
  <person>
    <name>山田太郎</name>
    <email>taro.yamada@xxx.com</email>
    <address>東京</address>
  </person>
  <person>
    <name>田中次郎</name>
    <email>jiro.tanaka@yyy.com</email>
    <address>大阪</address>
  </person>
  <person>
    <name>阿部三郎</name>
    <email>saburo.abe@zzz.com</email>
    <address>名古屋</address>
  </person>
</addressBook>
XML読み込みスクリプト

XMLファイルを読み込み、マップ形式で画面に表示する。
読み込みファイル(output_xxxxxxxxxx.xml)

<?xml version="1.0" encoding="UTF-8"?>
<addressBook>
  <person>
    <name>山田太郎</name>
    <email>taro.yamada@xxx.com</email>
    <address>東京</address>
  </person>
  <person>
    <name>田中次郎</name>
    <email>jiro.tanaka@yyy.com</email>
    <address>大阪</address>
  </person>
  <person>
    <name>阿部三郎</name>
    <email>saburo.abe@zzz.com</email>
    <address>名古屋</address>
  </person>
</addressBook>

実行結果

$ perl input_xml.pl output_xxxxxxxxxx.xml
(1)
	name : 山田太郎
	email : taro.yamada@xxx.com
	address : 東京
(2)
	name : 田中次郎
	email : jiro.tanaka@yyy.com
	address : 大阪
(3)
	name : 阿部三郎
	email : saburo.abe@zzz.com
	address : 名古屋
$

解答例

XML書き出しスクリプト
use strict;
use warnings;
use utf8;
use XML::LibXML;

binmode STDIN, ':utf8';
binmode STDOUT, ':utf8';
binmode STDERR, ':utf8';

# 書き出しファイル名
my $xmlout_name = $ARGV[0] || 'output_' . time . '.xml';

# File Check
if (-e $xmlout_name) {
  print STDERR "$xmlout_name already exists.\n";
  exit 1;
}

# Input Data Table
my @labels = ('name', 'email', 'address');
my @table = ([]);

# XML作成
my $xml = XML::LibXML::Document->new('1.0', 'UTF-8');

# addressBookノードを作成
my $adb = XML::LibXML::Element->new('addressBook');
$xml->addChild($adb);

# 先頭のpersonノードを作成
$adb->addChild(XML::LibXML::Element->new('person'));

# Input Data
my $finish = 0;
while ($finish == 0) {
  # 最後尾のpersonノードを参照
  my $node = $adb->lastChild;
  # personノードに入っている項目数（子ノードの数）を取得
  my $cnt = ($node->hasChildNodes()) ? $node->childNodes()->size() : 0;
  # 項目数から、次の項目名を取得
  my $name = $labels[$cnt];
  # プロンプト表示
  print "$name : ";
  if (my $param = <STDIN>) {
    $param =~ s/[\r\n]//go;
    if ($param ne '') {
      # 入力データを新しいノードとして、personに追加
      my $data = XML::LibXML::Element->new($name);
      $data->appendText($param);
      $node->addChild($data);
      # 入力項目が最後の時、次のpersonノードを追加
      if ($cnt + 1 >= @labels) {
        $adb->addChild(XML::LibXML::Element->new('person'));
      }
    }
  } else {
    $finish = 1;
    # 末尾のpersonノードに入力項目（子ノード）が無い時、ノードを除去
    $adb->removeChild($node) unless ($node->hasChildNodes());
  }
}
print "\n";

# File Double-check
if (-e $xmlout_name) {
  print STDERR "$xmlout_name already exists.\n";
  exit 1;
}

# XML Output
$xml->toFile($xmlout_name, 1);

exit 0;
XML読み込みスクリプト
use strict;
use warnings;
use utf8;
use XML::LibXML;

binmode STDIN, ':utf8';
binmode STDOUT, ':utf8';
binmode STDERR, ':utf8';

# Input Check
if (@ARGV != 1) {
  print STDERR "Please input XML file name.\n";
  exit 1;
}

# 読み込みファイル名
my $xmlin_name = $ARGV[0];

# File Check
unless (-f $xmlin_name) {
  print STDERR "$xmlin_name is not found.\n";
  exit 1;
}

# Input XML
my $xml = XML::LibXML->load_xml(location => $xmlin_name);

# 全てのpersonノードをリストで取得
my @persons = $xml->getElementsByTagName('person');

# Output XML Data
for (my $cnt = 0; $cnt < @persons; $cnt++) {
  print '(' . ($cnt + 1) . ')' . "\n";
  # personノードの（Textノードを除く）全ての子ノード（項目）をリストで取得
  my @params = ($persons[$cnt]->hasChildNodes()) ? map {(ref($_) eq 'XML::LibXML::Element') ? ($_) : ();} ($persons[$cnt]->childNodes()) : ();
  # 項目を全て表示（項目名 : 項目内容の組で）
  foreach my $node (@params) {
    print "\t" . $node->nodeName . ' : ' . $node->textContent . "\n";
  }
}

exit 0;