Fix #15283 - binmode() was not passing mode
[p5sagit/p5-mst-13.2.git] / utils / h2xs.PL
index 9b7584c..df89626 100644 (file)
@@ -75,6 +75,11 @@ extra-libraries argument.
 Omit all autoload facilities.  This is the same as B<-c> but also
 removes the S<C<use AutoLoader>> statement from the .pm file.
 
+=item B<-B>, B<--beta-version>
+
+Use an alpha/beta style version number.  Causes version number to
+be "0.00_01" unless B<-v> is specified.
+
 =item B<-C>, B<--omit-changes>
 
 Omits creation of the F<Changes> file, and adds a HISTORY section to
@@ -83,7 +88,8 @@ the POD template.
 =item B<-F>, B<--cpp-flags>=I<addflags>
 
 Additional flags to specify to C preprocessor when scanning header for
-function declarations.  Should not be used without B<-x>.
+function declarations.  Writes these options in the generated F<Makefile.PL>
+too.
 
 =item B<-M>, B<--func-mask>=I<regular expression>
 
@@ -206,7 +212,7 @@ of C<h2xs> may gain the ability to make educated guesses.
 =item B<--use-new-tests>
 
 When B<--compat-version> (B<-b>) is present the generated tests will use
-C<Test::More> rather then C<Test> which is the default for versions before
+C<Test::More> rather than C<Test> which is the default for versions before
 5.7.2 .   C<Test::More> will be added to PREREQ_PM in the generated
 C<Makefile.PL>.
 
@@ -214,10 +220,32 @@ C<Makefile.PL>.
 
 Will force the generation of test code that uses the older C<Test> module.
 
+=item B<--skip-exporter>
+
+Do not use C<Exporter> and/or export any symbol.
+
+=item B<--skip-ppport>
+
+Do not use C<Devel::PPPort>: no portability to older version.
+
+=item B<--skip-autoloader>
+
+Do not use the module C<AutoLoader>; but keep the constant() function
+and C<sub AUTOLOAD> for constants.
+
+=item B<--skip-strict>
+
+Do not use the pragma C<strict>.
+
+=item B<--skip-warnings>
+
+Do not use the pragma C<warnings>.
+
 =item B<-v>, B<--version>=I<version>
 
 Specify a version number for this extension.  This version number is added
-to the templates.  The default is 0.01.
+to the templates.  The default is 0.01, or 0.00_01 if C<-B> is specified.
+The version specified should be numeric.
 
 =item B<-x>, B<--autogen-xsubs>
 
@@ -435,7 +463,7 @@ See L<perlxs> and L<perlxstut> for additional details.
 use strict;
 
 
-my( $H2XS_VERSION ) = ' $Revision: 1.21 $ ' =~ /\$Revision:\s+([^\s]+)/;
+my( $H2XS_VERSION ) = ' $Revision: 1.22 $ ' =~ /\$Revision:\s+([^\s]+)/;
 my $TEMPLATE_VERSION = '0.01';
 my @ARGS = @ARGV;
 my $compat_version = $];
@@ -447,7 +475,6 @@ $Text::Wrap::huge = 'overflow';
 $Text::Wrap::columns = 80;
 use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload);
 use File::Compare;
