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