This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Data::Dumper update
[perl5.git] / utils / h2xs.PL
CommitLineData
4633a7c4
LW
1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
8a5546a1 5use Cwd;
4633a7c4
LW
6
7# List explicitly here the variables you want Configure to
8# generate. Metaconfig only looks for shell variables, so you
9# have to mention them as if they were shell variables, not
10# %Config entries. Thus you write
11# $startperl
12# to ensure Configure will look for $Config{startperl}.
13
14# This forces PL files to create target in same directory as PL file.
15# This is so that make depend always knows where to find PL derivatives.
8a5546a1 16$origdir = cwd;
44a8e56a
PP
17chdir dirname($0);
18$file = basename($0, '.PL');
774d564b 19$file .= '.com' if $^O eq 'VMS';
4633a7c4
LW
20
21open OUT,">$file" or die "Can't create $file: $!";
22
23print "Extracting $file (with variable substitutions)\n";
24
25# In this section, perl variables will be expanded during extraction.
26# You can use $Config{...} to use Configure variables.
27
28print OUT <<"!GROK!THIS!";
5f05dabc
PP
29$Config{startperl}
30 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
31 if \$running_under_some_shell;
40000a8c
AD
32!GROK!THIS!
33
4633a7c4
LW
34# In the following, perl variables are not expanded during extraction.
35
36print OUT <<'!NO!SUBS!';
cf35f3c1 37
3edbfbe5
TB
38=head1 NAME
39
40h2xs - convert .h C header files to Perl extensions
41
42=head1 SYNOPSIS
43
a887ff11 44B<h2xs> [B<-AOPXcdf>] [B<-v> version] [B<-n> module_name] [B<-p> prefix] [B<-s> sub] [headerfile ... [extra_libraries]]
f508c652
PP
45
46B<h2xs> B<-h>
3edbfbe5
TB
47
48=head1 DESCRIPTION
49
a887ff11
BS
50I<h2xs> builds a Perl extension from C header files. The extension
51will include functions which can be used to retrieve the value of any
52#define statement which was in the C header files.
3edbfbe5
TB
53
54The I<module_name> will be used for the name of the extension. If
a887ff11
BS
55module_name is not supplied then the name of the first header file
56will be used, with the first character capitalized.
3edbfbe5
TB
57
58If the extension might need extra libraries, they should be included
59here. The extension Makefile.PL will take care of checking whether
60the libraries actually exist and how they should be loaded.
61The extra libraries should be specified in the form -lm -lposix, etc,
62just as on the cc command line. By default, the Makefile.PL will
63search through the library path determined by Configure. That path
64can be augmented by including arguments of the form B<-L/another/library/path>
65in the extra-libraries argument.
66
67=head1 OPTIONS
68
69=over 5
70
f508c652 71=item B<-A>
3edbfbe5 72
f508c652
PP
73Omit all autoload facilities. This is the same as B<-c> but also removes the
74S<C<require AutoLoader>> statement from the .pm file.
3edbfbe5 75
b73edd97
PP
76=item B<-F>
77
78Additional flags to specify to C preprocessor when scanning header for
79function declarations. Should not be used without B<-x>.
80
2920c5d2
PP
81=item B<-O>
82
83Allows a pre-existing extension directory to be overwritten.
84
f508c652 85=item B<-P>
3edbfbe5 86
f508c652 87Omit the autogenerated stub POD section.
3edbfbe5 88
b73edd97
PP
89=item B<-X>
90
91Omit the XS portion. Used to generate templates for a module which is not
92XS-based.
93
3edbfbe5
TB
94=item B<-c>
95
96Omit C<constant()> from the .xs file and corresponding specialised
97C<AUTOLOAD> from the .pm file.
98
b73edd97
PP
99=item B<-d>
100
101Turn on debugging messages.
102
f508c652 103=item B<-f>
3edbfbe5 104
f508c652
PP
105Allows an extension to be created for a header even if that header is
106not found in /usr/include.
107
108=item B<-h>
109
110Print the usage, help and version for this h2xs and exit.
111
112=item B<-n> I<module_name>
113
114Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
115
ead2a595
PP
116=item B<-p> I<prefix>
117
118Specify a prefix which should be removed from the Perl function names, e.g., S<-p sec_rgy_>
119This sets up the XS B<PREFIX> keyword and removes the prefix from functions that are
120autoloaded via the C<constant()> mechansim.
121
122=item B<-s> I<sub1,sub2>
123
124Create a perl subroutine for the specified macros rather than autoload with the constant() subroutine.
125These macros are assumed to have a return type of B<char *>, e.g., S<-s sec_rgy_wildcard_name,sec_rgy_wildcard_sid>.
126
f508c652
PP
127=item B<-v> I<version>
128
129Specify a version number for this extension. This version number is added
130to the templates. The default is 0.01.
3edbfbe5 131
760ac839
LW
132=item B<-x>
133
134Automatically generate XSUBs basing on function declarations in the
135header file. The package C<C::Scan> should be installed. If this
136option is specified, the name of the header file may look like
137C<NAME1,NAME2>. In this case NAME1 is used instead of the specified string,
b73edd97 138but XSUBs are emitted only for the declarations included from file NAME2.
760ac839 139
5273d82d
IZ
140Note that some types of arguments/return-values for functions may
141result in XSUB-declarations/typemap-entries which need
142hand-editing. Such may be objects which cannot be converted from/to a
143pointer (like C<long long>), pointers to functions, or arrays.
144
3edbfbe5
TB
145=back
146
147=head1 EXAMPLES
148
149
150 # Default behavior, extension is Rusers
151 h2xs rpcsvc/rusers
152
153 # Same, but extension is RUSERS
154 h2xs -n RUSERS rpcsvc/rusers
155
156 # Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
157 h2xs rpcsvc::rusers
158
159 # Extension is ONC::RPC. Still finds <rpcsvc/rusers.h>
160 h2xs -n ONC::RPC rpcsvc/rusers
161
162 # Without constant() or AUTOLOAD
163 h2xs -c rpcsvc/rusers
164
165 # Creates templates for an extension named RPC
166 h2xs -cfn RPC
167
168 # Extension is ONC::RPC.
169 h2xs -cfn ONC::RPC
170
171 # Makefile.PL will look for library -lrpc in
172 # additional directory /opt/net/lib
173 h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
174
ead2a595
PP
175 # Extension is DCE::rgynbase
176 # prefix "sec_rgy_" is dropped from perl function names
177 h2xs -n DCE::rgynbase -p sec_rgy_ dce/rgynbase
178
179 # Extension is DCE::rgynbase
180 # prefix "sec_rgy_" is dropped from perl function names
181 # subroutines are created for sec_rgy_wildcard_name and sec_rgy_wildcard_sid
182 h2xs -n DCE::rgynbase -p sec_rgy_ \
183 -s sec_rgy_wildcard_name,sec_rgy_wildcard_sid dce/rgynbase
3edbfbe5 184
5273d82d 185 # Make XS without defines in perl.h, but with function declarations
760ac839
LW
186 # visible from perl.h. Name of the extension is perl1.
187 # When scanning perl.h, define -DEXT=extern -DdEXT= -DINIT(x)=
188 # Extra backslashes below because the string is passed to shell.
5273d82d
IZ
189 # Note that a directory with perl header files would
190 # be added automatically to include path.
191 h2xs -xAn perl1 -F "-DEXT=extern -DdEXT= -DINIT\(x\)=" perl.h
760ac839
LW
192
193 # Same with function declaration in proto.h as visible from perl.h.
5273d82d 194 h2xs -xAn perl2 perl.h,proto.h
760ac839 195
3edbfbe5
TB
196=head1 ENVIRONMENT
197
198No environment variables are used.
199
200=head1 AUTHOR
201
202Larry Wall and others
203
204=head1 SEE ALSO
205
f508c652 206L<perl>, L<perlxstut>, L<ExtUtils::MakeMaker>, and L<AutoLoader>.
3edbfbe5
TB
207
208=head1 DIAGNOSTICS
209
760ac839 210The usual warnings if it cannot read or write the files involved.
3edbfbe5
TB
211
212=cut
213
d94c7266 214my( $H2XS_VERSION ) = ' $Revision: 1.19 $ ' =~ /\$Revision:\s+([^\s]+)/;
f508c652 215my $TEMPLATE_VERSION = '0.01';
a0d0e21e
LW
216
217use Getopt::Std;
218
e1666bf5
TB
219sub usage{
220 warn "@_\n" if @_;
b73edd97 221 die "h2xs [-AOPXcdfh] [-v version] [-n module_name] [-p prefix] [-s subs] [headerfile [extra_libraries]]
f508c652 222version: $H2XS_VERSION
3edbfbe5 223 -A Omit all autoloading facilities (implies -c).
b73edd97 224 -F Additional flags for C preprocessor (used with -x).
2920c5d2 225 -O Allow overwriting of a pre-existing extension directory.
f508c652 226 -P Omit the stub POD section.
2920c5d2 227 -X Omit the XS portion.
b73edd97
PP
228 -c Omit the constant() function and specialised AUTOLOAD from the XS file.
229 -d Turn on debugging messages.
230 -f Force creation of the extension even if the C header does not exist.
231 -h Display this help message
232 -n Specify a name to use for the extension (recommended).
233 -p Specify a prefix which should be removed from the Perl function names.
234 -s Create subroutines for specified macros.
f508c652 235 -v Specify a version number for this extension.
760ac839 236 -x Autogenerate XSUBs using C::Scan.
e1666bf5
TB
237extra_libraries
238 are any libraries that might be needed for loading the
239 extension, e.g. -lm would try to link in the math library.
f508c652 240";
e1666bf5 241}
a0d0e21e 242
a0d0e21e 243
b73edd97 244getopts("AF:OPXcdfhn:p:s:v:x") || usage;
a0d0e21e 245
e1666bf5 246usage if $opt_h;
f508c652
PP
247
248if( $opt_v ){
249 $TEMPLATE_VERSION = $opt_v;
250}
e1666bf5 251$opt_c = 1 if $opt_A;
ead2a595 252%const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s;
a0d0e21e 253
a887ff11
BS
254while (my $arg = shift) {
255 if ($arg =~ /^-l/i) {
256 $extralibs = "$arg @ARGV";
257 last;
258 }
259 push(@path_h, $arg);
260}
e1666bf5
TB
261
262usage "Must supply header file or module name\n"
a887ff11 263 unless (@path_h or $opt_n);
e1666bf5 264
a0d0e21e 265
a887ff11
BS
266if( @path_h ){
267 foreach my $path_h (@path_h) {
268 $name ||= $path_h;
e1666bf5
TB
269 if( $path_h =~ s#::#/#g && $opt_n ){
270 warn "Nesting of headerfile ignored with -n\n";
271 }
272 $path_h .= ".h" unless $path_h =~ /\.h$/;
760ac839
LW
273 $fullpath = $path_h;
274 $path_h =~ s/,.*$// if $opt_x;
ead2a595
PP
275 if ($^O eq 'VMS') { # Consider overrides of default location
276 if ($path_h !~ m![:>\[]!) {
277 my($hadsys) = ($path_h =~ s!^sys/!!i);
278 if ($ENV{'DECC$System_Include'}) { $path_h = "DECC\$System_Include:$path_h"; }
279 elsif ($ENV{'DECC$Library_Include'}) { $path_h = "DECC\$Library_Include:$path_h"; }
280 elsif ($ENV{'GNU_CC_Include'}) { $path_h = 'GNU_CC_Include:' .
281 ($hadsys ? '[vms]' : '[000000]') . $path_h; }
282 elsif ($ENV{'VAXC$Include'}) { $path_h = "VAXC\$_Include:$path_h"; }
283 else { $path_h = "Sys\$Library:$path_h"; }
284 }
285 }
286 elsif ($^O eq 'os2') {
5273d82d
IZ
287 $path_h = "/usr/include/$path_h"
288 if $path_h !~ m#^([a-z]:)?[./]#i and -r "/usr/include/$path_h";
289 }
290 else {
291 $path_h = "/usr/include/$path_h"
292 if $path_h !~ m#^[./]# and -r "/usr/include/$path_h";
ead2a595 293 }
5273d82d
IZ
294
295 if (!$opt_c) {
296 die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
297 # Scan the header file (we should deal with nested header files)
298 # Record the names of simple #define constants into const_names
a887ff11 299 # Function prototypes are processed below.
5273d82d
IZ
300 open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
301 while (<CH>) {
b73edd97
PP
302 if (/^#[ \t]*define\s+([\$\w]+)\b\s*[^("]/) {
303 print "Matched $_ ($1)\n" if $opt_d;
e1666bf5
TB
304 $_ = $1;
305 next if /^_.*_h_*$/i; # special case, but for what?
760ac839 306 if (defined $opt_p) {
5273d82d
IZ
307 if (!/^$opt_p(\d)/) {
308 ++$prefix{$_} if s/^$opt_p//;
309 }
310 else {
311 warn "can't remove $opt_p prefix from '$_'!\n";
312 }
ead2a595 313 }
e1666bf5 314 $const_names{$_}++;
5273d82d
IZ
315 }
316 }
317 close(CH);
e1666bf5 318 }
a887ff11
BS
319 }
320 @const_names = sort keys %const_names;
a0d0e21e
LW
321}
322
e1666bf5 323
a0d0e21e
LW
324$module = $opt_n || do {
325 $name =~ s/\.h$//;
326 if( $name !~ /::/ ){
327 $name =~ s#^.*/##;
328 $name = "\u$name";
329 }
330 $name;
331};
332
8e07c86e 333(chdir 'ext', $ext = 'ext/') if -d 'ext';
a0d0e21e
LW
334
335if( $module =~ /::/ ){
336 $nested = 1;
337 @modparts = split(/::/,$module);
338 $modfname = $modparts[-1];
339 $modpname = join('/',@modparts);
340}
341else {
342 $nested = 0;
343 @modparts = ();
344 $modfname = $modpname = $module;
345}
346
347
2920c5d2
PP
348if ($opt_O) {
349 warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname;
350} else {
351 die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
352}
c07a80fd
PP
353if( $nested ){
354 $modpath = "";
355 foreach (@modparts){
356 mkdir("$modpath$_", 0777);
357 $modpath .= "$_/";
358 }
359}
a0d0e21e 360mkdir($modpname, 0777);
8e07c86e 361chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
a0d0e21e 362
5273d82d
IZ
363my %types_seen;
364my %std_types;
365my $fdecls;
366my $fdecls_parsed;
367
2920c5d2
PP
368if( ! $opt_X ){ # use XS, unless it was disabled
369 open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
5273d82d
IZ
370 if ($opt_x) {
371 require C::Scan; # Run-time directive
372 require Config; # Run-time directive
373 warn "Scanning typemaps...\n";
374 get_typemap();
375 my $c;
376 my $filter;
a887ff11
BS
377 my @fdecls;
378 foreach my $filename (@path_h) {
5273d82d
IZ
379 my $addflags = $opt_F || '';
380 if ($fullpath =~ /,/) {
381 $filename = $`;
382 $filter = $';
383 }
384 warn "Scanning $filename for functions...\n";
385 $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter,
386 'add_cppflags' => $addflags;
387 $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]);
388
389 $fdecls_parsed = $c->get('parsed_fdecls');
a887ff11
BS
390 push(@fdecls, @{$c->get('fdecls')});
391 }
392 $fdecls = [ @fdecls ];
5273d82d 393 }
2920c5d2 394}
5273d82d 395
8e07c86e 396open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
a0d0e21e 397
a0d0e21e 398$" = "\n\t";
8e07c86e 399warn "Writing $ext$modpname/$modfname.pm\n";
a0d0e21e 400
a0d0e21e
LW
401print PM <<"END";
402package $module;
403
2920c5d2
PP
404use strict;
405END
406
407if( $opt_X || $opt_c || $opt_A ){
408 # we won't have our own AUTOLOAD(), so won't have $AUTOLOAD
409 print PM <<'END';
f192e801 410use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
2920c5d2
PP
411END
412}
413else{
414 # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
415 # will want Carp.
416 print PM <<'END';
417use Carp;
f192e801 418use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
2920c5d2
PP
419END
420}
421
422print PM <<'END';
423
a0d0e21e 424require Exporter;
2920c5d2
PP
425END
426
427print PM <<"END" if ! $opt_X; # use DynaLoader, unless XS was disabled
a0d0e21e 428require DynaLoader;
3edbfbe5
TB
429END
430
2920c5d2
PP
431# require autoloader if XS is disabled.
432# if XS is enabled, require autoloader unless autoloading is disabled.
464ed3b6 433if( ($opt_X && (! $opt_A)) || (!$opt_X) ) {
3edbfbe5
TB
434 print PM <<"END";
435require AutoLoader;
436END
437}
438
2920c5d2 439if( $opt_X || ($opt_c && ! $opt_A) ){
3edbfbe5 440 # we won't have our own AUTOLOAD(), so we'll inherit it.
2920c5d2
PP
441 if( ! $opt_X ) { # use DynaLoader, unless XS was disabled
442 print PM <<"END";
e1666bf5 443
a0d0e21e 444\@ISA = qw(Exporter AutoLoader DynaLoader);
3edbfbe5 445END
2920c5d2
PP
446 }
447 else{
448 print PM <<"END";
449
450\@ISA = qw(Exporter AutoLoader);
451END
452 }
3edbfbe5
TB
453}
454else{
455 # 1) we have our own AUTOLOAD(), so don't need to inherit it.
456 # or
457 # 2) we don't want autoloading mentioned.
2920c5d2
PP
458 if( ! $opt_X ){ # use DynaLoader, unless XS was disabled
459 print PM <<"END";
3edbfbe5
TB
460
461\@ISA = qw(Exporter DynaLoader);
462END
2920c5d2
PP
463 }
464 else{
465 print PM <<"END";
466
467\@ISA = qw(Exporter);
468END
469 }
3edbfbe5 470}
e1666bf5 471
3edbfbe5 472print PM<<"END";
e1666bf5
TB
473# Items to export into callers namespace by default. Note: do not export
474# names by default without a very good reason. Use EXPORT_OK instead.
475# Do not simply export all your public functions/methods/constants.
a0d0e21e 476\@EXPORT = qw(
e1666bf5 477 @const_names
a0d0e21e 478);
f508c652
PP
479\$VERSION = '$TEMPLATE_VERSION';
480
e1666bf5
TB
481END
482
2920c5d2 483print PM <<"END" unless $opt_c or $opt_X;
a0d0e21e 484sub AUTOLOAD {
3edbfbe5
TB
485 # This AUTOLOAD is used to 'autoload' constants from the constant()
486 # XS function. If a constant is not found then control is passed
487 # to the AUTOLOAD in AutoLoader.
e1666bf5 488
2920c5d2 489 my \$constname;
a0d0e21e 490 (\$constname = \$AUTOLOAD) =~ s/.*:://;
1d3434b8 491 croak "&$module::constant not defined" if \$constname eq 'constant';
2920c5d2 492 my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
a0d0e21e
LW
493 if (\$! != 0) {
494 if (\$! =~ /Invalid/) {
495 \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
496 goto &AutoLoader::AUTOLOAD;
497 }
498 else {
2920c5d2 499 croak "Your vendor has not defined $module macro \$constname";
a0d0e21e
LW
500 }
501 }
1d3434b8 502 *\$AUTOLOAD = sub () { \$val };
a0d0e21e
LW
503 goto &\$AUTOLOAD;
504}
505
a0d0e21e 506END
a0d0e21e 507
2920c5d2
PP
508if( ! $opt_X ){ # print bootstrap, unless XS is disabled
509 print PM <<"END";
f508c652 510bootstrap $module \$VERSION;
2920c5d2
PP
511END
512}
513
514if( $opt_P ){ # if POD is disabled
515 $after = '__END__';
516}
517else {
518 $after = '=cut';
519}
520
521print PM <<"END";
a0d0e21e 522
e1666bf5 523# Preloaded methods go here.
a0d0e21e 524
2920c5d2 525# Autoload methods go after $after, and are processed by the autosplit program.
a0d0e21e
LW
526
5271;
e1666bf5 528__END__
a0d0e21e 529END
a0d0e21e 530
f508c652
PP
531$author = "A. U. Thor";
532$email = 'a.u.thor@a.galaxy.far.far.away';
533
5273d82d
IZ
534my $const_doc = '';
535my $fdecl_doc = '';
536if (@const_names and not $opt_P) {
537 $const_doc = <<EOD;
b73edd97 538\n=head1 Exported constants
5273d82d
IZ
539
540 @{[join "\n ", @const_names]}
541
542EOD
543}
544if (defined $fdecls and @$fdecls and not $opt_P) {
545 $fdecl_doc = <<EOD;
b73edd97 546\n=head1 Exported functions
5273d82d
IZ
547
548 @{[join "\n ", @$fdecls]}
549
550EOD
551}
552
f508c652
PP
553$pod = <<"END" unless $opt_P;
554## Below is the stub of documentation for your module. You better edit it!
555#
556#=head1 NAME
557#
558#$module - Perl extension for blah blah blah
559#
560#=head1 SYNOPSIS
561#
562# use $module;
563# blah blah blah
564#
565#=head1 DESCRIPTION
566#
567#Stub documentation for $module was created by h2xs. It looks like the
568#author of the extension was negligent enough to leave the stub
569#unedited.
570#
571#Blah blah blah.
5273d82d 572#$const_doc$fdecl_doc
f508c652
PP
573#=head1 AUTHOR
574#
575#$author, $email
576#
577#=head1 SEE ALSO
578#
579#perl(1).
580#
581#=cut
582END
583
584$pod =~ s/^\#//gm unless $opt_P;
585print PM $pod unless $opt_P;
586
a0d0e21e
LW
587close PM;
588
e1666bf5 589
2920c5d2 590if( ! $opt_X ){ # print XS, unless it is disabled
8e07c86e 591warn "Writing $ext$modpname/$modfname.xs\n";
e1666bf5 592
a0d0e21e
LW
593print XS <<"END";
594#include "EXTERN.h"
595#include "perl.h"
596#include "XSUB.h"
597
598END
a887ff11
BS
599if( @path_h ){
600 foreach my $path_h (@path_h) {
a0d0e21e
LW
601 my($h) = $path_h;
602 $h =~ s#^/usr/include/##;
ead2a595 603 if ($^O eq 'VMS') { $h =~ s#.*vms\]#sys/# or $h =~ s#.*[:>\]]##; }
a887ff11
BS
604 print XS qq{#include <$h>\n};
605 }
606 print XS "\n";
a0d0e21e
LW
607}
608
609if( ! $opt_c ){
610print XS <<"END";
611static int
d94c7266 612not_here(char *s)
a0d0e21e
LW
613{
614 croak("$module::%s not implemented on this architecture", s);
615 return -1;
616}
617
618static double
d94c7266 619constant(char *name, int arg)
a0d0e21e
LW
620{
621 errno = 0;
622 switch (*name) {
623END
624
e1666bf5
TB
625my(@AZ, @az, @under);
626
627foreach(@const_names){
628 @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
629 @az = 'a' .. 'z' if !@az && /^[a-z]/;
630 @under = '_' if !@under && /^_/;
631}
632
a0d0e21e
LW
633foreach $letter (@AZ, @az, @under) {
634
e1666bf5 635 last if $letter eq 'a' && !@const_names;
a0d0e21e
LW
636
637 print XS " case '$letter':\n";
638 my($name);
e1666bf5
TB
639 while (substr($const_names[0],0,1) eq $letter) {
640 $name = shift(@const_names);
ead2a595
PP
641 $macro = $prefix{$name} ? "$opt_p$name" : $name;
642 next if $const_xsub{$macro};
a0d0e21e
LW
643 print XS <<"END";
644 if (strEQ(name, "$name"))
ead2a595
PP
645#ifdef $macro
646 return $macro;
a0d0e21e
LW
647#else
648 goto not_there;
649#endif
650END
651 }
652 print XS <<"END";
653 break;
654END
655}
656print XS <<"END";
657 }
658 errno = EINVAL;
659 return 0;
660
661not_there:
662 errno = ENOENT;
663 return 0;
664}
665
e1666bf5
TB
666END
667}
668
ead2a595 669$prefix = "PREFIX = $opt_p" if defined $opt_p;
e1666bf5
TB
670# Now switch from C to XS by issuing the first MODULE declaration:
671print XS <<"END";
a0d0e21e 672
ead2a595
PP
673MODULE = $module PACKAGE = $module $prefix
674
675END
676
677foreach (sort keys %const_xsub) {
678 print XS <<"END";
679char *
680$_()
681
682 CODE:
683#ifdef $_
684 RETVAL = $_;
685#else
686 croak("Your vendor has not defined the $module macro $_");
687#endif
688
689 OUTPUT:
690 RETVAL
a0d0e21e 691
e1666bf5 692END
ead2a595 693}
e1666bf5
TB
694
695# If a constant() function was written then output a corresponding
696# XS declaration:
697print XS <<"END" unless $opt_c;
698
a0d0e21e
LW
699double
700constant(name,arg)
701 char * name
702 int arg
703
704END
a0d0e21e 705
5273d82d
IZ
706my %seen_decl;
707
708
ead2a595
PP
709sub print_decl {
710 my $fh = shift;
711 my $decl = shift;
712 my ($type, $name, $args) = @$decl;
5273d82d
IZ
713 return if $seen_decl{$name}++; # Need to do the same for docs as well?
714
ead2a595
PP
715 my @argnames = map {$_->[1]} @$args;
716 my @argtypes = map { normalize_type( $_->[0] ) } @$args;
5273d82d 717 my @argarrays = map { $_->[4] || '' } @$args;
ead2a595
PP
718 my $numargs = @$args;
719 if ($numargs and $argtypes[-1] eq '...') {
720 $numargs--;
721 $argnames[-1] = '...';
722 }
723 local $" = ', ';
724 $type = normalize_type($type);
725
726 print $fh <<"EOP";
727
728$type
729$name(@argnames)
730EOP
731
732 for $arg (0 .. $numargs - 1) {
733 print $fh <<"EOP";
5273d82d 734 $argtypes[$arg] $argnames[$arg]$argarrays[$arg]
ead2a595
PP
735EOP
736 }
737}
738
5273d82d
IZ
739# Should be called before any actual call to normalize_type().
740sub get_typemap {
741 # We do not want to read ./typemap by obvios reasons.
742 my @tm = qw(../../../typemap ../../typemap ../typemap);
743 my $stdtypemap = "$Config::Config{privlib}/ExtUtils/typemap";
744 unshift @tm, $stdtypemap;
745 my $proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
746 my $image;
747
748 foreach $typemap (@tm) {
749 next unless -e $typemap ;
750 # skip directories, binary files etc.
751 warn " Scanning $typemap\n";
752 warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
753 unless -T $typemap ;
754 open(TYPEMAP, $typemap)
755 or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
756 my $mode = 'Typemap';
757 while (<TYPEMAP>) {
758 next if /^\s*\#/;
759 if (/^INPUT\s*$/) { $mode = 'Input'; next; }
760 elsif (/^OUTPUT\s*$/) { $mode = 'Output'; next; }
761 elsif (/^TYPEMAP\s*$/) { $mode = 'Typemap'; next; }
762 elsif ($mode eq 'Typemap') {
763 next if /^\s*($|\#)/ ;
764 if ( ($type, $image) =
765 /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/o
766 # This may reference undefined functions:
767 and not ($image eq 'T_PACKED' and $typemap eq $stdtypemap)) {
768 normalize_type($type);
769 }
770 }
771 }
772 close(TYPEMAP) or die "Cannot close $typemap: $!";
773 }
774 %std_types = %types_seen;
775 %types_seen = ();
776}
777
ead2a595
PP
778
779sub normalize_type {
5273d82d 780 my $ignore_mods = '(?:\b(?:__const__|static|inline|__inline__)\b\s*)*';
ead2a595
PP
781 my $type = shift;
782 $type =~ s/$ignore_mods//go;
5273d82d 783 $type =~ s/([\]\[()])/ \1 /g;
ead2a595
PP
784 $type =~ s/\s+/ /g;
785 $type =~ s/\s+$//;
786 $type =~ s/^\s+//;
787 $type =~ s/\b\*/ */g;
788 $type =~ s/\*\b/* /g;
789 $type =~ s/\*\s+(?=\*)/*/g;
5273d82d
IZ
790 $types_seen{$type}++
791 unless $type eq '...' or $type eq 'void' or $std_types{$type};
ead2a595
PP
792 $type;
793}
794
795if ($opt_x) {
5273d82d 796 for $decl (@$fdecls_parsed) { print_decl(\*XS, $decl) }
ead2a595
PP
797}
798
a0d0e21e 799close XS;
5273d82d
IZ
800
801if (%types_seen) {
802 my $type;
803 warn "Writing $ext$modpname/typemap\n";
804 open TM, ">typemap" or die "Cannot open typemap file for write: $!";
805
806 for $type (keys %types_seen) {
807 print TM $type, "\t" x (6 - int((length $type)/8)), "T_PTROBJ\n"
808 }
809
810 close TM or die "Cannot close typemap file for write: $!";
811}
812
2920c5d2 813} # if( ! $opt_X )
e1666bf5 814
8e07c86e
AD
815warn "Writing $ext$modpname/Makefile.PL\n";
816open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
a0d0e21e 817
a0d0e21e
LW
818print PL <<'END';
819use ExtUtils::MakeMaker;
820# See lib/ExtUtils/MakeMaker.pm for details of how to influence
42793c05 821# the contents of the Makefile that is written.
a0d0e21e 822END
42793c05
TB
823print PL "WriteMakefile(\n";
824print PL " 'NAME' => '$module',\n";
c07a80fd 825print PL " 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n";
2920c5d2
PP
826if( ! $opt_X ){ # print C stuff, unless XS is disabled
827 print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n";
828 print PL " 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' \n";
829 print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n";
830}
a0d0e21e 831print PL ");\n";
f508c652
PP
832close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
833
834warn "Writing $ext$modpname/test.pl\n";
835open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\n";
836print EX <<'_END_';
837# Before `make install' is performed this script should be runnable with
838# `make test'. After `make install' it should work as `perl test.pl'
839
840######################### We start with some black magic to print on failure.
841
842# Change 1..1 below to 1..last_test_to_print .
843# (It may become useful if the test is moved to ./t subdirectory.)
844
5ae7f1db 845BEGIN { $| = 1; print "1..1\n"; }
f508c652
PP
846END {print "not ok 1\n" unless $loaded;}
847_END_
848print EX <<_END_;
849use $module;
850_END_
851print EX <<'_END_';
852$loaded = 1;
853print "ok 1\n";
854
855######################### End of black magic.
856
857# Insert your test code below (better if it prints "ok 13"
858# (correspondingly "not ok 13") depending on the success of chunk 13
859# of the test code):
e1666bf5 860
f508c652
PP
861_END_
862close(EX) || die "Can't close $ext$modpname/test.pl: $!\n";
a0d0e21e 863
c07a80fd
PP
864warn "Writing $ext$modpname/Changes\n";
865open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n";
866print EX "Revision history for Perl extension $module.\n\n";
867print EX "$TEMPLATE_VERSION ",scalar localtime,"\n";
868print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n";
869close(EX) || die "Can't close $ext$modpname/Changes: $!\n";
870
871warn "Writing $ext$modpname/MANIFEST\n";
5ae7f1db
PP
872open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!";
873@files = <*>;
874if (!@files) {
875 eval {opendir(D,'.');};
876 unless ($@) { @files = readdir(D); closedir(D); }
877}
878if (!@files) { @files = map {chomp && $_} `ls`; }
55497cff
PP
879if ($^O eq 'VMS') {
880 foreach (@files) {
881 # Clip trailing '.' for portability -- non-VMS OSs don't expect it
882 s%\.$%%;
883 # Fix up for case-sensitive file systems
884 s/$modfname/$modfname/i && next;
885 $_ = "\U$_" if $_ eq 'manifest' or $_ eq 'changes';
bbce6d69 886 $_ = 'Makefile.PL' if $_ eq 'makefile.pl';
55497cff
PP
887 }
888}
3e3baf6d 889print MANI join("\n",@files), "\n";
5ae7f1db 890close MANI;
40000a8c 891!NO!SUBS!
4633a7c4
LW
892
893close OUT or die "Can't close $file: $!";
894chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
895exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
8a5546a1 896chdir $origdir;