This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: Almost OK: Perl 5.004_62 on VMS 7.1
[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
PP
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
PP
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
b73edd97 42B<h2xs> [B<-AOPXcdf>] [B<-v> version] [B<-n> module_name] [B<-p> prefix] [B<-s> sub] [headerfile [extra_libraries]]
f508c652
PP
43
44B<h2xs> B<-h>
3edbfbe5
TB
45
46=head1 DESCRIPTION
47
48I<h2xs> builds a Perl extension from any C header file. The extension will
49include functions which can be used to retrieve the value of any #define
50statement which was in the C header.
51
52The I<module_name> will be used for the name of the extension. If
53module_name is not supplied then the name of the header file will be used,
54with the first character capitalized.
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
PP
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
PP
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
PP
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
PP
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
PP
97=item B<-d>
98
99Turn on debugging messages.
100
f508c652 101=item B<-f>
3edbfbe5 102
f508c652
PP
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
PP
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
PP
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
PP
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
PP
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
PP
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
e1666bf5 252$path_h = shift;
a0d0e21e 253$extralibs = "@ARGV";
e1666bf5
TB
254
255usage "Must supply header file or module name\n"
256 unless ($path_h or $opt_n);
257
a0d0e21e
LW
258
259if( $path_h ){
e1666bf5
TB
260 $name = $path_h;
261 if( $path_h =~ s#::#/#g && $opt_n ){
262 warn "Nesting of headerfile ignored with -n\n";
263 }
264 $path_h .= ".h" unless $path_h =~ /\.h$/;
760ac839
LW
265 $fullpath = $path_h;
266 $path_h =~ s/,.*$// if $opt_x;
ead2a595
PP
267 if ($^O eq 'VMS') { # Consider overrides of default location
268 if ($path_h !~ m![:>\[]!) {
269 my($hadsys) = ($path_h =~ s!^sys/!!i);
270 if ($ENV{'DECC$System_Include'}) { $path_h = "DECC\$System_Include:$path_h"; }
271 elsif ($ENV{'DECC$Library_Include'}) { $path_h = "DECC\$Library_Include:$path_h"; }
272 elsif ($ENV{'GNU_CC_Include'}) { $path_h = 'GNU_CC_Include:' .
273 ($hadsys ? '[vms]' : '[000000]') . $path_h; }
274 elsif ($ENV{'VAXC$Include'}) { $path_h = "VAXC\$_Include:$path_h"; }
275 else { $path_h = "Sys\$Library:$path_h"; }
276 }
277 }
278 elsif ($^O eq 'os2') {
5273d82d
IZ
279 $path_h = "/usr/include/$path_h"
280 if $path_h !~ m#^([a-z]:)?[./]#i and -r "/usr/include/$path_h";
281 }
282 else {
283 $path_h = "/usr/include/$path_h"
284 if $path_h !~ m#^[./]# and -r "/usr/include/$path_h";
ead2a595 285 }
5273d82d
IZ
286
287 if (!$opt_c) {
288 die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
289 # Scan the header file (we should deal with nested header files)
290 # Record the names of simple #define constants into const_names
291 # Function prototypes are not (currently) processed.
292 open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
293 while (<CH>) {
b73edd97
PP
294 if (/^#[ \t]*define\s+([\$\w]+)\b\s*[^("]/) {
295 print "Matched $_ ($1)\n" if $opt_d;
e1666bf5
TB
296 $_ = $1;
297 next if /^_.*_h_*$/i; # special case, but for what?
760ac839 298 if (defined $opt_p) {
5273d82d
IZ
299 if (!/^$opt_p(\d)/) {
300 ++$prefix{$_} if s/^$opt_p//;
301 }
302 else {
303 warn "can't remove $opt_p prefix from '$_'!\n";
304 }
ead2a595 305 }
e1666bf5 306 $const_names{$_}++;
5273d82d
IZ
307 }
308 }
309 close(CH);
310 @const_names = sort keys %const_names;
e1666bf5 311 }
a0d0e21e
LW
312}
313
e1666bf5 314
a0d0e21e
LW
315$module = $opt_n || do {
316 $name =~ s/\.h$//;
317 if( $name !~ /::/ ){
318 $name =~ s#^.*/##;
319 $name = "\u$name";
320 }
321 $name;
322};
323
8e07c86e 324(chdir 'ext', $ext = 'ext/') if -d 'ext';
a0d0e21e
LW
325
326if( $module =~ /::/ ){
327 $nested = 1;
328 @modparts = split(/::/,$module);
329 $modfname = $modparts[-1];
330 $modpname = join('/',@modparts);
331}
332else {
333 $nested = 0;
334 @modparts = ();
335 $modfname = $modpname = $module;
336}
337
338
2920c5d2
PP
339if ($opt_O) {
340 warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname;
341} else {
342 die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
343}
c07a80fd
PP
344if( $nested ){
345 $modpath = "";
346 foreach (@modparts){
347 mkdir("$modpath$_", 0777);
348 $modpath .= "$_/";
349 }
350}
a0d0e21e 351mkdir($modpname, 0777);
8e07c86e 352chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
a0d0e21e 353
5273d82d
IZ
354my %types_seen;
355my %std_types;
356my $fdecls;
357my $fdecls_parsed;
358
2920c5d2
PP
359if( ! $opt_X ){ # use XS, unless it was disabled
360 open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
5273d82d
IZ
361 if ($opt_x) {
362 require C::Scan; # Run-time directive
363 require Config; # Run-time directive
364 warn "Scanning typemaps...\n";
365 get_typemap();
366 my $c;
367 my $filter;
368 my $filename = $path_h;
369 my $addflags = $opt_F || '';
370 if ($fullpath =~ /,/) {
371 $filename = $`;
372 $filter = $';
373 }
374 warn "Scanning $filename for functions...\n";
375 $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter,
376 'add_cppflags' => $addflags;
377 $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]);
378
379 $fdecls_parsed = $c->get('parsed_fdecls');
380 $fdecls = $c->get('fdecls');
381 }
2920c5d2 382}
5273d82d 383
8e07c86e 384open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
a0d0e21e 385
a0d0e21e 386$" = "\n\t";
8e07c86e 387warn "Writing $ext$modpname/$modfname.pm\n";
a0d0e21e 388
a0d0e21e
LW
389print PM <<"END";
390package $module;
391
2920c5d2
PP
392use strict;
393END
394
395if( $opt_X || $opt_c || $opt_A ){
396 # we won't have our own AUTOLOAD(), so won't have $AUTOLOAD
397 print PM <<'END';
f192e801 398use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
2920c5d2
PP
399END
400}
401else{
402 # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
403 # will want Carp.
404 print PM <<'END';
405use Carp;
f192e801 406use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
2920c5d2
PP
407END
408}
409
410print PM <<'END';
411
a0d0e21e 412require Exporter;
2920c5d2
PP
413END
414
415print PM <<"END" if ! $opt_X; # use DynaLoader, unless XS was disabled
a0d0e21e 416require DynaLoader;
3edbfbe5
TB
417END
418
2920c5d2
PP
419# require autoloader if XS is disabled.
420# if XS is enabled, require autoloader unless autoloading is disabled.
464ed3b6 421if( ($opt_X && (! $opt_A)) || (!$opt_X) ) {
3edbfbe5
TB
422 print PM <<"END";
423require AutoLoader;
424END
425}
426
2920c5d2 427if( $opt_X || ($opt_c && ! $opt_A) ){
3edbfbe5 428 # we won't have our own AUTOLOAD(), so we'll inherit it.
2920c5d2
PP
429 if( ! $opt_X ) { # use DynaLoader, unless XS was disabled
430 print PM <<"END";
e1666bf5 431
a0d0e21e 432\@ISA = qw(Exporter AutoLoader DynaLoader);
3edbfbe5 433END
2920c5d2
PP
434 }
435 else{
436 print PM <<"END";
437
438\@ISA = qw(Exporter AutoLoader);
439END
440 }
3edbfbe5
TB
441}
442else{
443 # 1) we have our own AUTOLOAD(), so don't need to inherit it.
444 # or
445 # 2) we don't want autoloading mentioned.
2920c5d2
PP
446 if( ! $opt_X ){ # use DynaLoader, unless XS was disabled
447 print PM <<"END";
3edbfbe5
TB
448
449\@ISA = qw(Exporter DynaLoader);
450END
2920c5d2
PP
451 }
452 else{
453 print PM <<"END";
454
455\@ISA = qw(Exporter);
456END
457 }
3edbfbe5 458}
e1666bf5 459
3edbfbe5 460print PM<<"END";
e1666bf5
TB
461# Items to export into callers namespace by default. Note: do not export
462# names by default without a very good reason. Use EXPORT_OK instead.
463# Do not simply export all your public functions/methods/constants.
a0d0e21e 464\@EXPORT = qw(
e1666bf5 465 @const_names
a0d0e21e 466);
f508c652
PP
467\$VERSION = '$TEMPLATE_VERSION';
468
e1666bf5
TB
469END
470
2920c5d2 471print PM <<"END" unless $opt_c or $opt_X;
a0d0e21e 472sub AUTOLOAD {
3edbfbe5
TB
473 # This AUTOLOAD is used to 'autoload' constants from the constant()
474 # XS function. If a constant is not found then control is passed
475 # to the AUTOLOAD in AutoLoader.
e1666bf5 476
2920c5d2 477 my \$constname;
a0d0e21e 478 (\$constname = \$AUTOLOAD) =~ s/.*:://;
2920c5d2 479 my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
a0d0e21e
LW
480 if (\$! != 0) {
481 if (\$! =~ /Invalid/) {
482 \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
483 goto &AutoLoader::AUTOLOAD;
484 }
485 else {
2920c5d2 486 croak "Your vendor has not defined $module macro \$constname";
a0d0e21e
LW
487 }
488 }
489 eval "sub \$AUTOLOAD { \$val }";
490 goto &\$AUTOLOAD;
491}
492
a0d0e21e 493END
a0d0e21e 494
2920c5d2
PP
495if( ! $opt_X ){ # print bootstrap, unless XS is disabled
496 print PM <<"END";
f508c652 497bootstrap $module \$VERSION;
2920c5d2
PP
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.
a0d0e21e 511
2920c5d2 512# Autoload methods go after $after, and are processed by the autosplit program.
a0d0e21e
LW
513
5141;
e1666bf5 515__END__
a0d0e21e 516END
a0d0e21e 517
f508c652
PP
518$author = "A. U. Thor";
519$email = 'a.u.thor@a.galaxy.far.far.away';
520
5273d82d
IZ
521my $const_doc = '';
522my $fdecl_doc = '';
523if (@const_names and not $opt_P) {
524 $const_doc = <<EOD;
b73edd97 525\n=head1 Exported constants
5273d82d
IZ
526
527 @{[join "\n ", @const_names]}
528
529EOD
530}
531if (defined $fdecls and @$fdecls and not $opt_P) {
532 $fdecl_doc = <<EOD;
b73edd97 533\n=head1 Exported functions
5273d82d
IZ
534
535 @{[join "\n ", @$fdecls]}
536
537EOD
538}
539
f508c652
PP
540$pod = <<"END" unless $opt_P;
541## Below is the stub of documentation for your module. You better edit it!
542#
543#=head1 NAME
544#
545#$module - Perl extension for blah blah blah
546#
547#=head1 SYNOPSIS
548#
549# use $module;
550# blah blah blah
551#
552#=head1 DESCRIPTION
553#
554#Stub documentation for $module was created by h2xs. It looks like the
555#author of the extension was negligent enough to leave the stub
556#unedited.
557#
558#Blah blah blah.
5273d82d 559#$const_doc$fdecl_doc
f508c652
PP
560#=head1 AUTHOR
561#
562#$author, $email
563#
564#=head1 SEE ALSO
565#
566#perl(1).
567#
568#=cut
569END
570
571$pod =~ s/^\#//gm unless $opt_P;
572print PM $pod unless $opt_P;
573
a0d0e21e
LW
574close PM;
575
e1666bf5 576
2920c5d2 577if( ! $opt_X ){ # print XS, unless it is disabled
8e07c86e 578warn "Writing $ext$modpname/$modfname.xs\n";
e1666bf5 579
a0d0e21e 580print XS <<"END";
4633a7c4
LW
581#ifdef __cplusplus
582extern "C" {
583#endif
a0d0e21e
LW
584#include "EXTERN.h"
585#include "perl.h"
586#include "XSUB.h"
4633a7c4
LW
587#ifdef __cplusplus
588}
589#endif
a0d0e21e
LW
590
591END
592if( $path_h ){
593 my($h) = $path_h;
594 $h =~ s#^/usr/include/##;
ead2a595 595 if ($^O eq 'VMS') { $h =~ s#.*vms\]#sys/# or $h =~ s#.*[:>\]]##; }
a0d0e21e
LW
596print XS <<"END";
597#include <$h>
598
599END
600}
601
602if( ! $opt_c ){
603print XS <<"END";
604static int
605not_here(s)
606char *s;
607{
608 croak("$module::%s not implemented on this architecture", s);
609 return -1;
610}
611
612static double
613constant(name, arg)
614char *name;
615int arg;
616{
617 errno = 0;
618 switch (*name) {
619END
620
e1666bf5
TB
621my(@AZ, @az, @under);
622
623foreach(@const_names){
624 @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
625 @az = 'a' .. 'z' if !@az && /^[a-z]/;
626 @under = '_' if !@under && /^_/;
627}
628
a0d0e21e
LW
629foreach $letter (@AZ, @az, @under) {
630
e1666bf5 631 last if $letter eq 'a' && !@const_names;
a0d0e21e
LW
632
633 print XS " case '$letter':\n";
634 my($name);
e1666bf5
TB
635 while (substr($const_names[0],0,1) eq $letter) {
636 $name = shift(@const_names);
ead2a595
PP
637 $macro = $prefix{$name} ? "$opt_p$name" : $name;
638 next if $const_xsub{$macro};
a0d0e21e
LW
639 print XS <<"END";
640 if (strEQ(name, "$name"))
ead2a595
PP
641#ifdef $macro
642 return $macro;
a0d0e21e
LW
643#else
644 goto not_there;
645#endif
646END
647 }
648 print XS <<"END";
649 break;
650END
651}
652print XS <<"END";
653 }
654 errno = EINVAL;
655 return 0;
656
657not_there:
658 errno = ENOENT;
659 return 0;
660}
661
e1666bf5
TB
662END
663}
664
ead2a595 665$prefix = "PREFIX = $opt_p" if defined $opt_p;
e1666bf5
TB
666# Now switch from C to XS by issuing the first MODULE declaration:
667print XS <<"END";
a0d0e21e 668
ead2a595
PP
669MODULE = $module PACKAGE = $module $prefix
670
671END
672
673foreach (sort keys %const_xsub) {
674 print XS <<"END";
675char *
676$_()
677
678 CODE:
679#ifdef $_
680 RETVAL = $_;
681#else
682 croak("Your vendor has not defined the $module macro $_");
683#endif
684
685 OUTPUT:
686 RETVAL
a0d0e21e 687
e1666bf5 688END
ead2a595 689}
e1666bf5
TB
690
691# If a constant() function was written then output a corresponding
692# XS declaration:
693print XS <<"END" unless $opt_c;
694
a0d0e21e
LW
695double
696constant(name,arg)
697 char * name
698 int arg
699
700END
a0d0e21e 701
5273d82d
IZ
702my %seen_decl;
703
704
ead2a595
PP
705sub print_decl {
706 my $fh = shift;
707 my $decl = shift;
708 my ($type, $name, $args) = @$decl;
5273d82d
IZ
709 return if $seen_decl{$name}++; # Need to do the same for docs as well?
710
ead2a595
PP
711 my @argnames = map {$_->[1]} @$args;
712 my @argtypes = map { normalize_type( $_->[0] ) } @$args;
5273d82d 713 my @argarrays = map { $_->[4] || '' } @$args;
ead2a595
PP
714 my $numargs = @$args;
715 if ($numargs and $argtypes[-1] eq '...') {
716 $numargs--;
717 $argnames[-1] = '...';
718 }
719 local $" = ', ';
720 $type = normalize_type($type);
721
722 print $fh <<"EOP";
723
724$type
725$name(@argnames)
726EOP
727
728 for $arg (0 .. $numargs - 1) {
729 print $fh <<"EOP";
5273d82d 730 $argtypes[$arg] $argnames[$arg]$argarrays[$arg]
ead2a595
PP
731EOP
732 }
733}
734
5273d82d
IZ
735# Should be called before any actual call to normalize_type().
736sub get_typemap {
737 # We do not want to read ./typemap by obvios reasons.
738 my @tm = qw(../../../typemap ../../typemap ../typemap);
739 my $stdtypemap = "$Config::Config{privlib}/ExtUtils/typemap";
740 unshift @tm, $stdtypemap;
741 my $proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
742 my $image;
743
744 foreach $typemap (@tm) {
745 next unless -e $typemap ;
746 # skip directories, binary files etc.
747 warn " Scanning $typemap\n";
748 warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
749 unless -T $typemap ;
750 open(TYPEMAP, $typemap)
751 or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
752 my $mode = 'Typemap';
753 while (<TYPEMAP>) {
754 next if /^\s*\#/;
755 if (/^INPUT\s*$/) { $mode = 'Input'; next; }
756 elsif (/^OUTPUT\s*$/) { $mode = 'Output'; next; }
757 elsif (/^TYPEMAP\s*$/) { $mode = 'Typemap'; next; }
758 elsif ($mode eq 'Typemap') {
759 next if /^\s*($|\#)/ ;
760 if ( ($type, $image) =
761 /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/o
762 # This may reference undefined functions:
763 and not ($image eq 'T_PACKED' and $typemap eq $stdtypemap)) {
764 normalize_type($type);
765 }
766 }
767 }
768 close(TYPEMAP) or die "Cannot close $typemap: $!";
769 }
770 %std_types = %types_seen;
771 %types_seen = ();
772}
773
ead2a595
PP
774
775sub normalize_type {
5273d82d 776 my $ignore_mods = '(?:\b(?:__const__|static|inline|__inline__)\b\s*)*';
ead2a595
PP
777 my $type = shift;
778 $type =~ s/$ignore_mods//go;
5273d82d 779 $type =~ s/([\]\[()])/ \1 /g;
ead2a595
PP
780 $type =~ s/\s+/ /g;
781 $type =~ s/\s+$//;
782 $type =~ s/^\s+//;
783 $type =~ s/\b\*/ */g;
784 $type =~ s/\*\b/* /g;
785 $type =~ s/\*\s+(?=\*)/*/g;
5273d82d
IZ
786 $types_seen{$type}++
787 unless $type eq '...' or $type eq 'void' or $std_types{$type};
ead2a595
PP
788 $type;
789}
790
791if ($opt_x) {
5273d82d 792 for $decl (@$fdecls_parsed) { print_decl(\*XS, $decl) }
ead2a595
PP
793}
794
a0d0e21e 795close XS;
5273d82d
IZ
796
797if (%types_seen) {
798 my $type;
799 warn "Writing $ext$modpname/typemap\n";
800 open TM, ">typemap" or die "Cannot open typemap file for write: $!";
801
802 for $type (keys %types_seen) {
803 print TM $type, "\t" x (6 - int((length $type)/8)), "T_PTROBJ\n"
804 }
805
806 close TM or die "Cannot close typemap file for write: $!";
807}
808
2920c5d2 809} # if( ! $opt_X )
e1666bf5 810
8e07c86e
AD
811warn "Writing $ext$modpname/Makefile.PL\n";
812open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
a0d0e21e 813
a0d0e21e
LW
814print PL <<'END';
815use ExtUtils::MakeMaker;
816# See lib/ExtUtils/MakeMaker.pm for details of how to influence
42793c05 817# the contents of the Makefile that is written.
a0d0e21e 818END
42793c05
TB
819print PL "WriteMakefile(\n";
820print PL " 'NAME' => '$module',\n";
c07a80fd 821print PL " 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n";
2920c5d2
PP
822if( ! $opt_X ){ # print C stuff, unless XS is disabled
823 print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n";
824 print PL " 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' \n";
825 print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n";
826}
a0d0e21e 827print PL ");\n";
f508c652
PP
828close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
829
830warn "Writing $ext$modpname/test.pl\n";
831open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\n";
832print EX <<'_END_';
833# Before `make install' is performed this script should be runnable with
834# `make test'. After `make install' it should work as `perl test.pl'
835
836######################### We start with some black magic to print on failure.
837
838# Change 1..1 below to 1..last_test_to_print .
839# (It may become useful if the test is moved to ./t subdirectory.)
840
5ae7f1db 841BEGIN { $| = 1; print "1..1\n"; }
f508c652
PP
842END {print "not ok 1\n" unless $loaded;}
843_END_
844print EX <<_END_;
845use $module;
846_END_
847print EX <<'_END_';
848$loaded = 1;
849print "ok 1\n";
850
851######################### End of black magic.
852
853# Insert your test code below (better if it prints "ok 13"
854# (correspondingly "not ok 13") depending on the success of chunk 13
855# of the test code):
e1666bf5 856
f508c652
PP
857_END_
858close(EX) || die "Can't close $ext$modpname/test.pl: $!\n";
a0d0e21e 859
c07a80fd
PP
860warn "Writing $ext$modpname/Changes\n";
861open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n";
862print EX "Revision history for Perl extension $module.\n\n";
863print EX "$TEMPLATE_VERSION ",scalar localtime,"\n";
864print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n";
865close(EX) || die "Can't close $ext$modpname/Changes: $!\n";
866
867warn "Writing $ext$modpname/MANIFEST\n";
5ae7f1db
PP
868open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!";
869@files = <*>;
870if (!@files) {
871 eval {opendir(D,'.');};
872 unless ($@) { @files = readdir(D); closedir(D); }
873}
874if (!@files) { @files = map {chomp && $_} `ls`; }
55497cff
PP
875if ($^O eq 'VMS') {
876 foreach (@files) {
877 # Clip trailing '.' for portability -- non-VMS OSs don't expect it
878 s%\.$%%;
879 # Fix up for case-sensitive file systems
880 s/$modfname/$modfname/i && next;
881 $_ = "\U$_" if $_ eq 'manifest' or $_ eq 'changes';
bbce6d69 882 $_ = 'Makefile.PL' if $_ eq 'makefile.pl';
55497cff
PP
883 }
884}
3e3baf6d 885print MANI join("\n",@files), "\n";
5ae7f1db 886close MANI;
40000a8c 887!NO!SUBS!
4633a7c4
LW
888
889close OUT or die "Can't close $file: $!";
890chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
891exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';