PerlでXMLのフィルタリング

いつもお世話になっております。Perl初心者です。

以下のサイトを参考に、XML::Parser::PerlSAX を使用して、XMLファイルをフィルタリングするプログラムを作成しようと考えています。

http://mkweb.bcgsc.ca/intranet/perlbook/pxml/ch0 …

ここで、ある要素のある属性の、異なる属性値ごとに、文字データイベントを処理する方法を変えたいのですが、どのようにすればよいでしょうか。

各種SAXイベントハンドラも、XML::Handler::Subs も考えましたが、何を使えばよいか検討がつきません。よろしくお願いします。

No.1 回答者： _--_1l1_1_ 回答日時： 2014/11/08 03:09

適当。

表示がくずれるので空白2文字を全角空白にしていることに注意。

use strict;
use warnings;
use feature 'say';
use XML::SAX;

my $xml = << "END";
<?xml version="1.0" encoding="utf-8" ?>
<pets>
　<pet>
　　<type>dog</type>
　　<name pos="1">Yamada</name>
　　<name pos="2">Taro</name>
　　<age>3.5</age>
　</pet>
　<pet>
　　<type>cat</type>
　　<name pos="1">Yamada</name>
　　<name pos="2">tama</name>
　　<age>1</age>
　</pet>
</pets>
END

my @target_hierarchy = qw(pets pet name);
my @work_hierarchy　 = ();
my $call_back　　　　= undef;
my $parser = XML::SAX::ParserFactory->parser( Handler => MySAXHandler->new );
$parser->parse_string($xml);

{
　　package MySAXHandler;
　　use base qw(XML::SAX::Base);

　　sub start_element {
　　　　my ( $self, $el ) = @_;
　　　　push @work_hierarchy, $el->{LocalName};
　　　　$call_back = undef;
　　　　if ( _check_hierarchy() ) {
　　　　　　if (　　exists( $el->{Attributes} )
　　　　　　　　and exists( $el->{Attributes}->{'{}pos'} )
　　　　　　　　and $el->{Attributes}->{'{}pos'}->{Value} )
　　　　　　{
　　　　　　　　my $posision = $el->{Attributes}->{'{}pos'}->{Value};
　　　　　　　　if ($posision eq '1') {
　　　　　　　　　　$call_back = \&_say_first;
　　　　　　　　}
　　　　　　　　elsif ($posision eq '2') {
　　　　　　　　　　$call_back = \&_say_second;
　　　　　　　　}
　　　　　　　　else {
　　　　　　　　　　warn 'Unknown ', $posision;
　　　　　　　　}
　　　　　 }
　　　　}
　　}

　　sub end_element {
　　　　my ( $self, $el ) = @_;
　　　　$call_back = undef;
　　　　pop @work_hierarchy;
　　}

　　sub characters {
　　　　my ($self, $data) = @_;
　　　　if ( defined $call_back ) {
　　　　　　$call_back->( $data->{Data} );
　　　　}
　　}

　　sub _check_hierarchy {
　　　　if ( $#target_hierarchy != $#work_hierarchy ) {
　　　　　　return 0;
　　　　}
　　　　else {
　　　　　　for ( my $i = 0; $i <= $#target_hierarchy; $i++ ) {
　　　　　　　　return 0 if ( $target_hierarchy[$i] ne $work_hierarchy[$i] );
　　　　　 }
　　　　　　return 1;
　　　　}
　　}

　　sub _say_first {
　　　　my $name = shift;
　　　　say "1: $name";
　　}

　　sub _say_second {
　　　　my $name = shift;
　　　　say "2: $name";
　　　　say '---';
　　}

　　1;
}

------
$ perl -w foo.pl
1: Yamada
2: Taro
---
1: Yamada
2: tama
---

この回答へのお礼

ご回答ありがとうございました。
スクリプト全体をご提供いただきありがとうございます。
早期にご回答いただいたにも関わらず、メールの連絡がされず、気がついていませんでした。
自分でも無事、自己解決しました。
いただいたスクリプトも今後、研究させていただきます。

お礼日時：2014/12/05 08:37