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