The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

use v5.12;
use utf8;
use strict;
use Carp qw(carp cluck croak confess shortmess longmess);
use Cwd qw(cwd abs_path);
use Exporter qw(import);
use File::Basename qw(basename dirname);
#################################################################
sub botch ( $ ) ;
sub botch_argc ( $$ ) ;
sub botch_array_length ( $$ ) ;
sub botch_false ( ) ;
sub botch_have_thing_wanted ( @ ) ;
sub botch_undef ( ) ;
sub code_of_coderef ( $ ) ;
sub commify_and ;
sub commify_but ;
sub commify_nor ;
sub commify_or ;
sub commify_series ;
sub dump_exports ( @ ) ;
sub dump_package_exports ( $@ ) ;
sub Export ;
sub FIXME ( ) ;
sub _get_comparitor ( $ ) ;
sub his_args ( ;$ ) ;
sub his_assert ( ) ;
sub his_context ( ;$ ) ;
sub his_filename ( ;$ ) ;
sub his_frame ( ;$ ) ;
sub his_is_require ( ;$ ) ;
sub his_line ( ;$ ) ;
sub his_package ( ;$ ) ;
sub his_sub ( ;$ ) ;
sub his_subroutine ( ;$ ) ;
sub _init_envariables ( ) ;
sub _init_public_vars ( ) ;
sub name_of_coderef ( $ ) ;
sub NOT_REACHED ( ) ;
sub panic ( $ ) ;
sub quotify_and ;
sub quotify_but ;
sub quotify_nor ;
sub quotify_or ;
sub serialize_conjunction ( $@ ) ;
sub sig_name2num ( $ ) ;
sub sig_num2longname ( $ ) ;
sub sig_num2name ( $ ) ;
sub subname_or_code ( $ ) ;
sub UCA ( _ ) ;
sub UCA1 ( _ ) ;
sub uca1_cmp ( $$ ) ;
sub UCA2 ( _ ) ;
sub uca2_cmp ( $$ ) ;
sub UCA3 ( _ ) ;
sub uca3_cmp ( $$ ) ;
sub UCA4 ( _ ) ;
sub uca4_cmp ( $$ ) ;
sub uca_cmp ( $$ ) ;
sub uca_sort ( @ ) ;
sub _uniq ;
#################################################################
use version 0.77;
our $VERSION = version->declare("0.010");
our %EXPORT_TAGS;
push our @EXPORT_OK, do {
my %seen;
grep { !$seen{$_}++ } map { @$_ } values %EXPORT_TAGS;
};
our @CARP_NOT = qw(
Assert::Conditional::Utils
Assert::Conditional
Attribute::Handlers
);
$EXPORT_TAGS{all} = \@EXPORT_OK;
#################################################################
# The following attribute handler handler for subs saves
# us a lot of bookkeeping trouble by letting us declare
# which export tag groups a particular assert belongs to
# at the point of declaration where it belongs, and so
# that it is all handled automatically.
sub Export : ATTR(BEGIN)
{
our $Assert_Debug;
my($package, $symbol, $referent, $attr, $data, $phase, $filename, $linenum) = @_;
state $glyph_map = {
CODE => '&',
SCALAR => '$',
ARRAY => '@',
HASH => '%',
};
my $glyph = $glyph_map->{ ref($referent) } || botch_undef;
no strict "refs";
my $exportee = *{$symbol}{NAME};
$exportee =~ s/^/$glyph/ unless $glyph eq $glyph_map->{CODE};
my $tagref = $data;
if (defined($tagref) && !ref($tagref)) {
$tagref = [ $tagref ];
}
my $debugging = $Exporter::Verbose || $Assert_Debug;
my $his_export_ok = $package . "::EXPORT_OK";
push @$his_export_ok, $exportee;
carp "Adding $exportee to EXPORT_OK in $package at ",__FILE__," line ",__LINE__ if $debugging;
if ($tagref) {
my $his_export_tags = $package . "::EXPORT_TAGS";
for my $tag (@$tagref, qw(all)) {
carp "Adding $exportee to EXPORT_TAG :$tag in $package at ",__FILE__," line ",__LINE__ if $debugging;
push @{ $his_export_tags->{$tag} }, $exportee;
}
}
}
# Yes, you can actually export these that way too.
our($Assert_Debug, $Assert_Always, $Assert_Carp, $Assert_Never, $Allow_Handlers)
:Export( qw[vars] );
our $Pod_Generation;
# Let's not talk about these ones.
our(%PLURAL, %N_PLURAL)
:Export( qw[acme_plurals] );
sub _init_envariables() {
use Env qw(
ASSERT_CONDITIONAL
ASSERT_CONDITIONAL_BUILD_POD
ASSERT_CONDITIONAL_DEBUG
ASSERT_CONDITIONAL_ALLOW_HANDLERS
);
$Pod_Generation //= $ASSERT_CONDITIONAL_BUILD_POD || 0;
$Allow_Handlers //= $ASSERT_CONDITIONAL_ALLOW_HANDLERS || 0;
$Assert_Debug //= $ASSERT_CONDITIONAL_DEBUG || 0;
if ($ASSERT_CONDITIONAL) {
for ($ASSERT_CONDITIONAL) {
unless (/\b(?: carp | always | never )\b/x) {
warn("Ignoring unknown value '$_' of ASSERT_CONDITIONAL envariable");
next;
}
if ( /\b carp \b/x ) { $Assert_Carp ||= 1 }
if ( /\b always \b/x ) { $Assert_Always ||= 1 }
if ( /\b never \b/x ) { $Assert_Never ||= 1 }
if ( /\b handlers \b/x ) { $Allow_Handlers ||= 1 }
}
}
$Assert_Always ||= 1 unless $Assert_Carp || $Assert_Never;
if ($Assert_Never) {
warn q(Ignoring $Assert_Always because $Assert_Never is true) if $Assert_Always;
warn q(Ignoring $Assert_Carp because $Assert_Never is true) if $Assert_Carp;
$Assert_Always = $Assert_Carp = 0;
}
}
sub _init_public_vars() {
Acme::Plural->import();
}
# Now run that function right now, before the rest of the function:
BEGIN { _init_envariables() }
sub botch($)
:Export( qw[botch] )
{
return if $Assert_Never;
my($msg) = @_;
my $sub = his_assert;
local @SIG{<__{DIE,WARN}__>} unless $Allow_Handlers;
my $botch = "$0\[$$]: botched assertion $sub: \u$msg";
if ($Assert_Carp) {
Carp::carp($botch)
}
if ($Assert_Always) {
$botch = shortmess("$botch, bailing out");
Carp::confess("$botch\n Beginning stack dump from failed $sub");
}
}
sub botch_false()
:Export( qw[botch] )
{
panic "value should not be false";
}
sub botch_undef()
:Export( qw[botch] )
{
panic "value should not be undef";
}
#################################################################
#
# A few stray utility functions that are a bit too intimate with
# the assertions in this file to deserve being made public
sub botch_argc($$)
:Export( qw[botch] )
{
my($have, $want) = @_;
botch_have_thing_wanted(HAVE => $have, THING => "argument", WANTED => $want);
}
sub botch_array_length($$)
:Export( qw[botch] )
{
my($have, $want) = @_;
botch_have_thing_wanted(HAVE => $have, THING => "array element", WANTED => $want);
}
sub botch_have_thing_wanted(@)
:Export( qw[botch] )
{
my(%param) = @_;
my $have = $param{HAVE} // botch_undef;
my $thing = $param{THING} // botch_undef;
my $wanted = $param{WANTED} // botch_undef;
botch "have $N_PLURAL{$thing => $have} but wanted $wanted";
}
#################################################################
sub panic($)
:Export( qw[lint botch] )
{
my($msg) = @_;
local @SIG{<__{DIE,WARN}__>} unless $Allow_Handlers;
Carp::confess("Panicking on internal error: $msg");
}
sub FIXME()
:Export( qw[lint] )
{
panic "Unimplemented code reached; you forgot to code up a TODO section";
}
sub NOT_REACHED()
:Export( qw[lint] )
{
panic "Logically unreachable code somehow reached";
}
#################################################################
# Find the highest assert_ on the stack so that we don't misreport
# failures. For example this next one illustrated below should be
# reporting that assert_hash_keys_required botched because that's the
# one we called; it shouldn't say that it was assert_min_keys or
# assert_hashref_keys_required that botched, even thought the nearest
# assert that called botch was actually assert_min_keys.
## perl -Ilib -MAssert::Conditional=:all -e 'assert_hash_keys_required %ENV, "snap"'
## -e[92241]: botched assertion assert_hash_keys_required: Key 'snap' missing from hash, bailing out at -e line 1.
##
## Beginning stack dump from failed assert_hash_keys_required at lib/Assert/Conditional/Utils.pm line 391.
## Assert::Conditional::Utils::botch("key 'snap' missing from hash") called at lib/Assert/Conditional.pm line 1169
## Assert::Conditional::assert_min_keys(REF(0x7fe6196ec3f0), "snap") called at lib/Assert/Conditional.pm line 1135
## Assert::Conditional::assert_hashref_keys_required called at lib/Assert/Conditional.pm line 1104
## Assert::Conditional::assert_hash_keys_required(HASH(0x7fe619028f70), "snap") called at -e line 1
# But if we can't find as assert_\w+ on the stack, just use the name of the
# the thing that called the thing that called us, so presumably whatever
# called botch.
sub his_assert()
:Export( qw[frame] )
{
my $assert_rx = qr/::assert_\w+\z/x;
my $i;
my $sub = q();
for ($i = 1; $sub !~ $assert_rx; $i++) {
$sub = his_sub($i) // last;
}
$sub //= his_sub(2); # in case we couldn't find an assert_\w+ sub
while ((his_sub($i+1) // "") =~ $assert_rx) {
$sub = his_sub(++$i);
}
$sub =~ s/.*:://;
return $sub;
}
sub his_args(;$)
:Export( qw[frame] )
{
my $frames = @_ && $_[0];
do { package DB; () = caller($frames+2); };
return @DB::args;
}
sub his_frame(;$)
:Export( qw[frame] )
{
my $frames = @_ && $_[0];
return caller($frames+2);
}
BEGIN {
# Stealing lovely "iota" magic from the
# Go language construct of the same name.
my $iota;
BEGIN { $iota = 0 }
use constant {
CALLER_PACKAGE => $iota++,
CALLER_FILENAME => $iota++,
CALLER_LINE => $iota++,
CALLER_SUBROUTINE => $iota++,
CALLER_HASARGS => $iota++,
CALLER_WANTARRAY => $iota++,
CALLER_EVALTEXT => $iota++,
CALLER_IS_REQUIRE => $iota++,
CALLER_HINTS => $iota++,
CALLER_BITMASK => $iota++,
CALLER_HINTHASH => $iota++,
};
my @caller_consts = qw(
CALLER_PACKAGE
CALLER_FILENAME
CALLER_LINE
CALLER_SUBROUTINE
CALLER_HASARGS
CALLER_WANTARRAY
CALLER_EVALTEXT
CALLER_IS_REQUIRE
CALLER_HINTS
CALLER_BITMASK
CALLER_HINTHASH
);
push @{ $EXPORT_TAGS{CALLER} }, @caller_consts;
push @{ $EXPORT_TAGS{frame} },
@{ $EXPORT_TAGS{CALLER} };
}
sub his_package(;$)
:Export( qw[frame] )
{
my $frames = @_ && $_[0];
(his_frame($frames+1))[CALLER_PACKAGE]
}
sub his_filename(;$)
:Export( qw[frame] )
{
my $frames = @_ && $_[0];
(his_frame($frames+1))[CALLER_FILENAME]
}
sub his_line(;$)
:Export( qw[frame] )
{
my $frames = @_ && $_[0];
(his_frame($frames+1))[CALLER_LINE]
}
sub his_subroutine(;$)
:Export( qw[frame] )
{
my $frames = @_ && $_[0];
(his_frame($frames+1))[CALLER_SUBROUTINE]
}
sub his_sub(;$)
:Export( qw[frame] )
{
my $frames = @_ && $_[0];
his_subroutine($frames + 1);
}
sub his_context(;$)
:Export( qw[frame] )
{
my $frames = @_ && $_[0];
(his_frame($frames+1))[CALLER_WANTARRAY]
}
sub his_is_require(;$)
:Export( qw[frame] )
{
my $frames = @_ && $_[0];
(his_frame($frames+1))[CALLER_IS_REQUIRE]
}
#################################################################
my ($hint_bits, $warning_bits);
BEGIN {($hint_bits, $warning_bits) = ($^H, ${^WARNING_BITS})}
sub code_of_coderef($)
:Export( qw[code] )
{
my($coderef) = @_;
my $deparse = B::Deparse->new(
"-P",
"-sC",
#"-x9",
#"-q",
#"-q",
);
$deparse->ambient_pragmas(
warnings => 'all',
strict => 'all',
hint_bits => $hint_bits,
warning_bits => $warning_bits,
) if 0;
my $body = $deparse->coderef2text($coderef);
#return $body;
for ($body) {
s/^\h+(?:use|no) (?:strict|warnings|feature|integer|utf8|bytes|re)\b[^\n]*\n//gm;
s/^\h+package [^\n]*;\n//gm;
s/\A\{\n\h+([^\n;]*);\n\}\z/{ $1 }/;
}
return $body;
}
sub name_of_coderef($)
:Export( qw[code] )
{
require B;
my($coderef) = @_;
my $cv = B::svref_2object($coderef);
return unless $cv->isa("B::CV");
my $gv = $cv->GV;
return if $gv->isa("B::SPECIAL");
my $subname = $gv->NAME;
my $packname = $gv->STASH->NAME;
return $packname . "::" . $subname;
}
sub subname_or_code($)
:Export( qw[code] )
{
my($coderef) = @_;
my $name = name_of_coderef($coderef);
if ($name =~ /__ANON__/) {
return code_of_coderef($coderef);
} else {
return "$name()";
}
}
#################################################################
sub serialize_conjunction($@) {
my $conj = shift;
(@_ == 0) ? '' :
(@_ == 1) ? $_[0] :
(@_ == 2) ? join(" $conj ", @_) :
join(", ", @_[0 .. ($#_-1)], "$conj $_[-1]");
}
sub commify_series
:Export( qw[list] )
{
&commify_and;
}
sub commify_and
:Export( qw[list] )
{
serialize_conjunction and => @_;
}
sub commify_or
:Export( qw[list] )
{
serialize_conjunction or => @_;
}
sub commify_but
:Export( qw[list] )
{
serialize_conjunction but => @_;
}
sub commify_nor
:Export( qw[list] )
{
serialize_conjunction nor => @_;
}
sub quotify_and
:Export( qw[list] )
{
commify_and map { "'$_'" } @_;
}
sub quotify_or
:Export( qw[list] )
{
commify_or map { "'$_'" } @_;
}
sub quotify_nor
:Export( qw[list] )
{
commify_nor map { "'$_'" } @_;
}
sub quotify_but
:Export( qw[list] )
{
commify_but map { "'$_'" } @_;
}
sub dump_exports(@)
: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];
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;
my @sig_names = split " ", $sig_name_list;
my $have;
$have = @sig_nums;
$have == $sig_count || panic "expected $sig_count signums, not $have";
$have = @sig_names;
$have == $sig_count || panic "expected $sig_count signames, not $have";
my(%_Map_num2name, %_Map_name2num);
@_Map_num2name {@sig_nums } = @sig_names;
@_Map_name2num {@sig_names} = @sig_nums;
sub sig_num2name($)
:Export( sigmappers )
{
my($num) = @_;
$num =~ /^\d+$/ || botch "$num doesn't look like a signal number";
return $_Map_num2name{$num} // botch_undef;
}
sub sig_num2longname($)
:Export( sigmappers )
{
return q(SIG) . &sig_num2name;
}
sub sig_name2num($)
:Export( sigmappers )
{
my($name) = @_;
$name =~ /^\p{upper}+$/ || botch "$name doesn't look like a signal name";
$name =~ s/^SIG//;
return $_Map_name2num{$name} // botch_undef;
}
}
#################################################################
# You really don't want to be looking here.
BEGIN {
package # so PAUSE doesn't index this
Acme::Plural::pl_simple;
require Tie::Hash;
our @ISA = qw(Acme::Plural Tie::StdHash);
sub TIEHASH {
my($class, @args) = @_;
my $self = { };
bless $self, $class;
return $self;
}
sub FETCH {
my($self, $key) = @_;
my($noun, $count) = (split($; => $key), 2);
return $noun if $count eq '1';
$self->{$noun} ||= $self->_lame_plural($noun);
}
}
BEGIN {
package # so PAUSE doesn't index this
Acme::Plural::pl_count;
our @ISA = 'Acme::Plural::pl_simple';
sub FETCH {
my($self, $key) = @_;
my $several = $self->SUPER::FETCH($key);
my($noun, $count) = (split($; => $key), 2);
return "$count $several";
}
}
BEGIN {
package # so PAUSE doesn't index this
Acme::Plural;
use Exporter 'import';
our @EXPORT = qw(
%PLURAL
%N_PLURAL
);
# TODO: replace with the Lingua::EN::Inflect
sub _lame_plural($$) {
my($self, $str) = @_;
return $str if $str =~ s/(?<! [aeiou] ) y $/ies/x;
return $str if $str =~ s/ (?: [szx] | [sc]h ) \K $/es/x;
return $str . "s";
}
tie our %PLURAL => "Acme::Plural::pl_simple";
tie our %N_PLURAL => "Acme::Plural::pl_count";
}
_init_public_vars();
1;
__END__
=encoding utf8
=head1 NAME
Assert::Conditional::Utils - Utility functions for conditionally-compiled assertions
=head1 SYNOPSIS
use Assert::Conditional::Utils qw(panic NOT_REACHED);
$big > $little
|| panic("Impossible for $big > $little");
chdir("/")
|| panic("Your root filesystem is corrupt: $!");
if ($x) { ... }
elsif ($y) { ... }
elsif ($z) { ... }
else { NOT_REACHED }
=head1 DESCRIPTION
This module is used by the L<Assert::Conditional> module for most of the
non-assert functions it needs. Because this module is still in alpha
release, the two examples above should be the only guaranteed serviceable
parts.
It is possible (but in alpha release, not necessarily advised) to use the
C<botch> function to write your own assertions that work like those in
L<Assert::Conditional>.
The C<panic> function is for internal errors that should never
happen. Unlike its cousin C<botch>, it is not controllable through
the C<ASSERT_CONDITIONAL> variable.
Use C<NOT_REACHED> for some case that can "never" happen.
=head2 Exported Variables
Here is the list of the support global variables, available for import,
which are normally controlled by the C<ASSERT_CONDITIONAL> environment
variable.
=over
=item C<$Assert_Never>
Set by default under C<ASSERT_CONDITIONAL=never>.
Assertions are never imported, and even if you somehow manage to import
them, they will never never make a peep nor raise an exception.
=item C<$Assert_Always>
Set by default under C<ASSERT_CONDITIONAL=always>.
Assertions are always imported, and even if you somehow manage to avoid importing
them, they will still raise an exception on error.
=item C<$Assert_Carp>
Set by default under C<ASSERT_CONDITIONAL=carp>.
Assertions are always imported but they do not raise an exception if they fail;
instead they all carp at you. This is true even if you manage to call an assertion
you haven't imported.
=back
A few others exist, but you should probably not pay attention to them.
=head2 Exported Functions
Here is the list of all exported functions with their prototypes:
botch ( $ ) ;
botch_argc ( $$ ) ;
botch_array_length ( $$ ) ;
botch_false ( ) ;
botch_have_thing_wanted ( @ ) ;
botch_undef ( ) ;
code_of_coderef ( $ ) ;
commify_series ;
dump_exports ( @ ) ;
dump_package_exports ( $@ ) ;
Export ;
FIXME ( ) ;
his_args ( ;$ ) ;
his_assert ( ) ;
his_context ( ;$ ) ;
his_filename ( ;$ ) ;
his_frame ( ;$ ) ;
his_is_require ( ;$ ) ;
his_line ( ;$ ) ;
his_package ( ;$ ) ;
his_sub ( ;$ ) ;
his_subroutine ( ;$ ) ;
name_of_coderef ( $ ) ;
NOT_REACHED ( ) ;
panic ( $ ) ;
sig_name2num ( $ ) ;
sig_num2longname ( $ ) ;
sig_num2name ( $ ) ;
subname_or_code ( $ ) ;
UCA ( _ ) ;
UCA1 ( _ ) ;
uca1_cmp ( $$ ) ;
UCA2 ( _ ) ;
uca2_cmp ( $$ ) ;
UCA3 ( _ ) ;
uca3_cmp ( $$ ) ;
UCA4 ( _ ) ;
uca4_cmp ( $$ ) ;
uca_cmp ( $$ ) ;
uca_sort ( @ ) ;
=for reproduction
ASSERT_CONDITIONAL_BUILD_POD=1 perl -Ilib -MAssert::Conditional -e 'Assert::Conditional::Utils->dump_package_exports' | fmt
=head2 Export Tags
Available exports are grouped by the following tags:
=over
=item C<:all>
L</$Allow_Handlers>, L</$Assert_Always>, L</$Assert_Carp>,
L</$Assert_Debug>, L</$Assert_Never>, L</botch>, L</botch_argc>,
L</botch_array_length>, L</botch_false>, L</botch_have_thing_wanted>,
L</botch_undef>, L</CALLER_BITMASK>, L</CALLER_EVALTEXT>,
L</CALLER_FILENAME>, L</CALLER_HASARGS>, L</CALLER_HINTHASH>,
L</CALLER_HINTS>, L</CALLER_IS_REQUIRE>, L</CALLER_LINE>,
L</CALLER_PACKAGE>, L</CALLER_SUBROUTINE>, L</CALLER_WANTARRAY>,
L</code_of_coderef>, L</commify_and>, L</commify_but>, L</commify_nor>,
L</commify_or>, L</commify_series>, L</dump_exports>,
L</dump_package_exports>, L</FIXME>, L</his_args>, L</his_assert>,
L</his_context>, L</his_filename>, L</his_frame>, L</his_is_require>,
L</his_line>, L</his_package>, L</his_sub>, L</his_subroutine>,
L</name_of_coderef>, L</NOT_REACHED>, L</%N_PLURAL>, L</panic>,
L</%PLURAL>, L</quotify_and>, L</quotify_but>, L</quotify_nor>,
L</quotify_or>, L</sig_name2num>, L</sig_num2longname>, L</sig_num2name>,
L</subname_or_code>, L</UCA>, L</UCA1>, L</uca1_cmp>, L</UCA2>,
L</uca2_cmp>, L</UCA3>, L</uca3_cmp>, L</UCA4>, L</uca4_cmp>,
L</uca_cmp>, and L</uca_sort>.
=item C<:acme_plurals>
L</%N_PLURAL> and L</%PLURAL>.
=item C<:botch>
L</botch>, L</botch_argc>, L</botch_array_length>, L</botch_false>,
L</botch_have_thing_wanted>, L</botch_undef>, and L</panic>.
=item C<:CALLER>
L</CALLER_BITMASK>, L</CALLER_EVALTEXT>, L</CALLER_FILENAME>,
L</CALLER_HASARGS>, L</CALLER_HINTHASH>, L</CALLER_HINTS>,
L</CALLER_IS_REQUIRE>, L</CALLER_LINE>, L</CALLER_PACKAGE>,
L</CALLER_SUBROUTINE>, and L</CALLER_WANTARRAY>.
=item C<:code>
L</code_of_coderef>, L</name_of_coderef>, and L</subname_or_code>.
=item C<:exports>
L</dump_exports> and L</dump_package_exports>.
=item C<:frame>
L</CALLER_BITMASK>, L</CALLER_EVALTEXT>, L</CALLER_FILENAME>,
L</CALLER_HASARGS>, L</CALLER_HINTHASH>, L</CALLER_HINTS>,
L</CALLER_IS_REQUIRE>, L</CALLER_LINE>, L</CALLER_PACKAGE>,
L</CALLER_SUBROUTINE>, L</CALLER_WANTARRAY>, L</his_args>,
L</his_assert>, L</his_context>, L</his_filename>, L</his_frame>,
L</his_is_require>, L</his_line>, L</his_package>, L</his_sub>, and
L</his_subroutine>.
=item C<:lint>
L</FIXME>, L</NOT_REACHED>, and L</panic>.
=item C<:list>
L</commify_and>, L</commify_but>, L</commify_nor>, L</commify_or>,
L</commify_series>, L</quotify_and>, L</quotify_but>, L</quotify_nor>,
L</quotify_or>, and L</uca_sort>.
=item C<:sigmappers>
L</sig_name2num>, L</sig_num2longname>, and L</sig_num2name>.
=item C<:unicode>
L</UCA>, L</UCA1>, L</uca1_cmp>, L</UCA2>, L</uca2_cmp>, L</UCA3>,
L</uca3_cmp>, L</UCA4>, L</uca4_cmp>, L</uca_cmp>, and L</uca_sort>.
=item C<:vars>
L</$Allow_Handlers>, L</$Assert_Always>, L</$Assert_Carp>,
L</$Assert_Debug>, and L</$Assert_Never>.
=back
=head2 Exported Functions
About the only thing here that's "public" is L</botch>
and the C<sig*> name-to-number mapping functions.
The rest are internal and shouldn't be relied on.
=over
=item C<botch($)>
The main way that assertions fail. Normally it raises an exception
by calling C<Carp::confess>, but this can be controlled using the
C<ASSERT_CONDITIONAL> environment variable or its associated package
variables as previously described.
We crawl up the stack to find the I<highest> function named C<assert_*> to
use for the message. That way when an assertion calls another assertion and that
second one fails, the reported message uses the name of the first one.
=item C<botch_false()>
A way to panic if something is false but shouldn't be.
=item C<botch_undef()>
A way to panic if something is undef but shouldn't be.
=item C<botch_argc($$)>
=item C<botch_array_length($$)>
=item C<botch_have_thing_wanted(@)>
=item C<panic(I<MESSAGE>)>
This function is used for internal errors that should never happen.
It calls C<Carp::confess> with a prefix indicating that it is an
internal error.
=item C<FIXME>
Code you haven't gotten to yet.
=item C<NOT_REACHED>
Put this in places that you think you can never reach in your code.
=item C<his_assert()>
=item C<his_args(;$)>
=item C<his_frame(;$)>
=item C<his_package(;$)>
=item C<his_filename(;$)>
=item C<his_line(;$)>
=item C<his_subroutine(;$)>
=item C<his_sub(;$)>
=item C<his_context(;$)>
=item C<his_is_require(;$)>
=item C<code_of_coderef(I<CODEREF>)>
Return the code but not the name of the code reference passed.
=item C<name_of_coderef(I<CODEREF>)>
Return the name of the code reference passed.
=item C<subname_or_code(I<CODEREF>)>
Return the name of the code reference passed if it is not anonymous;
otherwise return its code.
=item C<commify_series>
=item C<dump_exports(@)>
=item C<dump_package_exports($@)>
=item C<UCA(_)>
=item C<UCA1(_)>
=item C<UCA2(_)>
=item C<UCA3(_)>
=item C<UCA4(_)>
=item C<uca_cmp($$)>
=item C<uca1_cmp($$)>
=item C<uca2_cmp($$)>
=item C<uca3_cmp($$)>
=item C<uca4_cmp($$)>
=item C<uca_sort(@)>
Return its argument list sorted alphabetically.
=item C<sig_num2name(I<NUMBER>)>
Returns the name of the signal number, like C<HUP>, C<INT>, etc.
=item C<sig_num2longname($)>
Returns the long name of the signal number, like C<SIGHUP>, C<SIGINT>, etc.
=item sub C<sig_name2num(I<NAME>)>
Returns the signal number corresponding to the passed in name.
=back
=head1 ENVIRONMENT
The C<ASSERT_CONDITIONAL> variable controls the behavior
of the C<botch> function, and also of the the conditional
importing itself.
The C<ASSERT_CONDITIONAL_BUILD_POD> variable is used internally.
=head1 SEE ALSO
The L<Assert::Conditional> module that uses these utilities
and
the L<Exporter::ConditionalSubs> module which that module is based on.
=head1 BUGS AND LIMITATIONS
Probably many. This is an beta release.
=head1 AUTHOR
Tom Christiansen C<< <tchrist@perl.com> >>
=head1 LICENCE AND COPYRIGHT
Copyright (c) 2015-2018 Tom Christiansen C<< <tchrist@perl.com> >>.
All Rights Reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.