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 =item B<-F>
 131
 132 Additional flags to specify to C preprocessor when scanning header for
 133 function declarations. Should not be used without B<-x>.
 134
 135 =back
 136
 137 =head1 EXAMPLES
 138
 139
 140         # Default behavior, extension is Rusers
 141         h2xs rpcsvc/rusers
 142
 143         # Same, but extension is RUSERS
 144         h2xs -n RUSERS rpcsvc/rusers
 145
 146         # Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
 147         h2xs rpcsvc::rusers
 148
 149         # Extension is ONC::RPC.  Still finds <rpcsvc/rusers.h>
 150         h2xs -n ONC::RPC rpcsvc/rusers
 151
 152         # Without constant() or AUTOLOAD
 153         h2xs -c rpcsvc/rusers
 154
 155         # Creates templates for an extension named RPC
 156         h2xs -cfn RPC
 157
 158         # Extension is ONC::RPC.
 159         h2xs -cfn ONC::RPC
 160
 161         # Makefile.PL will look for library -lrpc in
 162         # additional directory /opt/net/lib
 163         h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
 164
 165         # Extension is DCE::rgynbase
 166         # prefix "sec_rgy_" is dropped from perl function names
 167         h2xs -n DCE::rgynbase -p sec_rgy_ dce/rgynbase
 168
 169         # Extension is DCE::rgynbase
 170         # prefix "sec_rgy_" is dropped from perl function names
 171         # subroutines are created for sec_rgy_wildcard_name and sec_rgy_wildcard_sid
 172         h2xs -n DCE::rgynbase -p sec_rgy_ \
 173         -s sec_rgy_wildcard_name,sec_rgy_wildcard_sid dce/rgynbase
 174
 175         # Make XS with defines in perl.h, and function declarations
 176         # visible from perl.h. Name of the extension is perl1.
 177         # When scanning perl.h, define -DEXT=extern -DdEXT= -DINIT(x)=
 178         # Extra backslashes below because the string is passed to shell.
 179         h2xs -xn perl1 -F "-DEXT=extern -DdEXT= -DINIT\(x\)=" \
 180         ../perl5_003_01/perl.h
 181
 182         # Same with function declaration in proto.h as visible from perl.h.
 183         perl H:\get\perl\perl5_003_01.try\utils\h2xs -xn perl1 \
 184         ../perl5_003_01/perl.h,proto.h
 185
 186 =head1 ENVIRONMENT
 187
 188 No environment variables are used.
 189
 190 =head1 AUTHOR
 191
 192 Larry Wall and others
 193
 194 =head1 SEE ALSO
 195
 196 L<perl>, L<perlxstut>, L<ExtUtils::MakeMaker>, and L<AutoLoader>.
 197
 198 =head1 DIAGNOSTICS
 199
 200 The usual warnings if it cannot read or write the files involved.
 201
 202 =cut
 203
 204 my( $H2XS_VERSION ) = ' $Revision: 1.16 $ ' =~ /\$Revision:\s+([^\s]+)/;
 205 my $TEMPLATE_VERSION = '0.01';
 206
 207 use Getopt::Std;
 208
 209 sub usage{
 210         warn "@_\n" if @_;
 211     die "h2xs [-AOPXcfh] [-v version] [-n module_name] [-p prefix] [-s subs] [headerfile [extra_libraries]]
 212 version: $H2XS_VERSION
 213     -f   Force creation of the extension even if the C header does not exist.
 214     -n   Specify a name to use for the extension (recommended).
 215     -c   Omit the constant() function and specialised AUTOLOAD from the XS file.
 216     -p   Specify a prefix which should be removed from the Perl function names.
 217     -s   Create subroutines for specified macros.
 218     -A   Omit all autoloading facilities (implies -c).
 219     -O   Allow overwriting of a pre-existing extension directory.
 220     -P   Omit the stub POD section.
 221     -X   Omit the XS portion.
 222     -v   Specify a version number for this extension.
 223     -x   Autogenerate XSUBs using C::Scan.
 224     -F   Additional flags for C preprocessor (used with -x).
 225     -h   Display this help message
 226 extra_libraries
 227          are any libraries that might be needed for loading the
 228          extension, e.g. -lm would try to link in the math library.
 229 ";
 230 }
 231
 232
 233 getopts("AOPXcfhxv:n:p:s:F:") || usage;
 234
 235 usage if $opt_h;
 236
 237 if( $opt_v ){
 238         $TEMPLATE_VERSION = $opt_v;
 239 }
 240 $opt_c = 1 if $opt_A;
 241 %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s;
 242
 243 $path_h    = shift;
 244 $extralibs = "@ARGV";
 245
 246 usage "Must supply header file or module name\n"
 247         unless ($path_h or $opt_n);
 248
 249
 250 if( $path_h ){
 251     $name = $path_h;
 252     if( $path_h =~ s#::#/#g && $opt_n ){
 253         warn "Nesting of headerfile ignored with -n\n";
 254     }
 255     $path_h .= ".h" unless $path_h =~ /\.h$/;
 256     $fullpath = $path_h;
 257     $path_h =~ s/,.*$// if $opt_x;
 258     if ($^O eq 'VMS') {  # Consider overrides of default location
 259         if ($path_h !~ m![:>\[]!) {
 260             my($hadsys) = ($path_h =~ s!^sys/!!i);
 261             if ($ENV{'DECC$System_Include'})     { $path_h = "DECC\$System_Include:$path_h";    }
 262             elsif ($ENV{'DECC$Library_Include'}) { $path_h = "DECC\$Library_Include:$path_h";   }
 263             elsif ($ENV{'GNU_CC_Include'})       { $path_h = 'GNU_CC_Include:' .
 264                                                     ($hadsys ? '[vms]' : '[000000]') . $path_h; }
 265             elsif ($ENV{'VAXC$Include'})         { $path_h = "VAXC\$_Include:$path_h";          }
 266             else                                 { $path_h = "Sys\$Library:$path_h";            }
 267         }
 268     }
 269     elsif ($^O eq 'os2') {
 270         $path_h = "/usr/include/$path_h" unless $path_h =~ m#^([a-z]:)?[./]#i;
 271     }
 272     else { $path_h = "/usr/include/$path_h" unless $path_h =~ m#^[./]#; }
 273     die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
 274
 275     # Scan the header file (we should deal with nested header files)
 276     # Record the names of simple #define constants into const_names
 277     # Function prototypes are not (currently) processed.
 278     open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
 279     while (<CH>) {
 280         if (/^#[ \t]*define\s+([\$\w]+)\b\s*[^("]/) {
 281             print "Matched $_ ($1)\n";
 282             $_ = $1;
 283             next if /^_.*_h_*$/i; # special case, but for what?
 284             if (defined $opt_p) {
 285                 if (!/^$opt_p(\d)/) {
 286                     ++$prefix{$_} if s/^$opt_p//;
 287                 }
 288                 else {
 289                     warn "can't remove $opt_p prefix from '$_'!\n";
 290                 }
 291             }
 292             $const_names{$_}++;
 293         }
 294     }
 295     close(CH);
 296     @const_names = sort keys %const_names;
 297 }
 298
 299
 300 $module = $opt_n || do {
 301         $name =~ s/\.h$//;
 302         if( $name !~ /::/ ){
 303                 $name =~ s#^.*/##;
 304                 $name = "\u$name";
 305         }
 306         $name;
 307 };
 308
 309 (chdir 'ext', $ext = 'ext/') if -d 'ext';
 310
 311 if( $module =~ /::/ ){
 312         $nested = 1;
 313         @modparts = split(/::/,$module);
 314         $modfname = $modparts[-1];
 315         $modpname = join('/',@modparts);
 316 }
 317 else {
 318         $nested = 0;
 319         @modparts = ();
 320         $modfname = $modpname = $module;
 321 }
 322
 323
 324 if ($opt_O) {
 325         warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname;
 326 } else {
 327         die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
 328 }
 329 if( $nested ){
 330         $modpath = "";
 331         foreach (@modparts){
 332                 mkdir("$modpath$_", 0777);
 333                 $modpath .= "$_/";
 334         }
 335 }
 336 mkdir($modpname, 0777);
 337 chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
 338
 339 if( ! $opt_X ){  # use XS, unless it was disabled
 340   open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
 341 }
 342 open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
 343
 344 $" = "\n\t";
 345 warn "Writing $ext$modpname/$modfname.pm\n";
 346
 347 print PM <<"END";
 348 package $module;
 349
 350 use strict;
 351 END
 352
 353 if( $opt_X || $opt_c || $opt_A ){
 354         # we won't have our own AUTOLOAD(), so won't have $AUTOLOAD
 355         print PM <<'END';
 356 use vars qw($VERSION @ISA @EXPORT);
 357 END
 358 }
 359 else{
 360         # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
 361         # will want Carp.
 362         print PM <<'END';
 363 use Carp;
 364 use vars qw($VERSION @ISA @EXPORT $AUTOLOAD);
 365 END
 366 }
 367
 368 print PM <<'END';
 369
 370 require Exporter;
 371 END
 372
 373 print PM <<"END" if ! $opt_X;  # use DynaLoader, unless XS was disabled
 374 require DynaLoader;
 375 END
 376
 377 # require autoloader if XS is disabled.
 378 # if XS is enabled, require autoloader unless autoloading is disabled.
 379 if( $opt_X || (! $opt_A) ){
 380         print PM <<"END";
 381 require AutoLoader;
 382 END
 383 }
 384
 385 if( $opt_X || ($opt_c && ! $opt_A) ){
 386         # we won't have our own AUTOLOAD(), so we'll inherit it.
 387         if( ! $opt_X ) { # use DynaLoader, unless XS was disabled
 388                 print PM <<"END";
 389
 390 \@ISA = qw(Exporter AutoLoader DynaLoader);
 391 END
 392         }
 393         else{
 394                 print PM <<"END";
 395
 396 \@ISA = qw(Exporter AutoLoader);
 397 END
 398         }
 399 }
 400 else{
 401         # 1) we have our own AUTOLOAD(), so don't need to inherit it.
 402         # or
 403         # 2) we don't want autoloading mentioned.
 404         if( ! $opt_X ){ # use DynaLoader, unless XS was disabled
 405                 print PM <<"END";
 406
 407 \@ISA = qw(Exporter DynaLoader);
 408 END
 409         }
 410         else{
 411                 print PM <<"END";
 412
 413 \@ISA = qw(Exporter);
 414 END
 415         }
 416 }
 417
 418 print PM<<"END";
 419 # Items to export into callers namespace by default. Note: do not export
 420 # names by default without a very good reason. Use EXPORT_OK instead.
 421 # Do not simply export all your public functions/methods/constants.
 422 \@EXPORT = qw(
 423         @const_names
 424 );
 425 \$VERSION = '$TEMPLATE_VERSION';
 426
 427 END
 428
 429 print PM <<"END" unless $opt_c or $opt_X;
 430 sub AUTOLOAD {
 431     # This AUTOLOAD is used to 'autoload' constants from the constant()
 432     # XS function.  If a constant is not found then control is passed
 433     # to the AUTOLOAD in AutoLoader.
 434
 435     my \$constname;
 436     (\$constname = \$AUTOLOAD) =~ s/.*:://;
 437     my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
 438     if (\$! != 0) {
 439         if (\$! =~ /Invalid/) {
 440             \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
 441             goto &AutoLoader::AUTOLOAD;
 442         }
 443         else {
 444                 croak "Your vendor has not defined $module macro \$constname";
 445         }
 446     }
 447     eval "sub \$AUTOLOAD { \$val }";
 448     goto &\$AUTOLOAD;
 449 }
 450
 451 END
 452
 453 if( ! $opt_X ){ # print bootstrap, unless XS is disabled
 454         print PM <<"END";
 455 bootstrap $module \$VERSION;
 456 END
 457 }
 458
 459 if( $opt_P ){ # if POD is disabled
 460         $after = '__END__';
 461 }
 462 else {
 463         $after = '=cut';
 464 }
 465
 466 print PM <<"END";
 467
 468 # Preloaded methods go here.
 469
 470 # Autoload methods go after $after, and are processed by the autosplit program.
 471
 472 1;
 473 __END__
 474 END
 475
 476 $author = "A. U. Thor";
 477 $email = 'a.u.thor@a.galaxy.far.far.away';
 478
 479 $pod = <<"END" unless $opt_P;
 480 ## Below is the stub of documentation for your module. You better edit it!
 481 #
 482 #=head1 NAME
 483 #
 484 #$module - Perl extension for blah blah blah
 485 #
 486 #=head1 SYNOPSIS
 487 #
 488 #  use $module;
 489 #  blah blah blah
 490 #
 491 #=head1 DESCRIPTION
 492 #
 493 #Stub documentation for $module was created by h2xs. It looks like the
 494 #author of the extension was negligent enough to leave the stub
 495 #unedited.
 496 #
 497 #Blah blah blah.
 498 #
 499 #=head1 AUTHOR
 500 #
 501 #$author, $email
 502 #
 503 #=head1 SEE ALSO
 504 #
 505 #perl(1).
 506 #
 507 #=cut
 508 END
 509
 510 $pod =~ s/^\#//gm unless $opt_P;
 511 print PM $pod unless $opt_P;
 512
 513 close PM;
 514
 515
 516 if( ! $opt_X ){ # print XS, unless it is disabled
 517 warn "Writing $ext$modpname/$modfname.xs\n";
 518
 519 print XS <<"END";
 520 #ifdef __cplusplus
 521 extern "C" {
 522 #endif
 523 #include "EXTERN.h"
 524 #include "perl.h"
 525 #include "XSUB.h"
 526 #ifdef __cplusplus
 527 }
 528 #endif
 529
 530 END
 531 if( $path_h ){
 532         my($h) = $path_h;
 533         $h =~ s#^/usr/include/##;
 534         if ($^O eq 'VMS') { $h =~ s#.*vms\]#sys/# or $h =~ s#.*[:>\]]##; }
 535 print XS <<"END";
 536 #include <$h>
 537
 538 END
 539 }
 540
 541 if( ! $opt_c ){
 542 print XS <<"END";
 543 static int
 544 not_here(s)
 545 char *s;
 546 {
 547     croak("$module::%s not implemented on this architecture", s);
 548     return -1;
 549 }
 550
 551 static double
 552 constant(name, arg)
 553 char *name;
 554 int arg;
 555 {
 556     errno = 0;
 557     switch (*name) {
 558 END
 559
 560 my(@AZ, @az, @under);
 561
 562 foreach(@const_names){
 563     @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
 564     @az = 'a' .. 'z' if !@az && /^[a-z]/;
 565     @under = '_'  if !@under && /^_/;
 566 }
 567
 568 foreach $letter (@AZ, @az, @under) {
 569
 570     last if $letter eq 'a' && !@const_names;
 571
 572     print XS "    case '$letter':\n";
 573     my($name);
 574     while (substr($const_names[0],0,1) eq $letter) {
 575         $name = shift(@const_names);
 576         $macro = $prefix{$name} ? "$opt_p$name" : $name;
 577         next if $const_xsub{$macro};
 578         print XS <<"END";
 579         if (strEQ(name, "$name"))
 580 #ifdef $macro
 581             return $macro;
 582 #else
 583             goto not_there;
 584 #endif
 585 END
 586     }
 587     print XS <<"END";
 588         break;
 589 END
 590 }
 591 print XS <<"END";
 592     }
 593     errno = EINVAL;
 594     return 0;
 595
 596 not_there:
 597     errno = ENOENT;
 598     return 0;
 599 }
 600
 601 END
 602 }
 603
 604 $prefix = "PREFIX = $opt_p" if defined $opt_p;
 605 # Now switch from C to XS by issuing the first MODULE declaration:
 606 print XS <<"END";
 607
 608 MODULE = $module                PACKAGE = $module               $prefix
 609
 610 END
 611
 612 foreach (sort keys %const_xsub) {
 613     print XS <<"END";
 614 char *
 615 $_()
 616
 617     CODE:
 618 #ifdef $_
 619     RETVAL = $_;
 620 #else
 621     croak("Your vendor has not defined the $module macro $_");
 622 #endif
 623
 624     OUTPUT:
 625     RETVAL
 626
 627 END
 628 }
 629
 630 # If a constant() function was written then output a corresponding
 631 # XS declaration:
 632 print XS <<"END" unless $opt_c;
 633
 634 double
 635 constant(name,arg)
 636         char *          name
 637         int             arg
 638
 639 END
 640
 641 sub print_decl {
 642   my $fh = shift;
 643   my $decl = shift;
 644   my ($type, $name, $args) = @$decl;
 645   my @argnames = map {$_->[1]} @$args;
 646   my @argtypes = map { normalize_type( $_->[0] ) } @$args;
 647   my $numargs = @$args;
 648   if ($numargs and $argtypes[-1] eq '...') {
 649     $numargs--;
 650     $argnames[-1] = '...';
 651   }
 652   local $" = ', ';
 653   $type = normalize_type($type);
 654
 655   print $fh <<"EOP";
 656
 657 $type
 658 $name(@argnames)
 659 EOP
 660
 661   for $arg (0 .. $numargs - 1) {
 662     print $fh <<"EOP";
 663         $argtypes[$arg] $argnames[$arg]
 664 EOP
 665   }
 666 }
 667
 668 my $ignore_mods = '(?:\b(?:__const__|static|inline|__inline__)\b\s*)*';
 669
 670 sub normalize_type {
 671   my $type = shift;
 672   $type =~ s/$ignore_mods//go;
 673   $type =~ s/\s+/ /g;
 674   $type =~ s/\s+$//;
 675   $type =~ s/^\s+//;
 676   $type =~ s/\b\*/ */g;
 677   $type =~ s/\*\b/* /g;
 678   $type =~ s/\*\s+(?=\*)/*/g;
 679   $type;
 680 }
 681
 682 if ($opt_x) {
 683   require C::Scan;              # Run-time directive
 684   require Config;               # Run-time directive
 685   my $c;
 686   my $filter;
 687   my $filename = $path_h;
 688   my $addflags = $opt_F || '';
 689   if ($fullpath =~ /,/) {
 690     $filename = $`;
 691     $filter = $';
 692   }
 693   $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter,
 694                    'add_cppflags' => $addflags;
 695   $c->set('includeDirs' => [$Config::Config{shrpdir}]);
 696
 697   my $fdec = $c->get('parsed_fdecls');
 698
 699   for $decl (@$fdec) { print_decl(\*XS, $decl) }
 700 }
 701
 702 close XS;
 703 } # if( ! $opt_X )
 704
 705 warn "Writing $ext$modpname/Makefile.PL\n";
 706 open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
 707
 708 print PL <<'END';
 709 use ExtUtils::MakeMaker;
 710 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
 711 # the contents of the Makefile that is written.
 712 END
 713 print PL "WriteMakefile(\n";
 714 print PL "    'NAME'    => '$module',\n";
 715 print PL "    'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n";
 716 if( ! $opt_X ){ # print C stuff, unless XS is disabled
 717   print PL "    'LIBS'  => ['$extralibs'],   # e.g., '-lm' \n";
 718   print PL "    'DEFINE'        => '',     # e.g., '-DHAVE_SOMETHING' \n";
 719   print PL "    'INC'   => '',     # e.g., '-I/usr/include/other' \n";
 720 }
 721 print PL ");\n";
 722 close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
 723
 724 warn "Writing $ext$modpname/test.pl\n";
 725 open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\n";
 726 print EX <<'_END_';
 727 # Before `make install' is performed this script should be runnable with
 728 # `make test'. After `make install' it should work as `perl test.pl'
 729
 730 ######################### We start with some black magic to print on failure.
 731
 732 # Change 1..1 below to 1..last_test_to_print .
 733 # (It may become useful if the test is moved to ./t subdirectory.)
 734
 735 BEGIN { $| = 1; print "1..1\n"; }
 736 END {print "not ok 1\n" unless $loaded;}
 737 _END_
 738 print EX <<_END_;
 739 use $module;
 740 _END_
 741 print EX <<'_END_';
 742 $loaded = 1;
 743 print "ok 1\n";
 744
 745 ######################### End of black magic.
 746
 747 # Insert your test code below (better if it prints "ok 13"
 748 # (correspondingly "not ok 13") depending on the success of chunk 13
 749 # of the test code):
 750
 751 _END_
 752 close(EX) || die "Can't close $ext$modpname/test.pl: $!\n";
 753
 754 warn "Writing $ext$modpname/Changes\n";
 755 open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n";
 756 print EX "Revision history for Perl extension $module.\n\n";
 757 print EX "$TEMPLATE_VERSION  ",scalar localtime,"\n";
 758 print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n";
 759 close(EX) || die "Can't close $ext$modpname/Changes: $!\n";
 760
 761 warn "Writing $ext$modpname/MANIFEST\n";
 762 open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!";
 763 @files = <*>;
 764 if (!@files) {
 765   eval {opendir(D,'.');};
 766   unless ($@) { @files = readdir(D); closedir(D); }
 767 }
 768 if (!@files) { @files = map {chomp && $_} `ls`; }
 769 print MANI join("\n",@files);
 770 close MANI;
 771 !NO!SUBS!
 772
 773 close OUT or die "Can't close $file: $!";
 774 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 775 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';