X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fh2xs.PL;h=85645774289ffc59bab18282f10efbe9b53ee738;hb=67fed61ba7df4193ee696a1f5213265f154533e3;hp=9b7584c9bbc93ee5696f228d4ba0f380aa03d607;hpb=9de3b7c3f04d243540e2a381092bf0f918b7fe9e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utils/h2xs.PL b/utils/h2xs.PL index 9b7584c..8564577 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -66,6 +66,9 @@ the library path determined by Configure. That path can be augmented by including arguments of the form B<-L/another/library/path> in the extra-libraries argument. +In spite of its name, I may also be used to create a skeleton pure +Perl module. See the B<-X> option. + =head1 OPTIONS =over 5 @@ -75,6 +78,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 +91,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 @@ -95,12 +104,12 @@ Allows a pre-existing extension directory to be overwritten. =item B<-P>, B<--omit-pod> -Omit the autogenerated stub POD section. +Omit the autogenerated stub POD section. =item B<-X>, B<--omit-XS> -Omit the XS portion. Used to generate templates for a module which is not -XS-based. C<-c> and C<-f> are implicitly enabled. +Omit the XS portion. Used to generate a skeleton pure Perl module. +C<-c> and C<-f> are implicitly enabled. =item B<-a>, B<--gen-accessors> @@ -138,6 +147,24 @@ 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 @@ -145,7 +172,7 @@ not found in standard include directories. =item B<-g>, B<--global> -Include code for safely storing static data in the .xs file. +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> @@ -206,18 +233,40 @@ 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 then C which is the default for versions before -5.7.2 . C will be added to PREREQ_PM in the generated +C rather than C which is the default for versions before +5.6.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> @@ -239,63 +288,77 @@ 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 + + # Extension is rpcsvc::rusers. Still finds + h2xs rpcsvc::rusers + + # Extension is ONC::RPC. Still finds + h2xs -n ONC::RPC rpcsvc/rusers - # Same, but extension is RUSERS - h2xs -n RUSERS rpcsvc/rusers + # Without constant() or AUTOLOAD + h2xs -c rpcsvc/rusers - # Extension is rpcsvc::rusers. Still finds - h2xs rpcsvc::rusers + # Creates templates for an extension named RPC + h2xs -cfn RPC - # Extension is ONC::RPC. Still finds - h2xs -n ONC::RPC rpcsvc/rusers + # Extension is ONC::RPC. + h2xs -cfn ONC::RPC - # Without constant() or AUTOLOAD - h2xs -c rpcsvc/rusers + # Extension is a pure Perl module with no XS code. + h2xs -X My::Module - # Creates templates for an extension named RPC - h2xs -cfn 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 Suppose that you have some C files implementing some functionality, and the corresponding header files. How to create an extension which -makes this functionality accessable in Perl? The example below +makes this functionality accessible in Perl? The example below assumes that the header files are F and I, and you want the perl module be named as C. If you need some preprocessor directives and/or @@ -435,7 +498,7 @@ See L and L for additional details. use strict; -my( $H2XS_VERSION ) = ' $Revision: 1.21 $ ' =~ /\$Revision:\s+([^\s]+)/; +my( $H2XS_VERSION ) = ' $Revision: 1.23 $ ' =~ /\$Revision:\s+([^\s]+)/; my $TEMPLATE_VERSION = '0.01'; my @ARGS = @ARGV; my $compat_version = $]; @@ -447,7 +510,7 @@ $Text::Wrap::huge = 'overflow'; $Text::Wrap::columns = 80; use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload); use File::Compare; -use Devel::PPPort; +use File::Path; sub usage { warn "@_\n" if @_; @@ -456,23 +519,28 @@ 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. -P, --omit-pod Omit the stub POD section. -X, --omit-XS Omit the XS portion (implies both -c and -f). - -a, --gen-accessors Generate get/set accessors for struct and union members (used with -x). - -b, --compat-version Specify a perl version to be backwards compatibile with + -a, --gen-accessors Generate get/set accessors for struct and union members + (used with -x). + -b, --compat-version Specify a perl version to be backwards compatibile with. -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 + -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). -m, --gen-tied-var Generate tied variables for access to declared @@ -482,11 +550,18 @@ 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 (default is IV) - --use-new-tests Use Test::More in backward compatible modules - --use-old-tests Use the module Test rather than Test::More + -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. + --use-xsloader Use XSLoader in backward compatible modules (ignored + when used with -X). extra_libraries are any libraries that might be needed for loading the @@ -495,6 +570,7 @@ EOFUSAGE } my ($opt_A, + $opt_B, $opt_C, $opt_F, $opt_M, @@ -504,6 +580,7 @@ my ($opt_A, $opt_a, $opt_c, $opt_d, + $opt_e, $opt_f, $opt_g, $opt_h, @@ -518,13 +595,21 @@ my ($opt_A, $opt_b, $opt_t, $new_test, - $old_test + $old_test, + $skip_exporter, + $skip_ppport, + $skip_autoloader, + $skip_strict, + $skip_warnings, + $use_xsloader ); Getopt::Long::Configure('bundling'); +Getopt::Long::Configure('pass_through'); 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, @@ -535,6 +620,7 @@ 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, @@ -548,7 +634,13 @@ 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, + 'use-xsloader' => \$use_xsloader, ); GetOptions(%options) || usage; @@ -557,17 +649,20 @@ 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+/ || + $opt_b =~ /^v?(\d+)\.(\d+)\.(\d+)/ || 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); + my ($maj,$min,$sub) = ($1,$2,$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); } } 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,19 +671,47 @@ 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 %const_xsub; +%const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s; my $extralibs = ''; @@ -596,9 +719,10 @@ my @path_h; while (my $arg = shift) { if ($arg =~ /^-l/i) { - $extralibs = "$arg @ARGV"; - last; + $extralibs .= "$arg "; + next; } + last if $extralibs; push(@path_h, $arg); } @@ -638,8 +762,11 @@ EOD } } elsif ($opt_o or $opt_F) { - warn <) { if ($pre_sub_tri_graphs) { - # Preprocess all tri-graphs + # Preprocess all tri-graphs # including things stuck in quoted string constants. s/\?\?=/#/g; # | ??=| #| s/\?\?\!/|/g; # | ??!| || @@ -762,7 +888,35 @@ 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; + $src =~ s#//.*$##gm; + + while ($src =~ /\benum\s*([\w_]*)\s*\{\s([^}]+)\}/gsc) { + my ($enum_name, $enum_body) = ($1, $2); + # skip enums matching $opt_e + next if $opt_e && $enum_name =~ /$opt_e/; + my $val = 0; + for my $item (split /,/, $enum_body) { + next if $item =~ /\A\s*\Z/; + my ($key, $declared_val) = $item =~ /(\w+)\s*(?:=\s*(.*))?/; + $val = defined($declared_val) && length($declared_val) ? $declared_val : 1 + $val; + $seen_define{$key} = $val; + $const_names{$key} = { name => $key, macro => 1 }; + } + } # while (...) + } # if (!defined $opt_e or $opt_e) } } } @@ -770,24 +924,20 @@ 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); +# 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/' : ''; - -if( $module =~ /::/ ){ - $nested = 1; - @modparts = split(/::/,$module); - $modfname = $modparts[-1]; - $modpname = join('/',@modparts); -} -else { - $nested = 0; - @modparts = (); - $modfname = $modpname = $module; -} -# Don't trip up if someone calls their module 'constants' -$constsfname = $modfname eq 'constants' ? 'constdefs' : 'constants'; +my $ext = chdir 'ext' ? 'ext/' : ''; +my @modparts = split(/::/,$module); +my $modpname = join('-', @modparts); +my $modfname = pop @modparts; +my $modpmdir = join '/', 'lib', @modparts; +my $modpmname = join '/', $modpmdir, $modfname.'.pm'; if ($opt_O) { warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname; @@ -795,14 +945,7 @@ if ($opt_O) { else { die "Won't overwrite existing $ext$modpname\n" if -e $modpname; } -if( $nested ){ - my $modpath = ""; - foreach (@modparts){ - -d "$modpath$_" || mkdir("$modpath$_", 0777); - $modpath .= "$_/"; - } -} --d "$modpname" || mkdir($modpname, 0777); +-d "$modpname" || mkpath([$modpname], 0, 0775); chdir($modpname) || die "Can't chdir $ext$modpname: $!\n"; my %types_seen; @@ -820,13 +963,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; @@ -847,6 +991,8 @@ if( ! $opt_X ){ # use XS, unless it was disabled 'add_cppflags' => $addflags, 'c_styles' => \@styles; $c->set('includeDirs' => ["$Config::Config{archlib}/CORE", $cwd]); + $c->get('keywords')->{'__restrict'} = 1; + push @$fdecls_parsed, @{ $c->get('parsed_fdecls') }; push(@$fdecls, @{$c->get('fdecls')}); @@ -920,7 +1066,7 @@ if( ! $opt_X ){ # use XS, unless it was disabled $n = keys %td; my ($k, $v); while (($k, $v) = each %seen_define) { - # print("found '$k'=>'$v'\n"), + # print("found '$k'=>'$v'\n"), $bad_macs{$k} = $td{$k} = $td{$v} if exists $td{$v}; } } @@ -931,20 +1077,32 @@ if( ! $opt_X ){ # use XS, unless it was disabled } } } -my @const_names = sort keys %const_names; +my (@const_specs, @const_names); + +for (sort(keys(%const_names))) { + my $v = $const_names{$_}; + + push(@const_specs, ref($v) ? $v : $_); + push(@const_names, $_); +} -open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n"; +-d $modpmdir || mkpath([$modpmdir], 0, 0775); +open(PM, ">$modpmname") || die "Can't create $ext$modpname/$modpmname: $!\n"; $" = "\n\t"; -warn "Writing $ext$modpname/$modfname.pm\n"; +warn "Writing $ext$modpname/$modpmname\n"; 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 +1112,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 and not $use_xsloader); +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 +1134,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 +1170,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; @@ -1024,9 +1191,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 @@ -1063,7 +1239,7 @@ print PM <<"END"; __END__ END -my ($email,$author); +my ($email,$author,$licence); eval { my $username; @@ -1076,9 +1252,18 @@ eval { } }; +$author =~ s/'/\\'/g if defined $author; $author ||= "A. U. Thor"; $email ||= 'a.u.thor@a.galaxy.far.far.away'; +$licence = sprintf << "DEFAULT", $^V; +Copyright (C) ${\(1900 + (localtime) [5])} by $author + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version %vd or, +at your option, any later version of Perl 5 you may have available. +DEFAULT + my $revhist = ''; $revhist = < should be removed. # #EOD - $exp_doc .= < "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, + NAMES => \@const_specs, ); - print XS "#include \"$constsfname.c\"\n"; + print XS "#include \"$constscfname\"\n"; } @@ -1298,7 +1490,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; @@ -1445,7 +1637,7 @@ _to_ptr(THIS) croak("Size \%d of packed data != expected \%d", len, sizeof(THIS)); RETVAL = ($name *)s; - } + } else croak("THIS is not of type $name"); OUTPUT: @@ -1578,9 +1770,9 @@ sub get_typemap { next unless -e $typemap ; # skip directories, binary files etc. warn " Scanning $typemap\n"; - warn("Warning: ignoring non-text typemap file '$typemap'\n"), next + warn("Warning: ignoring non-text typemap file '$typemap'\n"), next unless -T $typemap ; - open(TYPEMAP, $typemap) + open(TYPEMAP, $typemap) or warn ("Warning: could not open typemap file '$typemap': $!\n"), next; my $mode = 'Typemap'; while () { @@ -1611,7 +1803,7 @@ sub normalize_type { # Second arg: do not strip const's before \* my $do_keep_deep_const = shift; # If $do_keep_deep_const this is heuristical only my $keep_deep_const = ($do_keep_deep_const ? '\b(?![^(,)]*\*)' : ''); - my $ignore_mods + my $ignore_mods = "(?:\\b(?:(?:__const__|const)$keep_deep_const|static|inline|__inline__)\\b\\s*)*"; if ($do_keep_deep_const) { # Keep different compiled /RExen/o separately! $type =~ s/$ignore_mods//go; @@ -1626,7 +1818,7 @@ sub normalize_type { # Second arg: do not strip const's before \* $type =~ s/\* (?=\*)/*/g; $type =~ s/\. \. \./.../g; $type =~ s/ ,/,/g; - $types_seen{$type}++ + $types_seen{$type}++ unless $type eq '...' or $type eq 'void' or $std_types{$type}; $type; } @@ -1709,15 +1901,20 @@ EOP warn "Writing $ext$modpname/Makefile.PL\n"; open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n"; -my $prereq_pm; +my $prereq_pm = ''; -if ( $compat_version < 5.00702 and $new_test ) +if ( $compat_version < 5.006002 and $new_test ) { - $prereq_pm = q%'Test::More' => 0%; + $prereq_pm .= q%'Test::More' => 0, %; } -else +elsif ( $compat_version < 5.006002 ) { - $prereq_pm = ''; + $prereq_pm .= q%'Test' => 0, %; +} + +if ( $compat_version < 5.006 and !$opt_X and $use_xsloader) +{ + $prereq_pm .= q%'XSLoader' => 0, %; } print PL <<"END"; @@ -1726,12 +1923,12 @@ 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' => {$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 => '$modpmname', # finds \$VERSION + PREREQ_PM => {$prereq_pm}, # e.g., Module::Name => 1.1 + (\$] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => '$modpmname', # retrieve abstract from module + AUTHOR => '$author <$email>') : ()), END if (!$opt_X) { # print C stuff, unless XS is disabled $opt_F = '' unless defined $opt_F; @@ -1742,21 +1939,12 @@ 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 - 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 ? '' : < '\$(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 => "$constsfname.c", - XS_FILE => "$constsfname.xs", + WriteMakefileSnippet ( C_FILE => $constscfname, + XS_FILE => $constsxsfname, DEFAULT_TYPE => $opt_t, NAME => $module, - NAMES => \@const_names, + NAMES => \@const_specs, ); 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 +1995,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 +2007,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; } } } @@ -1840,13 +2030,17 @@ my $rmheadeq = "=" x length($rmhead); my $rm_prereq; -if ( $compat_version < 5.00702 and $new_test ) +if ( $compat_version < 5.006002 and $new_test ) +{ + $rm_prereq = 'Test::More'; +} +elsif ( $compat_version < 5.006002 ) { - $rm_prereq = 'Test::More'; + $rm_prereq = 'Test'; } else { - $rm_prereq = 'blah blah blah'; + $rm_prereq = 'blah blah blah'; } print RM <<_RMEND_; @@ -1883,16 +2077,13 @@ COPYRIGHT AND LICENCE Put the correct copyright and licence information here. -Copyright (C) $thisyear $author - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +$licence _RMEND_ close(RM) || die "Can't close $ext$modpname/README: $!\n"; my $testdir = "t"; -my $testfile = "$testdir/1.t"; +my $testfile = "$testdir/$modpname.t"; unless (-d "$testdir") { mkdir "$testdir" or die "Cannot mkdir $testdir: $!\n"; } @@ -1903,17 +2094,20 @@ 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' +# `make test'. After `make install' it should work as `perl $modpname.t' ######################### # change 'tests => $tests' to 'tests => last_test_to_print'; +use strict; +use warnings; + _END_ my $test_mod = 'Test::More'; -if ( $old_test or ($compat_version < 5.007 and not $new_test )) +if ( $old_test or ($compat_version < 5.006002 and not $new_test )) { my $test_mod = 'Test'; @@ -1942,7 +2136,7 @@ _END_ print "# pass: \$\@"; } else { print "# fail: \$\@"; - \$fail = 1; + \$fail = 1; } } if (\$fail) { @@ -2017,7 +2211,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/*>, <$modpmdir/*>); if (!@files) { eval {opendir(D,'.');}; unless ($@) { @files = readdir(D); closedir(D); } @@ -2033,9 +2227,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!