package PYX::XMLNorm; # Pragmas. use strict; use warnings; # Modules. use Class::Utils qw(set_params); use Error::Pure qw(err); use PYX qw(end_element); use PYX::Parser; # Version. our $VERSION = 0.04; # Constructor. sub new { my ($class, @params) = @_; my $self = bless {}, $class; # Flush stack on finalization. $self->{'flush_stack'} = 0; # Output handler. $self->{'output_handler'} = \*STDOUT; # XML normalization rules. $self->{'rules'} = {}; # Process params. set_params($self, @params); # Check to rules. if (! keys %{$self->{'rules'}}) { err 'Cannot exist XML normalization rules.'; } # PYX::Parser object. $self->{'pyx_parser'} = PYX::Parser->new( 'callbacks' => { 'data' => \&_end_element_simple, 'end_element' => \&_end_element, 'final' => \&_final, 'start_element' => \&_start_element, }, 'non_parser_options' => { 'flush_stack' => $self->{'flush_stack'}, 'rules' => $self->{'rules'}, 'stack' => [], }, 'output_handler' => $self->{'output_handler'}, 'output_rewrite' => 1, ); # Object. return $self; } # Parse pyx text or array of pyx text. sub parse { my ($self, $pyx, $out) = @_; $self->{'pyx_parser'}->parse($pyx, $out); return; } # Parse file with pyx text. sub parse_file { my ($self, $file) = @_; $self->{'pyx_parser'}->parse_file($file); return; } # Parse from handler. sub parse_handler { my ($self, $input_file_handler, $out) = @_; $self->{'pyx_parser'}->parse_handler($input_file_handler, $out); return; } # Process start of element. sub _start_element { my ($pyx_parser, $tag) = @_; my $out = $pyx_parser->{'output_handler'}; my $rules = $pyx_parser->{'non_parser_options'}->{'rules'}; my $stack = $pyx_parser->{'non_parser_options'}->{'stack'}; if (exists $rules->{'*'}) { foreach my $tmp (@{$rules->{'*'}}) { if (@{$stack} > 0 && lc($stack->[-1]) eq $tmp) { print {$out} end_element(pop @{$stack}), "\n"; } } } if (exists $rules->{lc($tag)}) { foreach my $tmp (@{$rules->{lc($tag)}}) { if (@{$stack} > 0 && lc($stack->[-1]) eq $tmp) { print {$out} end_element(pop @{$stack}), "\n"; } } } push @{$stack}, $tag; print {$out} $pyx_parser->line, "\n"; return; } # Add implicit end_element. sub _end_element_simple { my $pyx_parser = shift; my $rules = $pyx_parser->{'non_parser_options'}->{'rules'}; my $stack = $pyx_parser->{'non_parser_options'}->{'stack'}; my $out = $pyx_parser->{'output_handler'}; if (exists $rules->{'*'}) { foreach my $tmp (@{$rules->{'*'}}) { if (@{$stack} && lc $stack->[-1] eq $tmp) { print {$out} end_element(pop @{$stack}), "\n"; } } } print {$out} $pyx_parser->line, "\n"; return; } # Process end of element sub _end_element { my ($pyx_parser, $tag) = @_; my $out = $pyx_parser->{'output_handler'}; my $rules = $pyx_parser->{'non_parser_options'}->{'rules'}; my $stack = $pyx_parser->{'non_parser_options'}->{'stack'}; if (exists $rules->{'*'}) { foreach my $tmp (@{$rules->{'*'}}) { if (lc($tag) ne $tmp && lc($stack->[-1]) eq $tmp) { print {$out} end_element(pop @{$stack}), "\n"; } } } # XXX Myslim, ze tenhle blok je spatne. if (exists $rules->{$tag}) { foreach my $tmp (@{$rules->{$tag}}) { if (lc($tag) ne $tmp && lc($stack->[-1]) eq $tmp) { print {$out} end_element(pop @{$stack}), "\n"; } } } if (lc($stack->[-1]) eq lc($tag)) { pop @{$stack}; } print {$out} $pyx_parser->line, "\n"; return; } # Process final. sub _final { my $pyx_parser = shift; my $stack = $pyx_parser->{'non_parser_options'}->{'stack'}; my $out = $pyx_parser->{'output_handler'}; if (@{$stack} > 0) { # If set, than flush stack. if ($pyx_parser->{'non_parser_options'}->{'flush_stack'}) { foreach my $tmp (reverse @{$stack}) { print {$out} end_element($tmp), "\n"; } } } return; } 1; __END__ =pod =encoding utf8 =head1 NAME PYX::XMLNorm - Processing PYX data or file and do XML normalization. =head1 SYNOPSIS use PYX::XMLNorm; my $obj = PYX::XMLNorm->new(%parameters); $obj->parse($pyx, $out); $obj->parse_file($input_file, $out); $obj->parse_handle($input_file_handler, $out); =head1 METHODS =over 8 =item C Constructor. =over 8 =item * C Flush stack on finalization. Default value is 0. =item * C Output handler. Default value is \*STDOUT. =item * C XML normalization rules. Parameter is required. Format of rules is: Outer element => list of inner elements. e.g. { 'middle' => ['end'], }, Outer element can be '*'. Default value is {}. =back =item C Parse PYX text or array of PYX text. If $out not present, use 'output_handler'. Returns undef. =item C Parse file with PYX data. If $out not present, use 'output_handler'. Returns undef. =item C Parse PYX handler. If $out not present, use 'output_handler'. Returns undef. =back =head1 ERRORS new(): Cannot exist XML normalization rules. From Class::Utils::set_params(): Unknown parameter '%s'. =head1 EXAMPLE # Pragmas. use strict; use warnings; # Modules. use PYX::XMLNorm; # Example data. my $pyx = <<'END'; (begin (middle (end -data )middle )begin END # Object. my $obj = PYX::XMLNorm->new( 'rules' => { 'middle' => ['end'], }, ); # Nomrmalize.. $obj->parse($pyx); # Output: # (begin # (middle # (end # -data # )end # )middle # )begin =head1 DEPENDENCIES L, L, L, L. =head1 SEE ALSO =over =item L A perl module for PYX handling. =item L Install the PYX modules. =back =head1 REPOSITORY L =head1 AUTHOR Michal Špaček L. =head1 LICENSE AND COPYRIGHT © 2011-2015 Michal Špaček BSD 2-Clause License =head1 VERSION 0.04 =cut