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