-use Devel::PPPort;
 
 sub usage {
     warn "@_\n" if @_;
@@ -456,9 +483,10 @@ h2xs [OPTIONS ... ] [headerfile [extra_libraries]]
 version: $H2XS_VERSION
 OPTIONS:
     -A, --omit-autoload   Omit all autoloading facilities (implies -c).
+    -B, --beta-version    Use beta \$VERSION of 0.00_01 (ignored if -v).
     -C, --omit-changes    Omit creating the Changes file, add HISTORY heading
                           to stub POD.
-    -F, --cpp-flags       Additional flags for C preprocessor (used with -x).
+    -F, --cpp-flags       Additional flags for C preprocessor/compile.
     -M, --func-mask       Mask to select C functions/macros
                           (default is select all).
     -O, --overwrite-ok    Allow overwriting of a pre-existing extension directory.
@@ -485,6 +513,11 @@ OPTIONS:
     -t, --default-type    Default type for autoloaded constants (default is IV)
         --use-new-tests   Use Test::More in backward compatible modules
         --use-old-tests   Use the module Test rather than Test::More
+        --skip-exporter   Do not export symbols
+        --skip-ppport     Do not use portability layer
+        --skip-autoloader Do not use the module C<AutoLoader>
+        --skip-strict     Do not use the pragma C<strict>
+        --skip-warnings   Do not use the pragma C<warnings>
     -v, --version         Specify a version number for this extension.
     -x, --autogen-xsubs   Autogenerate XSUBs using C::Scan.
 
@@ -495,6 +528,7 @@ EOFUSAGE
 }
 
 my ($opt_A,
+    $opt_B,
     $opt_C,
     $opt_F,
     $opt_M,
@@ -518,13 +552,19 @@ my ($opt_A,
     $opt_b,
     $opt_t,
     $new_test,
-    $old_test
+    $old_test,
+    $skip_exporter,
+    $skip_ppport,
+    $skip_autoloader,
+    $skip_strict,
+    $skip_warnings,
    );
 
 Getopt::Long::Configure('bundling');
 
 my %options = (
                 'omit-autoload|A'    => \$opt_A,
+                'beta-version|B'     => \$opt_B,
                 'omit-changes|C'     => \$opt_C,
                 'cpp-flags|F=s'      => \$opt_F,
                 'func-mask|M=s'      => \$opt_M,
@@ -548,7 +588,12 @@ my %options = (
                 'version|v=s'        => \$opt_v,
                 'autogen-xsubs|x'    => \$opt_x,
                 'use-new-tests'      => \$new_test,
-                'use-old-tests'      => \$old_test
+                'use-old-tests'      => \$old_test,
+                'skip-exporter'      => \$skip_exporter,
+                'skip-ppport'        => \$skip_ppport,
+                'skip-autoloader'    => \$skip_autoloader,
+                'skip-warnings'      => \$skip_warnings,
+                'skip-strict'        => \$skip_strict,
               );
 
 GetOptions(%options) || usage;
@@ -562,12 +607,17 @@ if( $opt_b ){
           .  "(i.e. 5.5.0)\n";
     my ($maj,$min,$sub) = split(/\./,$opt_b,3);
     if ($maj < 5 || ($maj == 5 && $min < 6)) {
-        $compat_version = sprintf("%d.%03d%02d",$maj,$min,$sub);
+        $compat_version =
+           $sub ? sprintf("%d.%03d%02d",$maj,$min,$sub) :
+                  sprintf("%d.%03d",    $maj,$min);
     } else {
-        $compat_version = sprintf("%d.%03d%03d",$maj,$min,$sub);
+        $compat_version =
+           $sub ? sprintf("%d.%03d%03d",$maj,$min,$sub) :
+                  sprintf("%d.%03d",    $maj,$min);
     }
 } else {
-    my ($maj,$min,$sub) = $compat_version =~ /(\d+)\.(\d\d\d)(\d\d\d?)/;
+    my ($maj,$min,$sub) = $compat_version =~ /(\d+)\.(\d\d\d)(\d*)/;
+    $sub ||= 0;
     warn sprintf <<'EOF', $maj,$min,$sub;
 Defaulting to backwards compatibility with perl %d.%d.%d
 If you intend this module to be compatible with earlier perl versions, please
@@ -576,12 +626,39 @@ specify a minimum perl version with the -b option.
 EOF
 }
 
+if( $opt_B ){
+    $TEMPLATE_VERSION = '0.00_01';
+}
+
 if( $opt_v ){
        $TEMPLATE_VERSION = $opt_v;
+
+    # check if it is numeric
+    my $temp_version = $TEMPLATE_VERSION;
+    my $beta_version = $temp_version =~ s/(\d)_(\d\d)/$1$2/;
+    my $notnum;
+    {
+        local $SIG{__WARN__} = sub { $notnum = 1 };
+        use warnings 'numeric';
+        $temp_version = 0+$temp_version;
+    }
+
+    if ($notnum) {
+        my $module = $opt_n || 'Your::Module';
+        warn <<"EOF";
+You have specified a non-numeric version.  Unless you supply an
+appropriate VERSION class method, users may not be able to specify a
+minimum required version with C<use $module versionnum>.
+
+EOF
+    }
+    else {
+        $opt_B = $beta_version;
+    }
 }
 
 # -A implies -c.
-$opt_c = 1 if $opt_A;
+$skip_autoloader = $opt_c = 1 if $opt_A;
 
 # -X implies -c and -f
 $opt_c = $opt_f = 1 if $opt_X;
@@ -638,8 +715,11 @@ EOD
   }
 }
 elsif ($opt_o or $opt_F) {
-  warn <<EOD;
-Options -o and -F do not make sense without -x.
+  warn <<EOD if $opt_o;
+Option -o does not make sense without -x.
+EOD
+  warn <<EOD if $opt_F and $opt_X ;
+Option -F does not make sense with -X.
 EOD
 }
 
