3

私はこのようなXMLドキュメントを持っています：

<article>
  <author>Smith</author>
  <date>2011-10-10</date>
  <description>Article about <b>frobnitz</b>, crulps and furtikurty's. Mainly frobnitz</description>
</article>

これをPerlで解析してから、いくつかの単語やフレーズの周りに新しいタグを追加する必要があります（たとえば、定義にリンクするため）。ターゲット単語の最初のインスタンスのみにタグを付け、特定のタグに含まれるものだけに検索を絞り込みます（たとえば、descriptionタグのみ）。

XML :: Twigで解析し、descriptionタグに「twig_handler」を設定できます。しかし、$ node-> textを呼び出すと、間にあるタグが削除されたテキストが表示されます。本当に私がやりたいのは、既存のタグが保持され、壊れないように、（非常に小さい）ツリーをトラバースすることです。したがって、最終的なXML出力は次のようになります。

<article>
  <author>Smith</author>
  <date>2011-10-10</date>
  <description>Article about <b><a href="dictionary.html#frobnitz">frobnitz</a></b>, <a href="dictionary.html#crulps">crulps</a> and <a href="dictionary.html#furtikurty">furtikurty</a>'s. Mainly frobnitz</description>
</article>

ターゲット環境でXML::LibXMLも使用できますが、そこから開始する方法がわかりません...

これが私のこれまでの最小限のテストケースです。助けに感謝します！

#!/usr/bin/perl
use strict;
use warnings;

use XML::Twig;

my %dictionary = (
    frobnitz    => 'dictionary.html#frobnitz',
    crulps      => 'dictionary.html#crulps',
    furtykurty  => 'dictionary.html#furtykurty',
    );

sub markup_plain_text { 
    my ( $text ) = @_;

    foreach my $k ( keys %dictionary ) {
        $text =~ s/(^|\W)($k)(\W|$)}/$1<a href="$dictionary{$k}">$2<\/a>$3/si;
    }

    return $text;
}

sub convert {
    my( $t, $node ) = @_;
    warn "convert: TEXT=[" . $node->text . "]\n";
    $node->set_text( markup_plain_text($node->text) );
    return 1;
}

sub markup {
    my ( $text ) = @_;

    my $t = XML::Twig->new(
        twig_handlers => { description => \&convert },
        pretty_print  => 'indented',
        );
    $t->parse( $text );

    return $t->flush;
}


my $orig = <<END_XML;
<article>
    <author>Smith</author>
    <date>2011-10-10</date>
    <description>Article about <b>frobnitz</b>, crulps and furtikurty's. Mainly frobnitz's</description>
</article>
END_XML
;

markup($orig);
4

1 に答える 1

3

これは少し注意が必要ですが、XML :: Twigはこの種の処理用に設計されています（そして私はそれを頻繁に使用しています）。markしたがって、正規表現を受け取り、一致にタグを付ける、と呼ばれる特定のメソッドがあります。

この場合、正規表現はかなり大きくなる可能性があります。Regexp :: Assempbleを使用してビルドしたので、最適化されます。次に、別の問題はmark、一致のテキストを使用して属性を設定できないことです（これは、モジュールの次のバージョンで作業する可能性があります。これは便利です）。そのため、最初にマークを付けてから、戻ってhref、2番目のパスで属性を設定します（いずれの場合も、すでにリンクされている単語を「リンク解除」するには、2番目のパスが必要です）。

最後に、サンプルデータにいくつかのタイプミスがあるため、ソリューションの作成をあきらめかけました。コードを正しく取得することほど悪いことはありません。コードで「辞書」を使用し、データで「定義」を使用するか、「furtykurtle」、「furtikurty」、「furtijurty」をすべて使用するため、テストが失敗することを確認するだけです。同じ言葉である。したがって、投稿する前に、データが正しいことを確認してください。ありがたいことに、私はテストとしてコードを書いていました。

#!/usr/bin/perl 

use strict;
use warnings;

use XML::Twig;
use Regexp::Assemble;

use Test::More tests => 1; 
use autodie qw(open);

my %dictionary = (
    frobnitz    => 'definitions.html#frobnitz',
    crulps      => 'definitions.html#crulps',
    furtikurty  => 'definitions.html#furtikurty',
    );

my $match_defs= Regexp::Assemble->new()
                                ->add( keys %dictionary)
                                ->anchor_word
                                ->as_string;
# I am not familiar enough with Regexp::Assemble to know a cleaner
# way to get get the capturing braces in the regexp
$match_defs= qr/($match_defs)/; 

my $in       = data_para(); 
my $expected = data_para();
my $out;
open( my $out_fh, '>', \$out);


XML::Twig->new( twig_roots => { 'description' => sub { tag_defs( @_, $out_fh, $match_defs, \%dictionary); } },
                twig_print_outside_roots => $out_fh, 
              )
         ->parse( $in);

is( $out, $expected, 'base test');
exit;

sub tag_defs
  { my( $t, $description, $out_fh, $match_defs, $dictionary)= @_;

    my @a= $description->mark( $match_defs, 'a' );

    # word => 1 when already used in this description
    # this might need to have a different scope if you need to tag
    # only the first time the word appears in a section or whatever
    my $tagged_in_description; 

    foreach my $a (@a) 
      { my $word= $a->text;
        warn "checking a: ", $a->sprint, "\n";

        if( $tagged_in_description->{$word})
          { $a->erase; } # we did not need to tag it after all
        else
          { $a->set_att( href => $dictionary->{$word}); }
        $tagged_in_description->{$word}++;
      }

    $t->flush( $out_fh); }


sub def_href
  { my( $word)= @_;
    return $dictionary{word};
  }

sub data_para
  { local $/="\n\n";
    my $para= <DATA>;
    return $para;
  }

__DATA__
<article>
  <author>Smith</author>
  <date>2011-10-10</date>
  <description>Article about <b>frobnitz</b>, crulps and furtikurty's. Mainly frobnitz</description>
</article>

<article>
  <author>Smith</author>
  <date>2011-10-10</date>
  <description>Article about <b><a href="definitions.html#frobnitz">frobnitz</a></b>, <a href="definitions.html#crulps">crulps</a> and <a href="definitions.html#furtikurty">furtikurty</a>'s. Mainly frobnitz</description>
</article>
于 2011-05-12T08:19:00.273 に答える