Server IP : 85.214.239.14 / Your IP : 3.145.106.176 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /usr/share/doc/libparse-recdescent-perl/examples/ |
Upload File : |
#!/usr/bin/perl -w package XML2DS; use Parse::RecDescent; @ISA = qw( Parse::RecDescent ); sub allow_nested { my ($parser, $tag, @nestedtags) = @_; my $nestedtags = join '|', map { '^'.$_.'$' } @nestedtags; $parser->{allow}{$tag} = qr/$nestedtags/; } sub new { bless Parse::RecDescent->new(<<'EOGRAMMAR'), XML2DS; xml: unitag(?) | tag content[$item[1]](s) endtag[$item[1]] { bless $item[2], $item[1]} unitag: m{<([a-zA-Z]+)/>} { bless [], $1 } tag: m{<([a-zA-Z]+)>} { $return = $1 } endtag: m{</$arg[0]>} | m{(\S+)} <error: was expecting </$arg[0]> but found $1 instead> content: <rulevar: local $error> content: rawtext <commit> check[$arg[0], $item[1]] | xml <commit> check[$arg[0], $item[1]] | <error?: $error> <error: error in <$arg[0]> block> rawtext: m{[^<]+} { bless \$item[1], 'rawtext' } check: { my ($outertag, $innertag) = ($arg[0], ref $arg[1]); $return = $arg[1] if !$thisparser->{allow}{$outertag} || $innertag =~ $thisparser->{allow}{$outertag}; $error = ($innertag eq 'rawtext') ? "Raw text not valid in <$outertag> block" : "<$innertag> tag not valid in <$outertag> block"; undef; } EOGRAMMAR } package main; use Data::Dumper; my $parser = XML2DS->new(); $parser->allow_nested( Test => qw(Example) ); $parser->allow_nested( Example => qw(Data rawtext) ); $parser->allow_nested( Data => qw(SubData rawtext) ); $parser->allow_nested( SubData => qw(Example rawtext) ); my $xml = join '', <DATA>; if (my $tree = $parser->xml($xml)) { print Data::Dumper->Dump([$tree]); } __DATA__ <Test> <Example/> <Example> <Data> raw data <SubData> raw subdata </SubData> more raw data </Data> <Data> still more raw data <SubData> <Example> <Data> nested example data </Data> </Example> </SubData> </Data> last rawtext </Example> </Test>