File Coverage

blib/lib/Unicode/Property/XS.pm

Criterion	Covered	Total	%
statement	42	56	75.0
branch	7	16	43.7
condition			n/a
subroutine	7	8	87.5
pod			n/a
total	56	80	70.0

package Unicode::Property::XS;

use 5.008;
use strict;
use warnings;
use vars qw( $VERSION );

#require Exporter;
#our @ISA = qw(Exporter);
# use Exporter::Lite;
#our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
our $Prefix;
BEGIN {
    $VERSION = '0.81';
}

# This allows declaration   use Unicode::Property::XS ':all';


our @general = (
         'L', 'LC', 'Lu', 'Ll',
         'Lt', 'Lm', 'Lo', 'M',
         'Mn', 'Mc', 'Me', 'N',
         'Nd', 'Nl', 'No', 'P',
         'Pc', 'Pd', 'Ps', 'Pe',
         'Pi', 'Pf', 'Po', 'S',
         'Sm', 'Sc', 'Sk', 'So',
         'Z', 'Zs', 'Zl', 'Zp',
         'C', 'Cc', 'Cf', 'Cs',
         'Co', 'Cn' );
our @bidirectional = (
         'BidiL', 'BidiLRE', 'BidiLRO', 'BidiR',
         'BidiAL', 'BidiRLE', 'BidiRLO', 'BidiPDF',
         'BidiEN', 'BidiES', 'BidiET', 'BidiAN',
         'BidiCS', 'BidiNSM', 'BidiBN', 'BidiB',
         'BidiS', 'BidiWS', 'BidiON' );
our @scripts = (
         'Arabic', 'Armenian', 'Balinese', 'Bengali',
         'Bopomofo', 'Braille', 'Buginese', 'Buhid',
         'CanadianAboriginal', 'Cherokee', 'Coptic', 'Cuneiform',
         'Cypriot', 'Cyrillic', 'Deseret', 'Devanagari',
         'Ethiopic', 'Georgian', 'Glagolitic', 'Gothic',
         'Greek', 'Gujarati', 'Gurmukhi', 'Han',
         'Hangul', 'Hanunoo', 'Hebrew', 'Hiragana',
         'Inherited', 'Kannada', 'Katakana', 'Kharoshthi',
         'Khmer', 'Lao', 'Latin', 'Limbu',
         'LinearB', 'Malayalam', 'Mongolian', 'Myanmar',
         'NewTaiLue', 'Nko', 'Ogham', 'OldItalic',
         'OldPersian', 'Oriya', 'Osmanya', 'PhagsPa',
         'Phoenician', 'Runic', 'Shavian', 'Sinhala',
         'SylotiNagri', 'Syriac', 'Tagalog', 'Tagbanwa',
         'TaiLe', 'Tamil', 'Telugu', 'Thaana',
         'Thai', 'Tibetan', 'Tifinagh', 'Ugaritic',
         'Yi' );
our @extended = (
         'ASCIIHexDigit', 'BidiControl', 'Dash', 'Deprecated',
         'Diacritic', 'Extender', 'HexDigit', 'Hyphen',
         'Ideographic', 'IDSBinaryOperator', 'IDSTrinaryOperator', 'JoinControl',
         'LogicalOrderException', 'NoncharacterCodePoint', 'OtherAlphabetic', 'OtherDefaultIgnorableCodePoint',
         'OtherGraphemeExtend', 'OtherIDStart', 'OtherIDContinue', 'OtherLowercase',
         'OtherMath', 'OtherUppercase', 'PatternSyntax', 'PatternWhiteSpace',
         'QuotationMark', 'Radical', 'SoftDotted', 'STerm',
         'TerminalPunctuation', 'UnifiedIdeograph', 'VariationSelector', 'WhiteSpace' );
our @derived = (
         'Alphabetic', 'Lowercase', 'Uppercase', 'Math',
         'IDStart', 'IDContinue', 'Any', 'Assigned',
         'Unassigned', 'ASCII', 'Common' );
our @EastAsianWidth = (
         'EaF', 'EaH', 'EaA', 'EaNa',
         'EaW', 'EaN', 'EaFullwidth0', 'EaFullwidth1',
         'EaHalfwidth0', 'EaHalfwidth1' );

our %EXPORT_TAGS = (
        'all' => [ 'Legal',
        @general,@bidirectional,@scripts,@extended,
        @derived,@EastAsianWidth ],

        'general' => [ @general ],
        'bidirectional' => [ @bidirectional ],
        'scripts' => [ @scripts ],
        'extended' => [ @extended ],
        'derived' => [ @derived ],
        'EastAsianWidth' => [ @EastAsianWidth ],
        );


#    ucs_InEastAsianFullwidth
#    ucs_InEastAsianHalfwidth
#    ucs_InEastAsianAmbiguous
#    ucs_InEastAsianNarrow
#    ucs_InEastAsianWide
#    ucs_InEastAsianNeutral
#    ucs_InFullwidth
#    ucs_InHalfwidth
#      for ucs_InFullwidth see context $Unicode::EastAsianWidth::EastAsian
#      for ucs_InHalfwidth see context $Unicode::EastAsianWidth::EastAsian

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw();

sub import {
    my ($pkg, @imports) = @_;
    my($caller, $file, $line) = caller;

    $Prefix = defined($Prefix) ? $Prefix : 'ucs_' ;
    $Prefix =~ s/[^A-Za-z0-9_]//g ;                    # strip possible weird chars in prefix

    # my @tags;
    my @items;

    # adapted from Exporter::Lite
    if ( !@imports ) {        # Default import.
        @imports = @EXPORT;
    }
    my %ok = map { s/^&//; $_ => 1; } @EXPORT_OK, @EXPORT;
    my %ok_tag = map { $_ => 1; } keys %EXPORT_TAGS;
    my $add;

    ITEM:
    foreach my $item (@imports) {
        $add = $item =~ s/^!// ? 1 : 2;

        if ($item eq ':DEFAULT') {
            map { $ok{$_}=$add; } @EXPORT ;
            next ITEM;
        }

        if ($item =~ /^:(.*)/) {
            if (!$ok_tag{$1}) {
                _report_error($1);
                next ITEM;
            };
            map { $ok{$_}=$add; } @{ $EXPORT_TAGS{$1} } ;
        }
        else {
            if (!$ok{$item}) {
                _report_error($item);
                next ITEM;
            };
            $ok{$item}=$add;
        }
    };

    foreach my $item (keys %ok) {
        next if $ok{ $item } != 2 ;

        do { no strict;
            *{ $caller.'::'.$Prefix.$item } = \&{ $item };
        };
    };

};

sub _report_error {
    my $item = shift;
    do { require Carp; Carp::croak("Can't export symbol: $item") };
};

require XSLoader;
XSLoader::load('Unicode::Property::XS', $VERSION);

# Preloaded methods go here.

1;
__END__