@@ -649,7 +729,6 @@ my ($name, %fullpath, %prefix, %seen_define, %prefixless, %const_names);
 my $module = $opt_n;
 
 if( @path_h ){
-    use Config;
     use File::Spec;
     my @paths;
     my $pre_sub_tri_graphs = 1;
@@ -770,7 +849,13 @@ if( @path_h ){
 # Save current directory so that C::Scan can use it
 my $cwd = File::Spec->rel2abs( File::Spec->curdir );
 
-my ($ext, $nested, @modparts, $modfname, $modpname, $constsfname);
+my ($ext, $nested, @modparts, $modfname, $modpname);
+# As Ilya suggested, use a name that contains - and then it can't clash with
+# the names of any packages. A directory 'fallback' will clash with any
+# new pragmata down the fallback:: tree, but that seems unlikely.
+my $constscfname = 'const-c.inc';
+my $constsxsfname = 'const-xs.inc';
+my $fallbackdirname = 'fallback';
 
 $ext = chdir 'ext' ? 'ext/' : '';
 
@@ -785,8 +870,6 @@ else {
        @modparts = ();
        $modfname = $modpname = $module;
 }
-# Don't trip up if someone calls their module 'constants'
-$constsfname = $modfname eq 'constants' ? 'constdefs' : 'constants';
 
 
 if ($opt_O) {
@@ -820,13 +903,14 @@ my %vdecl_hash;
 my @vdecls;
 
 if( ! $opt_X ){  # use XS, unless it was disabled
-  warn "Writing $ext$modpname/ppport.h\n";
-  Devel::PPPort::WriteFile('ppport.h')
-      || die "Can't create $ext$modpname/ppport.h: $!\n";
-
+  unless ($skip_ppport) {
+    require Devel::PPPort;
+    warn "Writing $ext$modpname/ppport.h\n";
+    Devel::PPPort::WriteFile('ppport.h')
+        || die "Can't create $ext$modpname/ppport.h: $!\n";
+  }
   open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
   if ($opt_x) {
-    require Config;            # Run-time directive
     warn "Scanning typemaps...\n";
     get_typemap();
     my @td;
@@ -942,9 +1026,13 @@ print PM <<"END";
 package $module;
 
 use $compat_version;
+END
+
+print PM <<"END" unless $skip_strict;
 use strict;
 END
-print PM "use warnings;\n" unless $compat_version < 5.006;
+
+print PM "use warnings;\n" unless $skip_warnings or $compat_version < 5.006;
 
 unless( $opt_X || $opt_c || $opt_A ){
        # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
@@ -954,18 +1042,19 @@ use Carp;
 END
 }
 
-print PM <<'END';
+print PM <<'END' unless $skip_exporter;
 
 require Exporter;
 END
 
-print PM <<"END" if ! $opt_X;  # use DynaLoader, unless XS was disabled
+my $use_Dyna = (not $opt_X and $compat_version < 5.006);
+print PM <<"END" if $use_Dyna;  # use DynaLoader, unless XS was disabled
 require DynaLoader;
 END
 
 
 # Are we using AutoLoader or not?
-unless ($opt_A) { # no autoloader whatsoever.
+unless ($skip_autoloader) { # no autoloader whatsoever.
        unless ($opt_c) { # we're doing the AUTOLOAD
                print PM "use AutoLoader;\n";
        }
@@ -975,24 +1064,26 @@ unless ($opt_A) { # no autoloader whatsoever.
 }
 
 if ( $compat_version < 5.006 ) {
-    if ( $opt_X || $opt_c || $opt_A ) {
-       print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);';
-    } else {
-       print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);';
-    }
+    my $vars = '$VERSION @ISA';
+    $vars .= ' @EXPORT @EXPORT_OK %EXPORT_TAGS' unless $skip_exporter;
+    $vars .= ' $AUTOLOAD' unless $opt_X || $opt_c || $opt_A;
+    $vars .= ' $XS_VERSION' if $opt_B && !$opt_X;
+    print PM "use vars qw($vars);";
 }
 
 # Determine @ISA.
-my $myISA = 'our @ISA = qw(Exporter';  # We seem to always want this.
-$myISA .= ' DynaLoader'        unless $opt_X;  # no XS
-$myISA .= ');';
+my @modISA;
+push @modISA, 'Exporter'       unless $skip_exporter; 
+push @modISA, 'DynaLoader'     if $use_Dyna;  # no XS
+my $myISA = "our \@ISA = qw(@modISA);";
 $myISA =~ s/^our // if $compat_version < 5.006;
 
 print PM "\n$myISA\n\n";
 
 my @exported_names = (@const_names, @fnames_no_prefix, map '$'.$_, @vdecls);
 
-my $tmp=<<"END";
+my $tmp='';
+$tmp .= <<"END" unless $skip_exporter;
 # Items to export into callers namespace by default. Note: do not export
 # names by default without a very good reason. Use EXPORT_OK instead.
 # Do not simply export all your public functions/methods/constants.
@@ -1009,10 +1100,16 @@ our \@EXPORT_OK = ( \@{ \$EXPORT_TAGS{'all'} } );
 our \@EXPORT = qw(
        @const_names
 );
-our \$VERSION = '$TEMPLATE_VERSION';
 
 END
 
+$tmp .= "our \$VERSION = '$TEMPLATE_VERSION';\n";
+if ($opt_B) {
+    $tmp .= "our \$XS_VERSION = \$VERSION;\n" unless $opt_X;
+    $tmp .= "\$VERSION = eval \$VERSION;  # see L<perlmodstyle>\n";
+}
+$tmp .= "\n";
+
 $tmp =~ s/^our //mg if $compat_version < 5.006;
 print PM $tmp;
 
@@ -1024,9 +1121,18 @@ if (@vdecls) {
 print PM autoload ($module, $compat_version) unless $opt_c or $opt_X;
 
 if( ! $opt_X ){ # print bootstrap, unless XS is disabled
-       print PM <<"END";
+  if ($use_Dyna) {
+       $tmp = <<"END";
 bootstrap $module \$VERSION;
 END
+  } else {
+       $tmp = <<"END";
+require XSLoader;
+XSLoader::load('$module', \$VERSION);
+END
+  }
+  $tmp =~ s:\$VERSION:\$XS_VERSION:g if $opt_B;
+  print PM $tmp;
 }
 
 # tying the variables can happen only after bootstrap
@@ -1096,7 +1202,7 @@ $revhist = <<EOT if $opt_C;
 #
 EOT
 
-my $exp_doc = <<EOD;
+my $exp_doc = $skip_exporter ? '' : <<EOD;
 #
 #=head2 EXPORT
 #
@@ -1105,7 +1211,7 @@ my $exp_doc = <<EOD;
 EOD
 
 if (@const_names and not $opt_P) {
-  $exp_doc .= <<EOD;
+  $exp_doc .= <<EOD unless $skip_exporter;
 #=head2 Exportable constants
 #
 #  @{[join "\n  ", @const_names]}
@@ -1114,7 +1220,7 @@ EOD
 }
 
 if (defined $fdecls and @$fdecls and not $opt_P) {
-  $exp_doc .= <<EOD;
+  $exp_doc .= <<EOD unless $skip_exporter;
 #=head2 Exportable functions
 #
 EOD
@@ -1123,7 +1229,7 @@ EOD
 #When accessing these functions from Perl, prefix C<$opt_p> should be removed.
 #
 #EOD
-  $exp_doc .= <<EOD;
+  $exp_doc .= <<EOD unless $skip_exporter;
 #  @{[join "\n  ", @known_fnames{@fnames}]}
 #
 EOD
@@ -1203,9 +1309,14 @@ print XS <<"END";
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
+
+END
+
+print XS <<"END" unless $skip_ppport;
 #include "ppport.h"
 
 END
+
 if( @path_h ){
     foreach my $path_h (@path_h_ini) {
        my($h) = $path_h;
@@ -1275,15 +1386,20 @@ if( ! $opt_c ) {
   # ExtUtils::Constant.
   # h2xs will later check that these are the same as those generated by the
   # code embedded into Makefile.PL
-  warn "Writing $ext$modpname/fallback.c\n";
-  warn "Writing $ext$modpname/fallback.xs\n";
-  WriteConstants ( C_FILE =>       "fallback.c",
-                   XS_FILE =>      "fallback.xs",
+  unless (-d $fallbackdirname) {
+    mkdir "$fallbackdirname" or die "Cannot mkdir $fallbackdirname: $!\n";
+  }
+  warn "Writing $ext$modpname/$fallbackdirname/$constscfname\n";
+  warn "Writing $ext$modpname/$fallbackdirname/$constsxsfname\n";
+  my $cfallback = File::Spec->catfile($fallbackdirname, $constscfname);
+  my $xsfallback = File::Spec->catfile($fallbackdirname, $constsxsfname);
+  WriteConstants ( C_FILE =>       $cfallback,
+                   XS_FILE =>      $xsfallback,
                    DEFAULT_TYPE => $opt_t,
                    NAME =>         $module,
                    NAMES =>        \@const_names,
                  );
-  print XS "#include \"$constsfname.c\"\n";
+  print XS "#include \"$constscfname\"\n";
 }
 
 
@@ -1298,7 +1414,7 @@ END
 
 # If a constant() function was #included then output a corresponding
 # XS declaration:
-print XS "INCLUDE: $constsfname.xs\n" unless $opt_c;
+print XS "INCLUDE: $constsxsfname\n" unless $opt_c;
 
 print XS <<"END" if $opt_g;
 
@@ -1747,16 +1863,7 @@ EOC
 $Icomment    'INC'             => '$I', # e.g., '${Ihelp}-I/usr/include/other'
 END
 
-  if (!$opt_c) {
-    print PL <<"END";
-    # Without this the constants xs files are spotted, and cause rules to be
-    # added to delete the similarly names C files, which isn't what we want.
-    'XS'               => {'$modfname.xs' => '$modfname.c'},
-    realclean          => {FILES => '$constsfname.c $constsfname.xs'},
-END
-  }
-
-  my $C = grep {$_ ne "$modfname.c" && $_ ne "fallback.c"}
+  my $C = grep {$_ ne "$modfname.c"}
     (glob '*.c'), (glob '*.cc'), (glob '*.C');
   my $Cpre = ($C ? '' : '# ');
   my $Ccomment = ($C ? '' : <<EOC);
@@ -1770,8 +1877,8 @@ END
 print PL ");\n";
 if (!$opt_c) {
   my $generate_code =
-    WriteMakefileSnippet ( C_FILE =>       "$constsfname.c",
-                           XS_FILE =>      "$constsfname.xs",
+    WriteMakefileSnippet ( C_FILE =>       $constscfname,
+                           XS_FILE =>      $constsxsfname,
                            DEFAULT_TYPE => $opt_t,
                            NAME =>         $module,
                            NAMES =>        \@const_names,
@@ -1779,17 +1886,18 @@ if (!$opt_c) {
   print PL <<"END";
 if  (eval {require ExtUtils::Constant; 1}) {
   # If you edit these definitions to change the constants used by this module,
-  # you will need to use the generated $constsfname.c and $constsfname.xs
+  # you will need to use the generated $constscfname and $constsxsfname
   # files to replace their "fallback" counterparts before distributing your
   # changes.
 $generate_code
 }
 else {
   use File::Copy;
-  copy ('fallback.c', '$constsfname.c')
-    or die "Can't copy fallback.c to $constsfname.c: \$!";
-  copy ('fallback.xs', '$constsfname.xs')
-    or die "Can't copy fallback.xs to $constsfname.xs: \$!";
+  use File::Spec;
+  foreach my \$file ('$constscfname', '$constsxsfname') {
+    my \$fallback = File::Spec->catfile('$fallbackdirname', \$file);
+    copy (\$fallback, \$file) or die "Can't copy \$fallback to \$file: \$!";
+  }
 }
 END
 
@@ -1806,10 +1914,11 @@ EOM
   } else {
     my $fail;
 
-    foreach ('c', 'xs') {
-      if (compare("fallback.$_", "$constsfname.$_")) {
+    foreach my $file ($constscfname, $constsxsfname) {
+      my $fallback = File::Spec->catfile($fallbackdirname, $file);
+      if (compare($file, $fallback)) {
         warn << "EOM";
-Files "$ext$modpname/fallback.$_" and "$ext$modpname/$constsfname.$_" differ.
+Files "$ext$modpname/$fallbackdirname/$file" and "$ext$modpname/$file" differ.
 EOM
         $fail++;
       }
@@ -1817,14 +1926,14 @@ EOM
     if ($fail) {
       warn fill ('','', <<"EOM") . "\n";
 It appears that the code in $ext$modpname/Makefile.PL does not autogenerate
-the files $ext$modpname/$constsfname.c and $ext$modpname/$constsfname.xs
+the files $ext$modpname/$constscfname and $ext$modpname/$constsxsfname
 correctly.
+
 Please report the circumstances of this bug in h2xs version $H2XS_VERSION
 using the perlbug script.
 EOM
     } else {
-      unlink "$constsfname.c", "$constsfname.xs";
+      unlink $constscfname, $constsxsfname;
     }
   }
 }
@@ -2017,7 +2126,7 @@ EOP
 
 warn "Writing $ext$modpname/MANIFEST\n";
 open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!";
-my @files = grep { -f } (<*>, <t/*>);
+my @files = grep { -f } (<*>, <t/*>, <$fallbackdirname/*>);
 if (!@files) {
   eval {opendir(D,'.');};
   unless ($@) { @files = readdir(D); closedir(D); }
@@ -2033,9 +2142,6 @@ if ($^O eq 'VMS') {
     $_ = 'Makefile.PL' if $_ eq 'makefile.pl';
   }
 }
-if (!$opt_c) {
-  @files = grep {$_ ne "$constsfname.c" and $_ ne "$constsfname.xs"} @files;
-}
 print MANI join("\n",@files), "\n";
 close MANI;
 !NO!SUBS!