File Coverage

blib/lib/Regexp/CharClasses/Helper.pm

Criterion	Covered	Total	%
statement	30	30	100.0
branch	13	14	92.8
condition	5	6	83.3
subroutine	7	7	100.0
pod	1	1	100.0
total	56	58	96.5

use strict;
use warnings;
package Regexp::CharClasses::Helper;

# ABSTRACT: Helper for creating user defined character class strings
our $VERSION = '0.003'; # VERSION

use Carp;
use charnames ':full';
use utf8;

=pod

=encoding utf8

=head1 NAME

Regexp::CharClasses::Helper - User defined character class strings by unicode name or literals


=head1 SYNOPSIS

    use Regexp::CharClasses::Helper;

    sub IsAorPlus {
        return Regexp::CharClasses::Helper::fmt(
            'A',
            'LATIN SMALL LETTER A'
            '+',
        );
    }
    say 'matches' if 'A+' =~ /^\p{IsAorPlus}+$/;

    sub InCapitalsButNot42 {
        return Regexp::CharClasses::Helper::fmt(
            "+A\tZ", # from A till Z
            "-\x42"  # except \x42
        );
    }
    say "doesn't" if 'ABC' =~ /\p{InCapitalsButNot42}+/;


=head1 METHODS AND ARGUMENTS

=over 4

=cut

sub _parse {
    my $in = $_[0] || $_;
    croak "Unknown charname '$in'" if $in =~ /^U\+/i;
    return $in if $in =~ /In|Is|::/;
    my $code = length $in == 1 ? ord $in
                               : charnames::vianame $in;
    croak "Unknown charname '$in'" unless defined $code;
    return sprintf '%04x', $code;
}

=item fmt()

Takes in a list and turns it into the format specified by L

=cut

sub fmt {
    return join '', map {
        croak 'undef unexpected' unless defined $_;
        my ($prefix, @out) = ('', $_);
        if (/^[-+!&]/ && !/^[-+!&]($|\t[^\t]|\t\t$)/) {
            $out[0] = s/^([-+!&])//r;
            $prefix = $1;
        }
        @out = ($1, $2) if $out[0] =~ /^(.+)\t(.+)$/;
        $prefix . join("\t", map {_parse $_} @out) . "\n";
    } @_;
}

1;
__END__