RSSを扱う用事があったので、普通のRSSリーダを使ってたけども、
ふと、SAXパーサを使って読み取ってみたくなったので、試した。
DOMだと全体を読み取らないとダメなので、場合によってはメモリを食べてしまう。
SAXなら上から読み取って、いくつかのタイミング(要素の始まりを読み取った、等)でメソッドを呼び出すような仕組みで、全体を読み取らないでXMLを読むことができる。
RSSの場合は、次のitemを読むのに前のitemの情報は必要ないので、
DOMみたいに全部を読み取るより、SAXで読取りつつ実行するほうが向いてるのかなーって思ったわけです。
それを利用したハンドラを書いてみたけども、
SAXは与えられた情報だけでは、今自分がどの要素(element)にいるのか、というのがわからない欠点がある。
つまり、どの要素を辿ったか、という情報を記憶しておく必要がある。
もちろん、attributeなどのその間の情報も記憶しておく必要がある。
もっとうまい方法があるのかなぁ。
XML::SAX::ElementCallbackHandler.pm
package XML::SAX::ElementCallbackHandler; use strict; use warnings; use base qw(XML::SAX::Base); use Encode; use 5.10.1; use constant ELEMENT_CALLBACK_KEY => 0; use constant ELEMENT_CALLBACK_CODE => 1; our $SOF_THRESHOLD = 255; our $STRING_THRESHOLD = 1024*1024; sub new{ my $class = shift; my %args = @_; my $element_callback_array_ref = delete $args{element_callback} || []; my $self = $class->SUPER::new(%args); $self->{element_stack} = []; $self->{element_callback} = []; $self->{object_stack} = []; $self->_parse_element_callback_ref($element_callback_array_ref); return $self; } sub add_element_callback{ my $self = shift; my $key = shift; my $val = shift; if(ref $val ne 'CODE'){ die 'add_element_callback error. $val is not CODE reference.' } $key = qr/$key$/; my $index = $self->_match_element_key_index($key); if($index != -1){ $self->{element_callback}->[$index] = $val; }else{ push @{$self->{element_callback}}, [$key, $val]; } } sub _parse_element_callback_ref{ my $self = shift; my $array_ref = shift; if(ref $array_ref ne 'ARRAY'){ die 'not array referense.'; } for(my $i=0; $i<@$array_ref; $i+=2){ $self->add_element_callback($array_ref->[$i], $array_ref->[$i+1]); } } sub _match_element_key_index{ my $self = shift; my $elem = shift; my $pair_ref = $self->{element_callback}; my $length = @{$pair_ref}; for(my $i=0; $i<$length; ++$i){ my $ref = $pair_ref->[$i]; if($elem eq $ref->[ELEMENT_CALLBACK_KEY]){ return $i; } } return -1; } sub _match_element_index{ my $self = shift; my $elem = shift; my $pair_ref = $self->{element_callback}; my $length = @{$pair_ref}; for(my $i=0; $i<$length; ++$i){ my $ref = $pair_ref->[$i]; if($elem =~ $ref->[ELEMENT_CALLBACK_KEY]){ return $i; } } return -1; } sub _get_element_callback{ my $self = shift; my $elem = shift; my $index = $self->_match_element_index($elem); return $index == -1 ? undef : $self->{element_callback}->[$index]->[ELEMENT_CALLBACK_CODE]; } sub get_element{ my $self = shift; my $arr_ref = $self->{element_stack}; return $arr_ref->[@$arr_ref - 1]; } sub get_element_path{ my $self = shift; return '/' . join('/', @{$self->{element_stack}}); } sub _count_element_nest{ my $self = shift; return scalar @{$self->{element_stack}}; } sub _push_element{ my $self = shift; if($self->_count_element_nest > $SOF_THRESHOLD){ die "stack over flow."; } push(@{$self->{element_stack}}, shift) if @_; } sub _pop_element{ my $self = shift; pop(@{$self->{element_stack}}); } sub _convert_attributes{ my $self = shift; my $attr_ref = shift; if(ref $attr_ref ne 'HASH'){ return {}; } my $attr_hash = {}; for my $attr ( values %$attr_ref ){ $attr_hash->{$attr->{Name}} = $attr->{Value} } return $attr_hash; } ### Overrite sub start_element { my ($self, $data) = @_; my $elem_name = $data->{Name}; $self->_push_element($elem_name); if(@{$self->{object_stack}} || $self->_get_element_callback($self->get_element_path())){ my $attr_ref = $data->{Attributes}; my $data_ref = XML::SAX::ElementCallbackHandler::Element->new( name => $elem_name, attributes => $self->_convert_attributes($attr_ref) ); push @{$self->{object_stack}}, $data_ref; } } sub end_element { my ($self, $data) = @_; my $stacksize = @{$self->{object_stack}}; if($stacksize){ my $callback = $self->_get_element_callback( $self->get_element_path() ); if($callback){ $callback->($self->{object_stack}->[@{$self->{object_stack}} - 1]); } my $this_element = pop @{$self->{object_stack}}; $stacksize = @{$self->{object_stack}}; if($stacksize){ my $parent_element = $self->{object_stack}->[$stacksize - 1]; $parent_element->_add_element($this_element); } } $self->_pop_element(); } sub characters{ my ($self, $data) = @_; my $stacksize = scalar @{$self->{object_stack}}; if($stacksize){ my $element = $self->{object_stack}->[$stacksize - 1]; $element->{data} .= $data->{Data}; if(length $element->{data} > $STRING_THRESHOLD){ die 'too long string.'; } } } package XML::SAX::ElementCallbackHandler::Element; sub new{ my $class = shift; my %args = @_; return bless { name => delete $args{name} || die(''), elements => [], data => "", attributes => delete $args{attributes} || {}, _elements_accessor => {} }, $class; } sub _add_element{ my $self = shift; my $element = shift; if(ref $element ne __PACKAGE__){ die "can't Element Object."; } push @{$self->{elements}}, $element; my $name = $element->name; if(! exists $self->{_elements_accessor}->{$name}){ $self->{_elements_accessor}->{$name} = []; } push @{$self->{_elements_accessor}->{$name}}, $element; } sub attribute{ my $self = shift; my $attribute_name = shift; return $self->{attributes}->{$attribute_name}; } sub elements{ my $self = shift; my $element_name = shift; my $elements_arr = $element_name ? $self->{_elements_accessor}->{$element_name} : $self->{elements}; return @{$elements_arr}; } sub element{ my $self = shift; my $element_name = shift; my $element_no = shift || 0; my $elements_arr = $self->{_elements_accessor}->{$element_name}; return $elements_arr->[$element_no]; } sub name{ my $self = shift; return $self->{name}; } sub data{ my $self = shift; return $self->{data}; } 1;
動かしてみる
use strict; use warnings; use 5.10.1; use utf8; use lib qw(./lib); use XML::SAX; use XML::SAX::ElementCallbackHandler; my $xml = <<'__XML__'; <?xml version="1.0" encoding="utf-8"?> <root> <aaa> wwwwwwwwwwwwwwwwwwwwwwwwwwwwww <bbb> <aaa attr="attr_aaa"> <bbb attr="attr_bbb">HOGE</bbb> </aaa> </bbb> <ccc attr="attr_ccc"> <bbb>FUGA</bbb> </ccc> <bbb>aaa</bbb> <bbb>bbb</bbb> <bbb>ccc</bbb> </aaa> </root> __XML__ use Data::Dumper; my $parser; $parser = XML::SAX::ParserFactory->parser(Handler => new XML::SAX::ElementCallbackHandler( element_callback => [ # <aaa>要素 'root/aaa' => sub{ my ($elem) = @_; my $bbb = $elem->elements('bbb'); # bbb要素だけ取り出す for my $bbb ($elem->elements('bbb')){ if($bbb->elements){ say("pass"); # 子要素を持つ要素なのでpass }else{ say($bbb->data); } } # 3番目(添え字:2)のbbb要素を取り出す say($elem->element('bbb', 2)->data); } ] )); $parser->parse_string($xml); say "-----------------------------------------"; $parser = XML::SAX::ParserFactory->parser(Handler => new XML::SAX::ElementCallbackHandler( element_callback => [ # <aaa>配下の<bbb>要素 'aaa/bbb' => sub { my ($elem) = @_; if($elem->elements){ my $aaa = $elem->element('aaa'); say($aaa->attribute('attr')); my $aaa_bbb = $aaa->element('bbb'); say($aaa_bbb->attribute('attr')); say($aaa_bbb->data); }else{ say($elem->data); } }, ] )); $parser->parse_string($xml); say "-----------------------------------------"; $parser = XML::SAX::ParserFactory->parser(Handler => new XML::SAX::ElementCallbackHandler( element_callback => [ # <aaa>配下にあるいくつかの要素の配下にある<bbb>要素(<aaa><bbb>は含まれない。<aaa><XXX><YYY><bbb>などが含まれる) 'aaa/.+/bbb' => sub{ my ($elem) = @_; say($elem->data); } ] )); $parser->parse_string($xml); say "-----------------------------------------";
pass
aaa
bbb
ccc
bbb
- -
HOGE
attr_aaa
attr_bbb
HOGE
aaa
bbb
ccc
- -
HOGE
FUGA
- -
まず、要素を読み取ったときのcallback関数を登録します。
callbackは要素とサブルーチンのペアで登録する必要があります。
その要素の定義はパス区切りで定義できます。
"aaa/bbb"であれば、出てきた
要素の定義が被った場合、先に定義された要素のサブルーチンが使われます。
"aaa/bbb"と"bbb"の順で定義すると、"bbb"も呼ばれる可能性はありますが、
"bbb"と"aaa/bbb"の順で定義すると、"aaa/bbb"は呼ばれることはありません。("bbb"で一致してしまうので。)
なので、定義は可能な限り長く記述しましょう。
ある要素に複数同じ要素が存在した場合、その順序は保証されます。
とあれば、itemの値を順番に取得すると、1, 2, ... , 9となります。
また、要素名には正規表現が使えます。しかし、要素を取り出すときは実際の名前になります。
たとえば、
"item\d"でマッチングしますが、コールバックにわたってくる要素名は、
item1, item2, ... item9というようになります。
このハンドラーを使う意味がない例として、上の例でいえば"root"の要素を取ることです。
この例の場合、終端まで読み取る必要が出てくるので、SAXを使う意味がなくなります。
要素の配下にいくつかの要素といくつかの文字列(改行含む)が存在した場合、文字列のみを記録するため、見た目がおかしな状態になります。
DOMパーサを使ったほうが圧倒的にラク。(テストもされてるしね・・・)
使う日は来るのだろうか。