X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/4d2d0db22574599aba3e3abe53e0ed95f3ace0ce..18729d3e27f8d8545469c3e23a69b10dc409a88f:/utils/h2xs.PL diff --git a/utils/h2xs.PL b/utils/h2xs.PL index 292a461..ffc343e 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -43,9 +43,9 @@ h2xs - convert .h C header files to Perl extensions =head1 SYNOPSIS -B [B<-ACOPXacdfkmx>] [B<-F> addflags] [B<-M> fmask] [B<-n> module_name] [B<-o> tmask] [B<-p> prefix] [B<-s> subs] [B<-v> version] [B<-b> compat_version] [headerfile ... [extra_libraries]] +B [B ...] [headerfile ... [extra_libraries]] -B B<-h> +B B<-h>|B<-?>|B<--help> =head1 DESCRIPTION @@ -75,6 +75,11 @@ extra-libraries argument. Omit all autoload facilities. This is the same as B<-c> but also removes the S> 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 file, and adds a HISTORY section to @@ -83,7 +88,8 @@ the POD template. =item B<-F>, B<--cpp-flags>=I 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 +too. =item B<-M>, B<--func-mask>=I @@ -126,7 +132,8 @@ For versions < 5.6.0, the changes are. - no 'use warnings' Specifying a compatibility version higher than the version of perl you -are using to run h2xs will have no effect. +are using to run h2xs will have no effect. If unspecified h2xs will default +to compatibility with the version of perl you are using to run h2xs. =item B<-c>, B<--omit-constant> @@ -137,11 +144,34 @@ C from the .pm file. Turn on debugging messages. +=item B<-e>, B<--omit-enums>=[I] + +If I is not given, skip all constants that are defined in +a C enumeration. Otherwise skip only those constants that are defined in an +enum whose name matches I. + +Since I is optional, make sure that this switch is followed +by at least one other switch if you omit I and have some +pending arguments such as header-file names. This is ok: + + h2xs -e -n Module::Foo foo.h + +This is not ok: + + h2xs -n Module::Foo -e foo.h + +In the latter, foo.h is taken as I. + =item B<-f>, B<--force> Allows an extension to be created for a header even if that header is not found in standard include directories. +=item B<-g>, B<--global> + +Include code for safely storing static data in the .xs file. +Extensions that do no make use of static data can ignore this option. + =item B<-h>, B<-?>, B<--help> Print the usage, help and version for this h2xs and exit. @@ -197,10 +227,43 @@ The default is IV (signed integer). Currently all macros found during the header scanning process will be assumed to have this type. Future versions of C 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 rather than C which is the default for versions before +5.7.2 . C will be added to PREREQ_PM in the generated +C. + +=item B<--use-old-tests> + +Will force the generation of test code that uses the older C module. + +=item B<--skip-exporter> + +Do not use C and/or export any symbol. + +=item B<--skip-ppport> + +Do not use C: no portability to older version. + +=item B<--skip-autoloader> + +Do not use the module C; but keep the constant() function +and C for constants. + +=item B<--skip-strict> + +Do not use the pragma C. + +=item B<--skip-warnings> + +Do not use the pragma C. + =item B<-v>, B<--version>=I 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> @@ -222,57 +285,68 @@ also the section on L>. =head1 EXAMPLES - # Default behavior, extension is Rusers - h2xs rpcsvc/rusers + # Default behavior, extension is Rusers + h2xs rpcsvc/rusers + + # Same, but extension is RUSERS + h2xs -n RUSERS rpcsvc/rusers - # Same, but extension is RUSERS - h2xs -n RUSERS rpcsvc/rusers + # Extension is rpcsvc::rusers. Still finds + h2xs rpcsvc::rusers - # Extension is rpcsvc::rusers. Still finds - h2xs rpcsvc::rusers + # Extension is ONC::RPC. Still finds + h2xs -n ONC::RPC rpcsvc/rusers - # Extension is ONC::RPC. Still finds - h2xs -n ONC::RPC rpcsvc/rusers + # Without constant() or AUTOLOAD + h2xs -c rpcsvc/rusers - # Without constant() or AUTOLOAD - h2xs -c rpcsvc/rusers + # Creates templates for an extension named RPC + h2xs -cfn RPC - # Creates templates for an extension named RPC - h2xs -cfn RPC + # Extension is ONC::RPC. + h2xs -cfn ONC::RPC + + # Extension is Lib::Foo which works at least with Perl5.005_03. + # Constants are created for all #defines and enums h2xs can find + # in foo.h. + h2xs -b 5.5.3 -n Lib::Foo foo.h - # Extension is ONC::RPC. - h2xs -cfn ONC::RPC + # Extension is Lib::Foo which works at least with Perl5.005_03. + # Constants are created for all #defines but only for enums + # whose names do not start with 'bar_'. + h2xs -b 5.5.3 -e '^bar_' -n Lib::Foo foo.h - # Makefile.PL will look for library -lrpc in - # additional directory /opt/net/lib - h2xs rpcsvc/rusers -L/opt/net/lib -lrpc + # Makefile.PL will look for library -lrpc in + # additional directory /opt/net/lib + h2xs rpcsvc/rusers -L/opt/net/lib -lrpc - # Extension is DCE::rgynbase - # prefix "sec_rgy_" is dropped from perl function names - h2xs -n DCE::rgynbase -p sec_rgy_ dce/rgynbase + # Extension is DCE::rgynbase + # prefix "sec_rgy_" is dropped from perl function names + h2xs -n DCE::rgynbase -p sec_rgy_ dce/rgynbase - # Extension is DCE::rgynbase - # prefix "sec_rgy_" is dropped from perl function names - # subroutines are created for sec_rgy_wildcard_name and sec_rgy_wildcard_sid - h2xs -n DCE::rgynbase -p sec_rgy_ \ - -s sec_rgy_wildcard_name,sec_rgy_wildcard_sid dce/rgynbase + # Extension is DCE::rgynbase + # prefix "sec_rgy_" is dropped from perl function names + # subroutines are created for sec_rgy_wildcard_name and + # sec_rgy_wildcard_sid + h2xs -n DCE::rgynbase -p sec_rgy_ \ + -s sec_rgy_wildcard_name,sec_rgy_wildcard_sid dce/rgynbase - # Make XS without defines in perl.h, but with function declarations - # visible from perl.h. Name of the extension is perl1. - # When scanning perl.h, define -DEXT=extern -DdEXT= -DINIT(x)= - # Extra backslashes below because the string is passed to shell. - # Note that a directory with perl header files would - # be added automatically to include path. - h2xs -xAn perl1 -F "-DEXT=extern -DdEXT= -DINIT\(x\)=" perl.h + # Make XS without defines in perl.h, but with function declarations + # visible from perl.h. Name of the extension is perl1. + # When scanning perl.h, define -DEXT=extern -DdEXT= -DINIT(x)= + # Extra backslashes below because the string is passed to shell. + # Note that a directory with perl header files would + # be added automatically to include path. + h2xs -xAn perl1 -F "-DEXT=extern -DdEXT= -DINIT\(x\)=" perl.h - # Same with function declaration in proto.h as visible from perl.h. - h2xs -xAn perl2 perl.h,proto.h + # Same with function declaration in proto.h as visible from perl.h. + h2xs -xAn perl2 perl.h,proto.h - # Same but select only functions which match /^av_/ - h2xs -M '^av_' -xAn perl2 perl.h,proto.h + # Same but select only functions which match /^av_/ + h2xs -M '^av_' -xAn perl2 perl.h,proto.h - # Same but treat SV* etc as "opaque" types - h2xs -o '^[S]V \*$' -M '^av_' -xAn perl2 perl.h,proto.h + # Same but treat SV* etc as "opaque" types + h2xs -o '^[S]V \*$' -M '^av_' -xAn perl2 perl.h,proto.h =head2 Extension based on F<.h> and F<.c> files @@ -414,10 +488,11 @@ See L and L for additional details. =cut +# ' # Grr 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 = $]; @@ -427,7 +502,8 @@ use Config; use Text::Wrap; $Text::Wrap::huge = 'overflow'; $Text::Wrap::columns = 80; -use ExtUtils::Constant qw (constant_types C_constant XS_constant autoload); +use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload); +use File::Compare; sub usage { warn "@_\n" if @_; @@ -436,9 +512,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. @@ -449,8 +526,12 @@ OPTIONS: -c, --omit-constant Omit the constant() function and specialised AUTOLOAD from the XS file. -d, --debugging Turn on debugging messages. + -e, --omit-enums Omit constants from enums in the constant() function. + If a pattern is given, only the matching enums are + ignored. -f, --force Force creation of the extension even if the C header does not exist. + -g, --global Include code for safely storing static data in the .xs file. -h, -?, --help Display this help message -k, --omit-const-func Omit 'const' attribute on function arguments (used with -x). @@ -461,7 +542,14 @@ OPTIONS: -p, --remove-prefix Specify a prefix which should be removed from the Perl function names. -s, --const-subs Create subroutines for specified macros. - -t, --default-type Default type for autoloaded constants + -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 + --skip-strict Do not use the pragma C + --skip-warnings Do not use the pragma C -v, --version Specify a version number for this extension. -x, --autogen-xsubs Autogenerate XSUBs using C::Scan. @@ -472,6 +560,7 @@ EOFUSAGE } my ($opt_A, + $opt_B, $opt_C, $opt_F, $opt_M, @@ -481,7 +570,9 @@ my ($opt_A, $opt_a, $opt_c, $opt_d, + $opt_e, $opt_f, + $opt_g, $opt_h, $opt_k, $opt_m, @@ -492,13 +583,21 @@ my ($opt_A, $opt_v, $opt_x, $opt_b, - $opt_t + $opt_t, + $new_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, @@ -509,7 +608,9 @@ my %options = ( 'compat-version|b=s' => \$opt_b, 'omit-constant|c' => \$opt_c, 'debugging|d' => \$opt_d, + 'omit-enums|e:s' => \$opt_e, 'force|f' => \$opt_f, + 'global|g' => \$opt_g, 'help|h|?' => \$opt_h, 'omit-const-func|k' => \$opt_k, 'gen-tied-var|m' => \$opt_m, @@ -519,7 +620,14 @@ my %options = ( 'const-subs|s=s' => \$opt_s, 'default-type|t=s' => \$opt_t, 'version|v=s' => \$opt_v, - 'autogen-xsubs|x=s' => \$opt_x + 'autogen-xsubs|x' => \$opt_x, + 'use-new-tests' => \$new_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; @@ -529,22 +637,68 @@ usage if $opt_h; if( $opt_b ){ usage "You cannot use -b and -m at the same time.\n" if ($opt_b && $opt_m); $opt_b =~ /^\d+\.\d+\.\d+/ || - usage "You must provide the backwards compatibility version in X.Y.Z form. " . - "(i.e. 5.5.0)\n"; + usage "You must provide the backwards compatibility version in X.Y.Z form. " + . "(i.e. 5.5.0)\n"; my ($maj,$min,$sub) = split(/\./,$opt_b,3); - $compat_version = sprintf("%d.%03d%02d",$maj,$min,$sub); -} + if ($maj < 5 || ($maj == 5 && $min < 6)) { + $compat_version = + $sub ? sprintf("%d.%03d%02d",$maj,$min,$sub) : + sprintf("%d.%03d", $maj,$min); + } else { + $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*)/; + $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 +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. + +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; +$opt_t ||= 'IV'; + my %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s; my $extralibs = ''; @@ -595,8 +749,11 @@ EOD } } elsif ($opt_o or $opt_F) { - warn <catdir('ext', $epath) if -d 'ext'; @@ -686,7 +843,7 @@ if( @path_h ){ s/\?\?/}/g; # | ??>| }| } - if (/^[ \t]*#[ \t]*define\s+([\$\w]+)\b(?!\()\s*(?=[^" \t])(.*)/) { + if (/^[ \t]*#[ \t]*define\s+([\$\w]+)\b(?!\()\s*(?=[^"\s])(.*)/) { my $def = $1; my $rest = $2; $rest =~ s!/\*.*?(\*/|\n)|//.*!!g; # Remove comments @@ -718,14 +875,48 @@ if( @path_h ){ } } } - close(CH); + if (defined $opt_e and !$opt_e) { + close(CH); + } + else { + # Work from miniperl too - on "normal" systems + my $SEEK_SET = eval 'use Fcntl qw/SEEK_SET/; SEEK_SET' or 0; + seek CH, 0, $SEEK_SET; + my $src = do { local $/; }; + close CH; + no warnings 'uninitialized'; + + # Remove C and C++ comments + $src =~ s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#$2#gs; + + while ($src =~ /(\benum\s*([\w_]*)\s*\{\s([\s\w=,]+)\})/gsc) { + my ($enum_name, $enum_body) = + $1 =~ /enum\s*([\w_]*)\s*\{\s([\s\w=,]+)\}/gs; + # skip enums matching $opt_e + next if $opt_e && $enum_name =~ /$opt_e/; + my $val = 0; + for my $item (split /,/, $enum_body) { + my ($key, $declared_val) = $item =~ /(\w*)\s*=\s*(.*)/; + $val = length($declared_val) ? $declared_val : 1 + $val; + $seen_define{$key} = $declared_val; + $const_names{$key}++; + } + } # while (...) + } # if (!defined $opt_e or $opt_e) } } } - +# Save current directory so that C::Scan can use it +my $cwd = File::Spec->rel2abs( File::Spec->curdir ); 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/' : ''; @@ -773,9 +964,14 @@ my %vdecl_hash; my @vdecls; if( ! $opt_X ){ # use XS, unless it was disabled + 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; @@ -791,9 +987,10 @@ if( ! $opt_X ){ # use XS, unless it was disabled $filter = $'; } warn "Scanning $filename for functions...\n"; + my @styles = $Config{gccversion} ? qw(C++ C9X GNU) : qw(C++ C9X); $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter, - 'add_cppflags' => $addflags, 'c_styles' => [qw(C++ C9X)]; - $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]); + 'add_cppflags' => $addflags, 'c_styles' => \@styles; + $c->set('includeDirs' => ["$Config::Config{archlib}/CORE", $cwd]); push @$fdecls_parsed, @{ $c->get('parsed_fdecls') }; push(@$fdecls, @{$c->get('fdecls')}); @@ -852,7 +1049,8 @@ if( ! $opt_X ){ # use XS, unless it was disabled } @fnames_no_prefix = @fnames; @fnames_no_prefix - = sort map { ++$prefix{$_} if s/^$opt_p(?!\d)//; $_ } @fnames_no_prefix; + = sort map { ++$prefix{$_} if s/^$opt_p(?!\d)//; $_ } @fnames_no_prefix + if defined $opt_p; # Remove macros which expand to typedefs print "Typedefs are @td.\n" if $opt_d; my %td = map {($_, $_)} @td; @@ -885,23 +1083,17 @@ open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n" $" = "\n\t"; warn "Writing $ext$modpname/$modfname.pm\n"; -if ( $compat_version < 5.006 ) { print PM <<"END"; package $module; use $compat_version; -use strict; END -} -else { -print PM <<"END"; -package $module; -use 5.006; +print PM <<"END" unless $skip_strict; use strict; -use warnings; END -} + +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 @@ -911,18 +1103,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"; } @@ -932,24 +1125,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. @@ -966,10 +1161,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\n"; +} +$tmp .= "\n"; + $tmp =~ s/^our //mg if $compat_version < 5.006; print PM $tmp; @@ -981,9 +1182,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 @@ -1023,12 +1233,14 @@ END my ($email,$author); eval { - my $user; - ($user,$author) = (getpwuid($>))[0,6]; - $author =~ s/,.*$//; # in case of sub fields - my $domain = $Config{'mydomain'}; - $domain =~ s/^\.//; - $email = "$user\@$domain"; + my $username; + ($username,$author) = (getpwuid($>))[0,6]; + if (defined $username && defined $author) { + $author =~ s/,.*$//; # in case of sub fields + my $domain = $Config{'mydomain'}; + $domain =~ s/^\.//; + $email = "$username\@$domain"; + } }; $author ||= "A. U. Thor"; @@ -1051,7 +1263,7 @@ $revhist = < should be removed. # #EOD - $exp_doc .= <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 \"$constscfname\"\n"; } -print_tievar_subs(\*XS, $_, $vdecl_hash{$_}) for @vdecls; my $prefix = defined $opt_p ? "PREFIX = $opt_p" : ''; @@ -1223,6 +1466,22 @@ MODULE = $module PACKAGE = $module $prefix END +# If a constant() function was #included then output a corresponding +# XS declaration: +print XS "INCLUDE: $constsxsfname\n" unless $opt_c; + +print XS <<"END" if $opt_g; + +BOOT: +{ + MY_CXT_INIT; + /* If any of the fields in the my_cxt_t struct need + to be initialised, do it here. + */ +} + +END + foreach (sort keys %const_xsub) { print XS <<"END"; char * @@ -1241,11 +1500,6 @@ $_() END } -# If a constant() function was written then output a corresponding -# XS declaration: -# XXX IVs -print XS XS_constant ($module, $types) unless $opt_c; - my %seen_decl; my %typemap; @@ -1562,6 +1816,8 @@ sub assign_typemap_entry { print "Type mutation via typedefs: $otype ==> $type\n" if $opt_d; $entry = assign_typemap_entry($type); } + # XXX good do better if our UV happens to be long long + return "T_NV" if $type =~ /^(unsigned\s+)?long\s+(long|double)\z/; $entry ||= $typemap{$otype} || (td_is_struct($type) ? "T_OPAQUE_STRUCT" : "T_PTROBJ"); $typemap{$otype} = $entry; @@ -1623,17 +1879,29 @@ EOP warn "Writing $ext$modpname/Makefile.PL\n"; open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n"; -print PL < 0%; +} +else +{ + $prereq_pm = ''; +} + +print PL <<"END"; +use $compat_version; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( - 'NAME' => '$module', - 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION - 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 - (\$] >= 5.005 ? ## Add these new keywords supported since 5.005 - (ABSTRACT_FROM => '$modfname.pm', # retrieve abstract from module - AUTHOR => '$author <$email>') : ()), + NAME => '$module', + VERSION_FROM => '$modfname.pm', # finds \$VERSION + PREREQ_PM => {$prereq_pm}, # e.g., Module::Name => 1.1 + (\$] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => '$modfname.pm', # retrieve abstract from module + AUTHOR => '$author <$email>') : ()), END if (!$opt_X) { # print C stuff, unless XS is disabled $opt_F = '' unless defined $opt_F; @@ -1644,22 +1912,85 @@ if (!$opt_X) { # print C stuff, unless XS is disabled EOC print PL < ['$extralibs'], # e.g., '-lm' - 'DEFINE' => '$opt_F', # e.g., '-DHAVE_SOMETHING' -$Icomment 'INC' => '$I', # e.g., '${Ihelp}-I/usr/include/other' + LIBS => ['$extralibs'], # e.g., '-lm' + DEFINE => '$opt_F', # e.g., '-DHAVE_SOMETHING' +$Icomment INC => '$I', # e.g., '${Ihelp}-I/usr/include/other' END - my $C = grep $_ ne "$modfname.c", (glob '*.c'), (glob '*.cc'), (glob '*.C'); + my $C = grep {$_ ne "$modfname.c"} + (glob '*.c'), (glob '*.cc'), (glob '*.C'); my $Cpre = ($C ? '' : '# '); my $Ccomment = ($C ? '' : < '\$(O_FILES)', # link all the C files too +$Ccomment ${Cpre}OBJECT => '\$(O_FILES)', # link all the C files too END -} +} # ' # Grr print PL ");\n"; +if (!$opt_c) { + my $generate_code = + WriteMakefileSnippet ( C_FILE => $constscfname, + XS_FILE => $constsxsfname, + DEFAULT_TYPE => $opt_t, + NAME => $module, + NAMES => \@const_names, + ); + 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 $constscfname and $constsxsfname + # files to replace their "fallback" counterparts before distributing your + # changes. +$generate_code +} +else { + use File::Copy; + 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 + + eval $generate_code; + if ($@) { + warn <<"EOM"; +Attempting to test constant code in $ext$modpname/Makefile.PL: +$generate_code +__END__ +gave unexpected error $@ +Please report the circumstances of this bug in h2xs version $H2XS_VERSION +using the perlbug script. +EOM + } else { + my $fail; + + foreach my $file ($constscfname, $constsxsfname) { + my $fallback = File::Spec->catfile($fallbackdirname, $file); + if (compare($file, $fallback)) { + warn << "EOM"; +Files "$ext$modpname/$fallbackdirname/$file" and "$ext$modpname/$file" differ. +EOM + $fail++; + } + } + if ($fail) { + warn fill ('','', <<"EOM") . "\n"; +It appears that the code in $ext$modpname/Makefile.PL does not autogenerate +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 $constscfname, $constsxsfname; + } + } +} close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n"; # Create a simple README since this is a CPAN requirement @@ -1669,6 +2000,18 @@ open(RM, ">README") || die "Can't create $ext$modpname/README:$!\n"; my $thisyear = (gmtime)[5] + 1900; my $rmhead = "$modpname version $TEMPLATE_VERSION"; my $rmheadeq = "=" x length($rmhead); + +my $rm_prereq; + +if ( $compat_version < 5.00702 and $new_test ) +{ + $rm_prereq = 'Test::More'; +} +else +{ + $rm_prereq = 'blah blah blah'; +} + print RM <<_RMEND_; $rmhead $rmheadeq @@ -1697,7 +2040,7 @@ DEPENDENCIES This module requires these other modules and libraries: - blah blah blah + $rm_prereq COPYRIGHT AND LICENCE @@ -1720,6 +2063,7 @@ warn "Writing $ext$modpname/$testfile\n"; my $tests = @const_names ? 2 : 1; open EX, ">$testfile" or die "Can't create $ext$modpname/$testfile: $!\n"; + print EX <<_END_; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1.t' @@ -1728,22 +2072,34 @@ print EX <<_END_; # change 'tests => $tests' to 'tests => last_test_to_print'; +_END_ + +my $test_mod = 'Test::More'; + +if ( $old_test or ($compat_version < 5.007 and not $new_test )) +{ + my $test_mod = 'Test'; + + print EX <<_END_; use Test; BEGIN { plan tests => $tests }; use $module; ok(1); # If we made it this far, we're ok. _END_ -if (@const_names) { - my $const_names = join " ", @const_names; - print EX <<'_END_'; + + if (@const_names) { + my $const_names = join " ", @const_names; + print EX <<'_END_'; my $fail; foreach my $constname (qw( _END_ - print EX wrap ("\t", "\t", $const_names); - print EX (")) {\n"); - print EX <<_END_; + + print EX wrap ("\t", "\t", $const_names); + print EX (")) {\n"); + + print EX <<_END_; next if (eval "my \\\$a = \$constname; 1"); if (\$\@ =~ /^Your vendor has not defined $module macro \$constname/) { print "# pass: \$\@"; @@ -1759,14 +2115,51 @@ if (\$fail) { } _END_ + } +} +else +{ + print EX <<_END_; +use Test::More tests => $tests; +BEGIN { use_ok('$module') }; + +_END_ + + if (@const_names) { + my $const_names = join " ", @const_names; + print EX <<'_END_'; + +my $fail = 0; +foreach my $constname (qw( +_END_ + + print EX wrap ("\t", "\t", $const_names); + print EX (")) {\n"); + + print EX <<_END_; + next if (eval "my \\\$a = \$constname; 1"); + if (\$\@ =~ /^Your vendor has not defined $module macro \$constname/) { + print "# pass: \$\@"; + } else { + print "# fail: \$\@"; + \$fail = 1; + } + +} + +ok( \$fail == 0 , 'Constants' ); +_END_ + } } -print EX <<'_END_'; + +print EX <<_END_; ######################### -# Insert your test code below, the Test module is use()ed here so read -# its man page ( perldoc Test ) for help writing this test script. +# Insert your test code below, the $test_mod module is use()ed here so read +# its man page ( perldoc $test_mod ) for help writing this test script. _END_ + close(EX) || die "Can't close $ext$modpname/$testfile: $!\n"; unless ($opt_C) { @@ -1787,7 +2180,7 @@ EOP warn "Writing $ext$modpname/MANIFEST\n"; open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!"; -my @files = grep { -f } (<*>, ); +my @files = grep { -f } (<*>, , <$fallbackdirname/*>); if (!@files) { eval {opendir(D,'.');}; unless ($@) { @files = readdir(D); closedir(D); }