Perl の HTML::TreeBuilder で元の HTML を出力する（DOCTYPE も出力する）

先日、「Perl の HTML::TreeBuilder で元の HTML を出力する」方法を紹介したが、不十分であることが判明した。先日の Perl スクリプトでは DOCTYPE 宣言が抜け落ちてしまう。

どうやら HTML::TreeBuilder では DOCTYPE 宣言は他の要素から切り離されて、ルートオブジェクトの_decl 属性として保持しているらしい。したがって、guts の中に含まれず、完全に元の位置に戻せない。仕様がないから、processing instruction および DOCTYPE 宣言とそれ以外を分けて出力することにした。すなわち、processing instruction 以外のタグが現れたら DOCTYPE 宣言を出力する。

HTML::TreeBuilder は、XHTML の処理は想定していないんだろうなと思う。

あーだこーだと、かなり試行錯誤した修正版を以下に。

            
              #!/usr/bin/env perl
use strict;
use warnings;
use HTML::TreeBuilder;
use HTML::Element;
use Data::Dumper;

my $tree = HTML::TreeBuilder->new;
my %opts = ('store_comments'=>1 ,
            'store_pis'=>1 ,
            'no_expand_entities'=>1 ,
            'ignore_unknown'=>0 ,
            'no_space_compacting'=>1 ,
            # pis, <html> 直下のコメントの順番維持
            'implicit_tags'=>0,
            'ignore_ignorable_whitespace'=>0);
while (my ($k, $v) = each(%opts)) {
    $tree->$k($v);
}

$tree->parse_file(*DATA);
$tree->eof();
%HTML::Element::optionalEndTag = (); # end tag 省略しない。

my @guts = $tree->guts;
if ($tree->attr('_decl')) { # DOCTYPE 宣言が有る場合
    while (my ($n, $c) = each(@guts)) {
        if (ref $c ) {
            unless ($c->attr('_tag') eq '~pi') {
                # processing instruction 以外のタグの出現で DOCTYPE 宣言を出力
                print $tree->attr('_decl')->as_HTML, "\n";
                print $c->as_HTML('', '  ');
                last;
            }
            print $c->as_HTML, "\n";
        }
    }
}

while (my ($n, $c) = each(@guts)) {
    print ref $c ? $c->as_HTML('', ' ') : $c;
    # ２番目の引数をしてないと、改行が無い HTML が出力される。
}

__DATA__
<?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html>
  <!-- comment1 -->
  <head>
    <meta http-equiv="content-type" content="text/html;charset=utf-8" />
    <title>page title</title>
  </head>
  <body>
  <p>paragraph1</p>
  <ul>
  <li>item1</li>
  </ul>
  </body>
</html>

            