X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fh2xs.PL;h=c774d62adf1ee980455f33d10803a9312a1a4080;hb=24d786f4d2806834028ce32abc1769da2e945f9b;hp=f9a09a1c09bf5d0d4bbc7204550b736b8bc07355;hpb=1dd73f2742b0eabfe6ac8450e3f71bc08cb138db;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utils/h2xs.PL b/utils/h2xs.PL index f9a09a1..c774d62 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 @@ -101,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> @@ -144,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 @@ -151,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> @@ -267,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 - # 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 ONC::RPC. - h2xs -cfn ONC::RPC + # Extension is a pure Perl module with no XS code. + h2xs -X My::Module - # Makefile.PL will look for library -lrpc in - # additional directory /opt/net/lib - h2xs rpcsvc/rusers -L/opt/net/lib -lrpc + # 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 DCE::rgynbase - # prefix "sec_rgy_" is dropped from perl function names - h2xs -n DCE::rgynbase -p sec_rgy_ dce/rgynbase + # 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 - # 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 + # Makefile.PL will look for library -lrpc in + # additional directory /opt/net/lib + h2xs rpcsvc/rusers -L/opt/net/lib -lrpc - # 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 + # Extension is DCE::rgynbase + # prefix "sec_rgy_" is dropped from perl function names + h2xs -n DCE::rgynbase -p sec_rgy_ dce/rgynbase - # Same with function declaration in proto.h as visible from perl.h. - h2xs -xAn perl2 perl.h,proto.h + # 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 - # Same but select only functions which match /^av_/ - h2xs -M '^av_' -xAn perl2 perl.h,proto.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 but treat SV* etc as "opaque" types - h2xs -o '^[S]V \*$' -M '^av_' -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 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 @@ -463,7 +498,7 @@ See L and L for additional details. use strict; -my( $H2XS_VERSION ) = ' $Revision: 1.22 $ ' =~ /\$Revision:\s+([^\s]+)/; +my( $H2XS_VERSION ) = ' $Revision: 1.23 $ ' =~ /\$Revision:\s+([^\s]+)/; my $TEMPLATE_VERSION = '0.01'; my @ARGS = @ARGV; my $compat_version = $]; @@ -475,6 +510,7 @@ $Text::Wrap::huge = 'overflow'; $Text::Wrap::columns = 80; use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload); use File::Compare; +use File::Path; sub usage { warn "@_\n" if @_; @@ -492,15 +528,19 @@ OPTIONS: -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 @@ -510,16 +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 - --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 + -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 @@ -538,6 +580,7 @@ my ($opt_A, $opt_a, $opt_c, $opt_d, + $opt_e, $opt_f, $opt_g, $opt_h, @@ -558,9 +601,11 @@ my ($opt_A, $skip_autoloader, $skip_strict, $skip_warnings, + $use_xsloader ); Getopt::Long::Configure('bundling'); +Getopt::Long::Configure('pass_through'); my %options = ( 'omit-autoload|A' => \$opt_A, @@ -575,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, @@ -594,6 +640,7 @@ my %options = ( 'skip-autoloader' => \$skip_autoloader, 'skip-warnings' => \$skip_warnings, 'skip-strict' => \$skip_strict, + 'use-xsloader' => \$use_xsloader, ); GetOptions(%options) || usage; @@ -602,18 +649,16 @@ 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 = $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); + $compat_version = sprintf("%d.%03d%03d",$maj,$min,$sub); } } else { my ($maj,$min,$sub) = $compat_version =~ /(\d+)\.(\d\d\d)(\d*)/; @@ -665,7 +710,8 @@ $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 = ''; @@ -673,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); } @@ -788,7 +835,7 @@ if( @path_h ){ } if (!$opt_c) { - die "Can't find $tmp_path_h in @dirs\n" + die "Can't find $tmp_path_h in @dirs\n" if ( ! $opt_f && ! -f "$rel_path_h" ); # Scan the header file (we should deal with nested header files) # Record the names of simple #define constants into const_names @@ -797,7 +844,7 @@ if( @path_h ){ defines: while () { if ($pre_sub_tri_graphs) { - # Preprocess all tri-graphs + # Preprocess all tri-graphs # including things stuck in quoted string constants. s/\?\?=/#/g; # | ??=| #| s/\?\?\!/|/g; # | ??!| || @@ -841,7 +888,34 @@ 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([^}]+)\}/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}++; + } + } # while (...) + } # if (!defined $opt_e or $opt_e) } } } @@ -849,7 +923,6 @@ 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); # 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. @@ -857,20 +930,13 @@ 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; -} +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; @@ -878,14 +944,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; @@ -931,6 +990,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')}); @@ -1004,7 +1065,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}; } } @@ -1017,10 +1078,11 @@ if( ! $opt_X ){ # use XS, unless it was disabled } my @const_names = sort keys %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; @@ -1047,7 +1109,7 @@ print PM <<'END' unless $skip_exporter; require Exporter; END -my $use_Dyna = (not $opt_X and $compat_version < 5.006); +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 @@ -1073,7 +1135,7 @@ if ( $compat_version < 5.006 ) { # Determine @ISA. my @modISA; -push @modISA, 'Exporter' unless $skip_exporter; +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; @@ -1169,7 +1231,7 @@ print PM <<"END"; __END__ END -my ($email,$author); +my ($email,$author,$licence); eval { my $username; @@ -1182,9 +1244,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 = <) { @@ -1727,7 +1795,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; @@ -1742,7 +1810,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; } @@ -1825,15 +1893,16 @@ 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 ) { - $prereq_pm = q%'Test::More' => 0%; + $prereq_pm .= q%'Test::More' => 0, %; } -else + +if ( $compat_version < 5.00600 and !$opt_X and $use_xsloader) { - $prereq_pm = ''; + $prereq_pm .= q%'XSLoader' => 0, %; } print PL <<"END"; @@ -1843,10 +1912,10 @@ use ExtUtils::MakeMaker; # the contents of the Makefile that is written. WriteMakefile( NAME => '$module', - VERSION_FROM => '$modfname.pm', # finds \$VERSION + 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 => '$modfname.pm', # retrieve abstract from module + (ABSTRACT_FROM => '$modpmname', # retrieve abstract from module AUTHOR => '$author <$email>') : ()), END if (!$opt_X) { # print C stuff, unless XS is disabled @@ -1992,16 +2061,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"; } @@ -2012,7 +2078,7 @@ 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' ######################### @@ -2051,7 +2117,7 @@ _END_ print "# pass: \$\@"; } else { print "# fail: \$\@"; - \$fail = 1; + \$fail = 1; } } if (\$fail) { @@ -2126,7 +2192,7 @@ EOP warn "Writing $ext$modpname/MANIFEST\n"; open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!"; -my @files = grep { -f } (<*>, , <$fallbackdirname/*>); +my @files = grep { -f } (<*>, , <$fallbackdirname/*>, <$modpmdir/*>); if (!@files) { eval {opendir(D,'.');}; unless ($@) { @files = readdir(D); closedir(D); }