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, XS_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<XS_SUBNAME>. The C subroutine it calls defaults to
167 the name of the perl visible subroutine, unless you give the parameter
175 my $XS_subname = shift;
176 my $C_subname = shift;
177 $XS_subname ||= 'constant';
178 $C_subname ||= $XS_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};
246 # If anyone is insane enough to suggest a package name containing %
247 my $package_sprintf_safe = $package;
248 $package_sprintf_safe =~ s/%/%%/g;
251 /* Return 1 or 2 items. First is error message, or undef if no error.
252 Second, if present, is found value */
254 case PERL_constant_NOTFOUND:
256 sv_2mortal(newSVpvf("%s is not a valid $package_sprintf_safe macro", s));
259 case PERL_constant_NOTDEF:
260 sv = sv_2mortal(newSVpvf(
261 "Your vendor has not defined $package_sprintf_safe macro %s, used",
267 foreach $type (sort keys %XS_Constant) {
268 # '' marks utf8 flag needed.
270 $xs .= "\t/* Uncomment this if you need to return ${type}s\n"
271 unless $what->{$type};
272 $xs .= " case PERL_constant_IS$type:\n";
273 if (length $XS_Constant{$type}) {
280 # Do nothing. return (), which will be correctly interpreted as
284 unless ($what->{$type}) {
285 chop $xs; # Yes, another need for chop not chomp.
291 sv = sv_2mortal(newSVpvf(
292 "Unexpected return type %d while processing $package_sprintf_safe macro %s, used",
302 =item autoload PACKAGE, VERSION, AUTOLOADER
304 A function to generate the AUTOLOAD subroutine for the module I<PACKAGE>
305 I<VERSION> is the perl version the code should be backwards compatible with.
306 It defaults to the version of perl running the subroutine. If I<AUTOLOADER>
307 is true, the AUTOLOAD subroutine falls back on AutoLoader::AUTOLOAD for all
308 names that the constant() routine doesn't recognise.
312 # ' # Grr. syntax highlighters that don't grok pod.
315 my ($module, $compat_version, $autoloader) = @_;
316 $compat_version ||= $];
317 croak "Can't maintain compatibility back as far as version $compat_version"
318 if $compat_version < 5;
319 my $func = "sub AUTOLOAD {\n"
320 . " # This AUTOLOAD is used to 'autoload' constants from the constant()\n"
322 $func .= " If a constant is not found then control is passed\n"
323 . " # to the AUTOLOAD in AutoLoader." if $autoloader;
327 . " my \$constname;\n";
329 " our \$AUTOLOAD;\n" if ($compat_version >= 5.006);
332 (\$constname = \$AUTOLOAD) =~ s/.*:://;
333 croak "&${module}::constant not defined" if \$constname eq 'constant';
334 my (\$error, \$val) = constant(\$constname);
340 if ($error =~ /is not a valid/) {
341 $AutoLoader::AUTOLOAD = $AUTOLOAD;
342 goto &AutoLoader::AUTOLOAD;
350 " if (\$error) { croak \$error; }\n";
356 # Fixed between 5.005_53 and 5.005_61
357 #XXX if ($] >= 5.00561) {
358 #XXX *$AUTOLOAD = sub () { $val };
361 *$AUTOLOAD = sub { $val };
373 =item WriteMakefileSnippet
375 WriteMakefileSnippet ATTRIBUTE =E<gt> VALUE [, ...]
377 A function to generate perl code for Makefile.PL that will regenerate
378 the constant subroutines. Parameters are named as passed to C<WriteConstants>,
379 with the addition of C<INDENT> to specify the number of leading spaces
382 Currently only C<INDENT>, C<NAME>, C<DEFAULT_TYPE>, C<NAMES>, C<C_FILE> and
383 C<XS_FILE> are recognised.
387 sub WriteMakefileSnippet {
389 my $indent = $args{INDENT} || 2;
391 my $result = <<"EOT";
392 ExtUtils::Constant::WriteConstants(
393 NAME => '$args{NAME}',
395 DEFAULT_TYPE => '$args{DEFAULT_TYPE}',
397 foreach (qw (C_FILE XS_FILE)) {
398 next unless exists $args{$_};
399 $result .= sprintf " %-12s => '%s',\n",
406 $result =~ s/^/' 'x$indent/gem;
407 return ExtUtils::Constant::XS->dump_names({default_type=>$args{DEFAULT_TYPE},
413 =item WriteConstants ATTRIBUTE =E<gt> VALUE [, ...]
415 Writes a file of C code and a file of XS code which you should C<#include>
416 and C<INCLUDE> in the C and XS sections respectively of your module's XS
417 code. You probably want to do this in your C<Makefile.PL>, so that you can
418 easily edit the list of constants without touching the rest of your module.
419 The attributes supported are
425 Name of the module. This must be specified
429 The default type for the constants. If not specified C<IV> is assumed.
433 The names of the constants are grouped by length. Generate child subroutines
434 for each group with this number or more names in.
438 An array of constants' names, either scalars containing names, or hashrefs
439 as detailed in L<"C_constant">.
443 If true, uses proxy subs. See L<ExtUtils::Constant::ProxySubs>.
447 A filehandle to write the C code to. If not given, then I<C_FILE> is opened
452 The name of the file to write containing the C code. The default is
453 C<const-c.inc>. The C<-> in the name ensures that the file can't be
454 mistaken for anything related to a legitimate perl package name, and
455 not naming the file C<.c> avoids having to override Makefile.PL's
456 C<.xs> to C<.c> rules.
460 A filehandle to write the XS code to. If not given, then I<XS_FILE> is opened
465 The name of the file to write containing the XS code. The default is
470 The perl visible name of the XS subroutine generated which will return the
471 constants. The default is C<constant>.
475 The name of the C subroutine generated which will return the constants.
476 The default is I<XS_SUBNAME>. Child subroutines have C<_> and the name
477 length appended, so constants with 10 character names would be in
478 C<constant_10> with the default I<XS_SUBNAME>.
487 C_FILE => 'const-c.inc',
488 XS_FILE => 'const-xs.inc',
489 XS_SUBNAME => 'constant',
490 DEFAULT_TYPE => 'IV',
493 $ARGS{C_SUBNAME} ||= $ARGS{XS_SUBNAME}; # No-one sane will have C_SUBNAME eq '0'
495 croak "Module name not specified" unless length $ARGS{NAME};
497 my $c_fh = $ARGS{C_FH};
500 # We need these little games, rather than doing things
501 # unconditionally, because we're used in core Makefile.PLs before
502 # IO is available (needed by filehandle), but also we want to work on
503 # older perls where undefined scalars do not automatically turn into
504 # anonymous file handles.
506 $c_fh = FileHandle->new();
508 open $c_fh, ">$ARGS{C_FILE}" or die "Can't open $ARGS{C_FILE}: $!";
511 my $xs_fh = $ARGS{XS_FH};
515 $xs_fh = FileHandle->new();
517 open $xs_fh, ">$ARGS{XS_FILE}" or die "Can't open $ARGS{XS_FILE}: $!";
520 # As this subroutine is intended to make code that isn't edited, there's no
521 # need for the user to specify any types that aren't found in the list of
524 if ($ARGS{PROXYSUBS}) {
525 require ExtUtils::Constant::ProxySubs;
527 $ARGS{XS_FH} = $xs_fh;
528 ExtUtils::Constant::ProxySubs->WriteConstants(%ARGS);
532 print $c_fh constant_types(); # macro defs
535 # indent is still undef. Until anyone implements indent style rules with
537 foreach (ExtUtils::Constant::XS->C_constant({package => $ARGS{NAME},
538 subname => $ARGS{C_SUBNAME},
545 print $c_fh $_, "\n"; # C constant subs
547 print $xs_fh XS_constant ($ARGS{NAME}, $types, $ARGS{XS_SUBNAME},
551 close $c_fh or warn "Error closing $ARGS{C_FILE}: $!" unless $ARGS{C_FH};
552 close $xs_fh or warn "Error closing $ARGS{XS_FILE}: $!" unless $ARGS{XS_FH};
562 Nicholas Clark <nick@ccl4.org> based on the code in C<h2xs> by Larry Wall and