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