File Coverage

blib/lib/Sub/CharacterProperties.pm

Criterion	Covered	Total	%
statement	37	38	97.3
branch	5	8	62.5
condition			n/a
subroutine	8	8	100.0
pod	2	2	100.0
total	52	56	92.8

use 5.008;
use strict;
use warnings;

package Sub::CharacterProperties;
our $VERSION = '1.100860';
# ABSTRACT: Support for user-defined character properties
use Number::Rangify 'rangify';
use charnames ':full';
use parent 'Class::Accessor::Complex';
__PACKAGE__
    ->mk_new
    ->mk_array_accessors(qw(characters));

sub get_ranges {
    my $self = shift;

    # Convert the values to their actual Unicode character equivalent.  For
    # defining a character, we accept Unicode character names (the "..." part
    # of the "\N{...}" notation) or hex code points (indicated by a leading
    # "0x"; useful for characters that don't have a name).
    my @characters;
    for ($self->characters) {
        if (/^0x(.*)$/) {
            push @characters => sprintf '%c' => hex($1);
        } else {
            push @characters => sprintf '%c' => charnames::vianame($_);
        }
        utf8::upgrade($_);
    }
    my @ranges = rangify(map { ord($_) } @characters);
    wantarray ? @ranges : \@ranges;
}

sub as_code {
    my ($self, $name) = @_;
    $name = 'InFoo' unless defined $name;
    my $code = "sub $name { <<'END' }\n";
    for my $range ($self->get_ranges) {
        my ($lower, $upper) = $range->Size;
        if ($lower == $upper) {
            $code .= sprintf "%X\n", $lower;
        } else {
            $code .= sprintf "%X %X\n", $lower, $upper;
        }
    }
    $code .= "END\n";
    $code;
}
1;


__END__