File Coverage

blib/lib/XML/Entities.pm

Criterion	Covered	Total	%
statement	49	55	89.0
branch	13	22	59.0
condition			n/a
subroutine	10	11	90.9
pod	2	3	66.6
total	74	91	81.3

package XML::Entities;

use strict;
use 5.008;    # Unicode all over
use Carp;
use XML::Entities::Data;

our $VERSION = '1.0001';

eval { require HTML::Parser };  # for fast XS implemented _decode_entities

if (  eval { HTML::Entities::UNICODE_SUPPORT() }  ) {
    *_decode_entities = \&HTML::Entities::_decode_entities;
}
else {
    sub ord2chr {
        if (substr($_[0], 0, 1) eq 'x') {
            return chr(hex '0'.$_[0])
        }
        else {
            return chr($_[0])
        }
    }
    *_decode_entities = sub {
        my $hash = pop;
        $_[0] =~ s/ & (\#?) (\w+) \b (;?) /
            $1
            ? ord2chr($2)
            : exists $hash->{$2}
            ? $hash->{$2}
            : exists $hash->{$2.';'}
            ? $hash->{$2.';'}
            : '&'.$1.$2.$3
        /xeg;
    };
}

sub decode {
    my $set = shift;
    my @set_names = XML::Entities::Data::names;
    my $entity2char;
    if (ref $set eq 'HASH') {
        $entity2char = $set;
    }
    else {
        croak "'$set' is not a valid entity set name. Choose one of: all @set_names"
            if not grep {$_ eq $set} 'all', @set_names;
        no strict 'refs';
        $entity2char = "XML::Entities::Data::$set"->();
        use strict;
    }
    if (defined wantarray) { @_ = @_ };
    for (@_) {
        _decode_entities($_, $entity2char);
    }
    return @_[0 .. $#_]
}

sub numify {
    my $set = shift;
    my @set_names = XML::Entities::Data::names;
    my $entity2char;
    if (ref $set eq 'HASH') {
        $entity2char = $set;
    }
    else {
        croak "'$set' is not a valid entity set name. Choose one of: all @set_names"
            if not grep {$_ eq $set} 'all', @set_names;
        no strict 'refs';
        $entity2char = "XML::Entities::Data::$set"->();
        use strict;
    }
    if (defined wantarray) {
        @_ = @_;
    }
    my %set = %$entity2char;
    s/(?<= & )  ( [^\#] \w*? )  (?= ; )/
          exists $set{$1}
        ? '#'.ord($set{$1})
        : exists $set{$1.';'}
        ? '#'.ord($set{$1.';'})
        : $1
    /xeg for @_;
    return @_ if wantarray;
    return pop @_ if defined wantarray;
}

1

__END__