view release on metacpan or  search on metacpan

lib/Assert/Conditional/Utils.pm  view on Meta::CPAN

    :Export( qw[exports] )
{
    my $caller_package = caller;
    dump_package_exports($caller_package, @_);
}

sub dump_package_exports($@)
    :Export( qw[exports] )
{
    my($pkg, @exports) = @_;
    my %tag2aref = do { no strict 'refs'; %{$pkg . "::EXPORT_TAGS"} };
    delete $tag2aref{asserts};
    my %seen; # for the all repetition
    my @taglist = @exports ? @exports : ('all', uca_sort(keys %tag2aref));
    my $errors = 0;
    print "=head2 Export Tags\n\n=over\n\n" if $Pod_Generation;
    for my $tag (@taglist)  {
        next if $seen{$tag}++;
        my $aref = $tag2aref{$tag};
        unless ($aref) {
            print STDERR ":$tag is not an export tag in $pkg.\n";
            $errors++;
            next;
        }
        if ($Pod_Generation) {
            print "=item C<:$tag>\n\n", commify_series(map { "L</$_>" } uca_sort @$aref), ".\n\n";
        }
        else {
            print "Conditional export tag :$tag exports ", commify_series(uca_sort @$aref), ".\n";
        }
    }
    print "=back\n\n" if $Pod_Generation;
    return $errors == 0;
}

#################################################################

sub UCA (_)             :Export( qw[unicode] );
sub UCA1(_)             :Export( qw[unicode] );
sub UCA2(_)             :Export( qw[unicode] );
sub UCA3(_)             :Export( qw[unicode] );
sub UCA4(_)             :Export( qw[unicode] );
sub uca_cmp ($$)        :Export( qw[unicode] );
sub uca1_cmp($$)        :Export( qw[unicode] );
sub uca2_cmp($$)        :Export( qw[unicode] );
sub uca3_cmp($$)        :Export( qw[unicode] );
sub uca4_cmp($$)        :Export( qw[unicode] );

{
    my @Comparitor;

    sub _get_comparitor($) {
        my($level) = @_;
        panic "invalid level $level" unless $level =~ /^[1-4]$/;
        return $Comparitor[$level] if $Comparitor[$level];

        require Unicode::Collate;
        my $class = Unicode::Collate:: ;
        # need to discount the other ones altogether
        my @args = (level => $level); #, variable => "Non-Ignorable");
    #   if ($Opt{locale}) {
    #       require Unicode::Collate::Locale;
    #       $class = Unicode::Collate::Locale:: ;
    #       push @args, locale => $Opt{locale};
    #   }
        my $coll = $class->new(@args);
        $Comparitor[$level] = $coll;
    }

    for my $strength ( 1 .. 4 ) {
        no strict "refs";
        *{ "UCA$strength" } = sub(_) {
            state $coll = _get_comparitor($strength);
            return $coll->getSortKey($_[0]);
        };

        *{ "uca${strength}_cmp" } = sub($$) {
            my($this, $that) = @_;
            "UCA$strength"->($this)
                cmp
            "UCA$strength"->($that)

        };
    }

    no warnings "once";
    *UCA     = \&UCA1;
    *uca_cmp = \&uca1_cmp;
}

sub uca_sort(@)
    :Export( qw[unicode list] )
{
     state $collator = _get_comparitor(4);
     return $collator->sort(@_);
}

{
    sub _uniq {
        my %seen;
        my @out;
        for (@_) { push @out, $_ unless $seen{$_}++ }
        return @out;
    }

    @EXPORT_OK = _uniq(@EXPORT_OK);
    for my $tag (keys %EXPORT_TAGS) {
        my @exports = _uniq @{ $EXPORT_TAGS{$tag} };
        $EXPORT_TAGS{$tag} = [@exports];
    }
}

#################################################################

{   # Private scope for sig mappers

    our %Config;  # constrains in-file lexical visibility
    use  Config;

    my $sig_count      = $Config{sig_size}     || botch_undef;
    my $sig_name_list  = $Config{sig_name}     || botch_undef;
    my $sig_num_list   = $Config{sig_num}      || botch_undef;

    my @sig_nums       = split " ", $sig_num_list;