1 package ExtUtils::Constant;
2 use vars qw (@ISA $VERSION @EXPORT_OK %EXPORT_TAGS);
7 ExtUtils::Constant - generate XS code to import C header constants
11 use ExtUtils::Constant qw (WriteConstants);
14 NAMES => [qw(FOO BAR BAZ)],
16 # Generates wrapper code to make the values of the constants FOO BAR BAZ
21 ExtUtils::Constant facilitates generating C and XS wrapper code to allow
22 perl modules to AUTOLOAD constants defined in C library header files.
23 It is principally used by the C<h2xs> utility, on which this code is based.
24 It doesn't contain the routines to scan header files to extract these
29 Generally one only needs to call the C<WriteConstants> function, and then
31 #include "const-c.inc"
33 in the C section of C<Foo.xs>
37 in the XS section of C<Foo.xs>.
39 For greater flexibility use C<constant_types()>, C<C_constant> and
40 C<XS_constant>, with which C<WriteConstants> is implemented.
42 Currently this module understands the following types. h2xs may only know
43 a subset. The sizes of the numeric types are chosen by the C<Configure>
44 script at compile time.
50 signed integer, at least 32 bits.
54 unsigned integer, the same size as I<IV>
58 floating point type, probably C<double>, possibly C<long double>
62 NUL terminated string, length will be determined with C<strlen>
66 A fixed length thing, given as a [pointer, length] pair. If you know the
67 length of a string at compile time you may use this instead of I<PV>
75 Truth. (C<PL_sv_yes>) The value is not needed (and ignored).
79 Defined Falsehood. (C<PL_sv_no>) The value is not needed (and ignored).
83 C<undef>. The value of the macro is not needed.
94 eval "use warnings; 1" or die $@;
97 use Carp qw(croak cluck);
100 use ExtUtils::Constant::Utils qw(C_stringify);
101 use ExtUtils::Constant::XS qw(%XS_Constant %XS_TypeSet);
105 %EXPORT_TAGS = ( 'all' => [ qw(
106 XS_constant constant_types return_clause memEQ_clause C_stringify
107 C_constant autoload WriteConstants WriteMakefileSnippet
110 @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
114 A function returning a single scalar with C<#define> definitions for the
115 constants used internally between the generated C and XS functions.
120 ExtUtils::Constant::XS->header();
124 cluck "ExtUtils::Constant::memEQ_clause is deprecated";
125 ExtUtils::Constant::XS->memEQ_clause({name=>$_[0], checked_at=>$_[1],
129 sub return_clause ($$) {
130 cluck "ExtUtils::Constant::return_clause is deprecated";
132 ExtUtils::Constant::XS->return_clause({indent=>$indent}, @_);
136 cluck "ExtUtils::Constant::switch_clause is deprecated";
139 ExtUtils::Constant::XS->switch_clause({indent=>$indent, comment=>$comment},
144 my ($package, $subname, $default_type, $what, $indent, $breakout, @items)
146 ExtUtils::Constant::XS->C_constant({package => $package, subname => $subname,
147 default_type => $default_type,
148 types => $what, indent => $indent,
149 breakout => $breakout}, @items);
152 =item XS_constant PACKAGE, TYPES, SUBNAME, C_SUBNAME
154 A function to generate the XS code to implement the perl subroutine
155 I<PACKAGE>::constant used by I<PACKAGE>::AUTOLOAD to load constants.
156 This XS code is a wrapper around a C subroutine usually generated by
157 C<C_constant>, and usually named C<constant>.
159 I<TYPES> should be given either as a comma separated list of types that the
160 C subroutine C<constant> will generate or as a reference to a hash. It should
161 be the same list of types as C<C_constant> was given.
162 [Otherwise C<XS_constant> and C<C_constant> may have different ideas about
163 the number of parameters passed to the C function C<constant>]
165 You can call the perl visible subroutine something other than C<constant> if
166 you give the parameter I<SUBNAME>. The C subroutine it calls defaults to
167 the name of the perl visible subroutine, unless you give the parameter
176 my $C_subname = shift;
177 $subname ||= 'constant';
178 $C_subname ||= $subname;
181 # Convert line of the form IV,UV,NV to hash
182 $what = {map {$_ => 1} split /,\s*/, ($what)};
184 my $params = ExtUtils::Constant::XS->params ($what);
192 dXSTARG; /* Faster if we have it. */
203 $xs .= " /* IV\t\tiv;\tUncomment this if you need to return IVs */\n";
208 $xs .= " /* NV\t\tnv;\tUncomment this if you need to return NVs */\n";
211 $xs .= " const char *pv;\n";
214 " /* const char\t*pv;\tUncomment this if you need to return PVs */\n";
220 const char * s = SvPV(sv, len);
225 int utf8 = SvUTF8(sv);
232 if ($params->{IV} xor $params->{NV}) {
234 /* Change this to $C_subname(aTHX_ s, len, &iv, &nv);
235 if you need to return both NVs and IVs */
238 $xs .= " type = $C_subname(aTHX_ s, len";
239 $xs .= ', utf8' if $params->{''};
240 $xs .= ', &iv' if $params->{IV};
241 $xs .= ', &nv' if $params->{NV};
242 $xs .= ', &pv' if $params->{PV};
243 $xs .= ', &sv' if $params->{SV};
247 /* Return 1 or 2 items. First is error message, or undef if no error.
248 Second, if present, is found value */
250 case PERL_constant_NOTFOUND:
251 sv = sv_2mortal(newSVpvf("%s is not a valid $package macro", s));
254 case PERL_constant_NOTDEF:
255 sv = sv_2mortal(newSVpvf(
256 "Your vendor has not defined $package macro %s, used", s));
261 foreach $type (sort keys %XS_Constant) {
262 # '' marks utf8 flag needed.
264 $xs .= "\t/* Uncomment this if you need to return ${type}s\n"
265 unless $what->{$type};
266 $xs .= " case PERL_constant_IS$type:\n";
267 if (length $XS_Constant{$type}) {
274 # Do nothing. return (), which will be correctly interpreted as
278 unless ($what->{$type}) {
279 chop $xs; # Yes, another need for chop not chomp.
285 sv = sv_2mortal(newSVpvf(
286 "Unexpected return type %d while processing $package macro %s, used",
296 =item autoload PACKAGE, VERSION, AUTOLOADER
298 A function to generate the AUTOLOAD subroutine for the module I<PACKAGE>
299 I<VERSION> is the perl version the code should be backwards compatible with.
300 It defaults to the version of perl running the subroutine. If I<AUTOLOADER>
301 is true, the AUTOLOAD subroutine falls back on AutoLoader::AUTOLOAD for all
302 names that the constant() routine doesn't recognise.
306 # ' # Grr. syntax highlighters that don't grok pod.
309 my ($module, $compat_version, $autoloader) = @_;
310 $compat_version ||= $];
311 croak "Can't maintain compatibility back as far as version $compat_version"
312 if $compat_version < 5;
313 my $func = "sub AUTOLOAD {\n"
314 . " # This AUTOLOAD is used to 'autoload' constants from the constant()\n"
316 $func .= " If a constant is not found then control is passed\n"
317 . " # to the AUTOLOAD in AutoLoader." if $autoloader;
321 . " my \$constname;\n";
323 " our \$AUTOLOAD;\n" if ($compat_version >= 5.006);
326 (\$constname = \$AUTOLOAD) =~ s/.*:://;
327 croak "&${module}::constant not defined" if \$constname eq 'constant';
328 my (\$error, \$val) = constant(\$constname);
334 if ($error =~ /is not a valid/) {
335 $AutoLoader::AUTOLOAD = $AUTOLOAD;
336 goto &AutoLoader::AUTOLOAD;
344 " if (\$error) { croak \$error; }\n";
350 # Fixed between 5.005_53 and 5.005_61
351 #XXX if ($] >= 5.00561) {
352 #XXX *$AUTOLOAD = sub () { $val };
355 *$AUTOLOAD = sub { $val };
367 =item WriteMakefileSnippet
369 WriteMakefileSnippet ATTRIBUTE =E<gt> VALUE [, ...]
371 A function to generate perl code for Makefile.PL that will regenerate
372 the constant subroutines. Parameters are named as passed to C<WriteConstants>,
373 with the addition of C<INDENT> to specify the number of leading spaces
376 Currently only C<INDENT>, C<NAME>, C<DEFAULT_TYPE>, C<NAMES>, C<C_FILE> and
377 C<XS_FILE> are recognised.
381 sub WriteMakefileSnippet {
383 my $indent = $args{INDENT} || 2;
385 my $result = <<"EOT";
386 ExtUtils::Constant::WriteConstants(
387 NAME => '$args{NAME}',
389 DEFAULT_TYPE => '$args{DEFAULT_TYPE}',
391 foreach (qw (C_FILE XS_FILE)) {
392 next unless exists $args{$_};
393 $result .= sprintf " %-12s => '%s',\n",
400 $result =~ s/^/' 'x$indent/gem;
401 return ExtUtils::Constant::XS->dump_names({default_type=>$args{DEFAULT_TYPE},
407 =item WriteConstants ATTRIBUTE =E<gt> VALUE [, ...]
409 Writes a file of C code and a file of XS code which you should C<#include>
410 and C<INCLUDE> in the C and XS sections respectively of your module's XS
411 code. You probably want to do this in your C<Makefile.PL>, so that you can
412 easily edit the list of constants without touching the rest of your module.
413 The attributes supported are
419 Name of the module. This must be specified
423 The default type for the constants. If not specified C<IV> is assumed.
427 The names of the constants are grouped by length. Generate child subroutines
428 for each group with this number or more names in.
432 An array of constants' names, either scalars containing names, or hashrefs
433 as detailed in L<"C_constant">.
437 The name of the file to write containing the C code. The default is
438 C<const-c.inc>. The C<-> in the name ensures that the file can't be
439 mistaken for anything related to a legitimate perl package name, and
440 not naming the file C<.c> avoids having to override Makefile.PL's
441 C<.xs> to C<.c> rules.
445 The name of the file to write containing the XS code. The default is
450 The perl visible name of the XS subroutine generated which will return the
451 constants. The default is C<constant>.
455 The name of the C subroutine generated which will return the constants.
456 The default is I<SUBNAME>. Child subroutines have C<_> and the name
457 length appended, so constants with 10 character names would be in
458 C<constant_10> with the default I<XS_SUBNAME>.
467 C_FILE => 'const-c.inc',
468 XS_FILE => 'const-xs.inc',
469 SUBNAME => 'constant',
470 DEFAULT_TYPE => 'IV',
473 $ARGS{C_SUBNAME} ||= $ARGS{SUBNAME}; # No-one sane will have C_SUBNAME eq '0'
475 croak "Module name not specified" unless length $ARGS{NAME};
479 # We need these little games, rather than doing things unconditionally,
480 # because we're used in core Makefile.PLs before IO is available (needed
481 # by filehandle), but also we want to work on older perls where undefined
482 # scalars do not automatically turn into anonymous file handles.
484 $c_fh = FileHandle->new();
485 $xs_fh = FileHandle->new();
487 open $c_fh, ">$ARGS{C_FILE}" or die "Can't open $ARGS{C_FILE}: $!";
488 open $xs_fh, ">$ARGS{XS_FILE}" or die "Can't open $ARGS{XS_FILE}: $!";
490 # As this subroutine is intended to make code that isn't edited, there's no
491 # need for the user to specify any types that aren't found in the list of
495 print $c_fh constant_types(); # macro defs
498 # indent is still undef. Until anyone implements indent style rules with it.
499 foreach (ExtUtils::Constant::XS->C_constant({package => $ARGS{NAME},
500 subname => $ARGS{C_SUBNAME},
504 breakout => $ARGS{BREAKOUT_AT}},
506 print $c_fh $_, "\n"; # C constant subs
508 print $xs_fh XS_constant ($ARGS{NAME}, $types, $ARGS{XS_SUBNAME},
511 close $c_fh or warn "Error closing $ARGS{C_FILE}: $!";
512 close $xs_fh or warn "Error closing $ARGS{XS_FILE}: $!";
522 Nicholas Clark <nick@ccl4.org> based on the code in C<h2xs> by Larry Wall and