File Coverage

blib/lib/XML/XOXO/Node.pm

Criterion	Covered	Total	%
statement	6	69	8.7
branch	0	20	0.0
condition	0	12	0.0
subroutine	2	11	18.1
pod	7	9	77.7
total	15	121	12.4

package XML::XOXO::Node;
use strict;
use Class::XPath 1.4
  get_name     => 'name',
  get_parent   => 'parent',
  get_root     => 'root',
  get_children => sub { $_[0]->contents ? @{ $_[0]->contents } : () },
  get_attr_names => sub { keys %{ $_[0]->attributes } },
  get_attr_value => sub { $_[0]->attributes->{ $_[1] } || '' },
  get_content    => sub { $_[0]->attributes->{text} };

sub new {
    my $self = bless {}, $_[0];
    $self->{attributes} = {};
    $self->{contents}   = [];
    $self;
}

sub name       { my $this = shift; $this->stash( 'name',       @_ ); }
sub parent     { my $this = shift; $this->stash( 'parent',     @_ ); }
sub contents   { my $this = shift; $this->stash( 'contents',   @_ ); }
sub attributes { my $this = shift; $this->stash( 'attributes', @_ ); }

sub root {
    my $e = shift;
    while ( $e->can('parent') && $e->parent ) { $e = $e->parent }
    $e;
}

sub stash {
    $_[0]->{ $_[1] } = $_[2] if defined $_[2];
    $_[0]->{ $_[1] };
}

#--- output

sub as_xml {
    my $this = shift;
    my $node = shift || $this;
    die 'A node is required when invoking as_xml as a class method.'
      unless ref($node);
    my $name     = $node->name;
    my $a        = \%{ $node->attributes };    # cloned.
    my $children = $node->contents;
    my $out      = "<$name>\n";

    # special attributes
    my $text = $a->{text} || $a->{title} || $a->{url};
    delete $a->{text};
    my $aa = '';
    if ( exists $a->{url} ) {
        $a->{href} = $a->{url};
        delete $a->{url};
    }
    map { $aa .= " $_=\"" . encode_xml( $a->{$_}, 1 ) . "\""; delete $a->{$_}; }
      grep { exists $a->{$_} } qw( href title rel type );
    if ( length($aa) ) {
        $text = encode_xml( $text, 1 );
        $out .= "$text\n";
    }

    # extended (including multi-valued) attributes
    my $cout = '';
    foreach ( sort keys %$a ) {
        $cout .= '' . encode_xml($_) . "\n";
        $cout .= '';
        $cout .=
          ref( $a->{$_} )
          ? "\n" . $this->as_xml( $a->{$_} )
          : encode_xml( $a->{$_}, 1 );
        $cout .= "\n";
    }
    $out .= "\n" . $cout . "\n" if length($cout);

    # children elements
    map { $out .= $this->as_xml($_) } @$children;
    $out .= "\n";
    $out;
}

my %Map = (
            '&'  => '&',
            '"'  => '"',
            '<'  => '<',
            '>'  => '>',
            '\'' => '''
);
my $RE = join '|', keys %Map;

sub encode_xml {
    my ( $str, $nocdata ) = @_;
    return unless defined($str);
    if (
        !$nocdata
        && $str =~ m/
        <[^>]+>  ## HTML markup
        |        ## or
        &(?:(?!(\#([0-9]+)|\#x([0-9a-fA-F]+))).*?);
                 ## something that looks like an HTML entity.
    /x
      ) {
        ## If ]]> exists in the string, encode the > to >.
        $str =~ s/]]>/]]>/g;
        $str = '';
      } else {
        $str =~ s!($RE)!$Map{$1}!g;
    }
    $str;
}

*query = \&match;

1;

__END__