package DTA::XMLsh;

use warnings;
use strict;

sub highlight_xml {
    my $str = shift;
    
    # save anchors
    my @anchors;
    my $anchor_cnt = 0;
    $str =~ s{(<a\b.*?</a>)}{
        push @anchors, $1;
        '~~~' . $anchor_cnt++ . '~~~'
    }egs;
    
    $str = escape($str);

    for ( $str ) {
        # doctype
        s{(&lt;\?.*?\?&gt;)}
         {<span class="xmlsh-doctype">$1</span>}gs;

        # comments
        s{(&lt;!--.*?--&gt;)}
         {<span class="xmlsh-comment">$1</span>}gs;

        # tag names
        s{(?<=&lt;)(\w+)(.*?)(?=/?&gt;)}{opentag($1, $2)}gse;
        s{(\w+)(?=&gt;)}{<span class="xmlsh-tag">$1</span>}g;

        # entities
        s{(&amp;[^;]*;)}
         {<span class="xmlsh-entity">$1</span>}g;

        # brackets
        s{(&lt;/?)(?!(?:!--|\?))}
         {<span class="xmlsh-bracket">$1</span>}g;
        s{(?<!--)(?<!\?)(/?&gt;)}
         {<span class="xmlsh-bracket">$1</span>}g;
    }

    # restore anchors
    my $i = 0;
    foreach my $anchor ( @anchors ) {
        $str =~ s/~~~$i~~~/$anchor/;
        $i++;
    }

    return $str;
}

sub opentag {
    my ( $tag, $attr ) = @_;
    my $ret = sprintf '<span class="xmlsh-tag">%s</span>', $tag;
    $ret .= attr( $attr );
    return $ret;
}

sub attr {
    my $str = shift;
    $str =~ s{(\s*)(\w+:)?(\w+)(=)(["])([^\5]*?)(\5)}{parseattr($1, $2, $3, $4, $5, $6, $7)}ge;
    return $str;
}

sub parseattr {
    my ( $lspace, $ns, $attrname, $eq, $oq, $val, $cq ) = @_;
    my $ret = $lspace;
    if ( $ns ) {
        $ret .= sprintf '<span class="xmlsh-namespace">%s</span>', $ns;
    }
    $ret .= sprintf '<span class="xmlsh-aname">%s</span><span class="xmlsh-equal">%s</span><span class="xmlsh-quote">%s</span><span class="xmlsh-avalue">%s</span><span class="xmlsh-quote">%s</span>',
                $attrname, $eq, $oq, $val, $cq;
    return $ret;
}

sub escape {
    my $str = shift;
    for ( $str ) {
        s/\x{0364}/&#x0364;/g;
        s/\x{fffc}/&#xfffc;/g;
        s/&/&amp;/g;
        s/</&lt;/g;
        s/>/&gt;/g;
    }
    return $str;
}

1;
