package ExtUtils
::Constant
::XS
;
use vars
qw($VERSION %XS_Constant %XS_TypeSet @ISA @EXPORT_OK $is_perl56);
use ExtUtils::Constant::Utils 'perl_stringify';
require ExtUtils::Constant::Base;
@ISA = qw(ExtUtils::Constant::Base Exporter);
@EXPORT_OK = qw(%XS_Constant %XS_TypeSet);
$is_perl56 = ($] < 5.007 && $] > 5.005_50);
ExtUtils::Constant::Base - base class for ExtUtils::Constant objects
require ExtUtils::Constant::XS;
ExtUtils::Constant::XS overrides ExtUtils::Constant::Base to generate C
code for XS modules' constants.
Nicholas Clark <nick@ccl4.org> based on the code in C<h2xs> by Larry Wall and
# '' is used as a flag to indicate non-ascii macro names, and hence the need
# to pass in the utf8 on/off flag.
PV => 'PUSHp(pv, strlen(pv))',
YES => 'PUSHs(&PL_sv_yes)',
NO => 'PUSHs(&PL_sv_no)',
UNDEF => '', # implicit undef
UV => '*iv_return = (IV)',
PVN => ['*pv_return = ', '*iv_return = (IV)'],
push @lines, "#define PERL_constant_NOTFOUND\t$start\n"; $start++;
push @lines, "#define PERL_constant_NOTDEF\t$start\n"; $start++;
foreach (sort keys %XS_Constant) {
push @lines, "#define PERL_constant_IS$_\t$start\n"; $start++;
typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */
#define aTHX_ /* 5.6 or later define this for threading support. */
#define pTHX_ /* 5.6 or later define this for threading support. */
return exists $XS_TypeSet{$type};
# This might actually be a return statement
sub assignment_clause_for_type {
my $type = $args->{type};
my $typeset = $XS_TypeSet{$type};
die "Type $type is aggregate, but only single value given"
return map {"$typeset->[$_]$_[$_];"} 0 .. $#$typeset;
} elsif (defined $typeset) {
confess "Aggregate value given for type $type"
sub return_statement_for_type {
# In the future may pass in an options hash
$type = $type->{type} if ref $type;
"return PERL_constant_IS$type;";
sub return_statement_for_notdef {
"return PERL_constant_NOTDEF;";
sub return_statement_for_notfound {
"return PERL_constant_NOTFOUND;";
my $macro = $item->{name};
$macro = $item->{value} unless defined $macro;
# Keep to the traditional perl source macro
foreach (sort keys %$what) {
warn "ExtUtils::Constant doesn't know how to handle values of type $_" unless defined $XS_Constant{$_};
$params->{''} = 1 if $what->{''};
$params->{IV} = 1 if $what->{IV} || $what->{UV} || $what->{PVN};
$params->{NV} = 1 if $what->{NV};
$params->{PV} = 1 if $what->{PV} || $what->{PVN};
$params->{SV} = 1 if $what->{SV};
sub C_constant_prefix_param {
sub C_constant_prefix_param_defintion {
sub namelen_param_definition {
'STRLEN ' . $_[0] -> namelen_param;
sub C_constant_other_params_defintion {
my ($self, $params) = @_;
$body .= ", int utf8" if $params->{''};
$body .= ", IV *iv_return" if $params->{IV};
$body .= ", NV *nv_return" if $params->{NV};
$body .= ", const char **pv_return" if $params->{PV};
$body .= ", SV **sv_return" if $params->{SV};
sub C_constant_other_params {
my ($self, $params) = @_;
$body .= ", utf8" if $params->{''};
$body .= ", iv_return" if $params->{IV};
$body .= ", nv_return" if $params->{NV};
$body .= ", pv_return" if $params->{PV};
$body .= ", sv_return" if $params->{SV};
my ($self, $args, @items) = @_;
my ($package, $subname, $default_type, $what, $indent, $breakout) =
@{$args}{qw(package subname default_type what indent breakout)};
/* When generated this function returned values for the list of names given
in this section of perl code. Rather than manually editing these functions
to add or remove constants, which would result in this comment and section
of code becoming inaccurate, we recommend that you edit this section of
code, and use it to regenerate a new set of constant functions which you
then use to replace the originals.
Regenerate these constant functions by feeding this entire source file to
use ExtUtils::Constant qw (constant_types C_constant XS_constant);
$result .= $self->dump_names ({default_type
=>$default_type, what
=>$what,
indent
=>0, declare_types
=>1},
print constant_types(); # macro defs
$package = perl_stringify
($package);
"foreach (C_constant (\"$package\", '$subname', '$default_type', \$types, ";
# The form of the indent parameter isn't defined. (Yet)
$Data::Dumper
::Terse
=1; # Not used once. :-)
chomp ($indent = Data
::Dumper
::Dumper
($indent));
$result .= ", $breakout" . ', @names) ) {
print $_, "\n"; # C constant subs
print "#### XS Section:\n";
print XS_constant ("' . $package . '", $types);