텍스트 노드에 마크 업을 추가하기 위해 Perl에서 복잡한 XML 문서를 수정하려면 어떻게해야합니까?

Question

나는 XML 문서를 다음과 같이 있습니다

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

내가 (예 : 정의 링크) 펄이 구문을 분석하고 어떤 단어 나 문구 주위에 새 태그를 추가해야합니다. 나는 표적 단어의 첫 번째 인스턴스에만 태그를 달고 주어진 태그에있는 것 (예 : 설명 태그 만)으로 검색 범위를 좁히고 싶습니다.

XML::Twig으로 구문 분석하고 설명 태그에 "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); 

Answer 1

이 약간 까다로운 일이지만, XML :: 나뭇 가지 설계 (내가 많이 사용) 처리의 종류. 따라서 mark이라는 특정 메서드가 있으며이 메서드는 regexp를 사용하고 일치하는 태그를 지정합니다.

이 경우 정규 표현식이 상당히 클 수 있습니다. Regexp :: Assempble을 사용하여 빌드 했으므로 최적화되었습니다. 다른 문제는 mark이 성냥의 텍스트를 사용하여 속성을 설정하게하지 않는다는 것입니다 (모듈의 다음 버전에서 유용 할 수 있습니다). 그래서 먼저 표시해야합니다. 돌아가서 두 번째 패스에 href 속성을 설정하십시오 (두 번째 패스는 이미 링크 된 단어의 "링크 해제"에 필요합니다).

마지막 한 단어 : 예제 데이터에 약간의 오타가 있기 때문에 거의 해결책을 포기했습니다. 데이터에서 코드와 '정의'에 '사전'을 사용했거나 '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>