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