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