X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fh2xs.PL;h=bd0ba16f46a40016ba47faa6abdbfe55f067b466;hb=1c65c084643b044d345d5f0dcf04fad352199ac7;hp=7e54d49acf7f79dd58a81ed9ea3b937c5a8e0daa;hpb=bbce6d69784bf43b0e69e8d312042d65f258af23;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utils/h2xs.PL b/utils/h2xs.PL index 7e54d49..bd0ba16 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -2,6 +2,7 @@ use Config; use File::Basename qw(&basename &dirname); +use Cwd; # List explicitly here the variables you want Configure to # generate. Metaconfig only looks for shell variables, so you @@ -12,10 +13,10 @@ use File::Basename qw(&basename &dirname); # This forces PL files to create target in same directory as PL file. # This is so that make depend always knows where to find PL derivatives. -chdir(dirname($0)); -($file = basename($0)) =~ s/\.PL$//; -$file =~ s/\.pl$// - if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving" +$origdir = cwd; +chdir dirname($0); +$file = basename($0, '.PL'); +$file .= '.com' if $^O eq 'VMS'; open OUT,">$file" or die "Can't create $file: $!"; @@ -25,9 +26,9 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. @@ -40,19 +41,19 @@ h2xs - convert .h C header files to Perl extensions =head1 SYNOPSIS -B [B<-AOPXcdf>] [B<-v> version] [B<-n> module_name] [B<-p> prefix] [B<-s> sub] [headerfile [extra_libraries]] +B [B<-ACOPXcdf>] [B<-v> version] [B<-n> module_name] [B<-p> prefix] [B<-s> sub] [headerfile ... [extra_libraries]] B B<-h> =head1 DESCRIPTION -I builds a Perl extension from any C header file. The extension will -include functions which can be used to retrieve the value of any #define -statement which was in the C header. +I builds a Perl extension from C header files. The extension +will include functions which can be used to retrieve the value of any +#define statement which was in the C header files. The I will be used for the name of the extension. If -module_name is not supplied then the name of the header file will be used, -with the first character capitalized. +module_name is not supplied then the name of the first header file +will be used, with the first character capitalized. If the extension might need extra libraries, they should be included here. The extension Makefile.PL will take care of checking whether @@ -70,7 +71,12 @@ in the extra-libraries argument. =item B<-A> Omit all autoload facilities. This is the same as B<-c> but also removes the -S> statement from the .pm file. +S> statement from the .pm file. + +=item B<-C> + +Omits creation of the F file, and adds a HISTORY section to +the POD template. =item B<-F> @@ -88,7 +94,7 @@ Omit the autogenerated stub POD section. =item B<-X> Omit the XS portion. Used to generate templates for a module which is not -XS-based. +XS-based. C<-c> and C<-f> are implicitly enabled. =item B<-c> @@ -116,7 +122,7 @@ Specifies a name to be used for the extension, e.g., S<-n RPC::DCE> Specify a prefix which should be removed from the Perl function names, e.g., S<-p sec_rgy_> This sets up the XS B keyword and removes the prefix from functions that are -autoloaded via the C mechansim. +autoloaded via the C mechanism. =item B<-s> I @@ -210,20 +216,21 @@ The usual warnings if it cannot read or write the files involved. =cut -my( $H2XS_VERSION ) = ' $Revision: 1.18 $ ' =~ /\$Revision:\s+([^\s]+)/; +my( $H2XS_VERSION ) = ' $Revision: 1.19 $ ' =~ /\$Revision:\s+([^\s]+)/; my $TEMPLATE_VERSION = '0.01'; use Getopt::Std; sub usage{ warn "@_\n" if @_; - die "h2xs [-AOPXcdfh] [-v version] [-n module_name] [-p prefix] [-s subs] [headerfile [extra_libraries]] + die "h2xs [-ACOPXcdfh] [-v version] [-n module_name] [-p prefix] [-s subs] [headerfile [extra_libraries]] version: $H2XS_VERSION -A Omit all autoloading facilities (implies -c). + -C Omit creating the Changes file, add HISTORY heading to stub POD. -F Additional flags for C preprocessor (used with -x). -O Allow overwriting of a pre-existing extension directory. -P Omit the stub POD section. - -X Omit the XS portion. + -X Omit the XS portion (implies both -c and -f). -c Omit the constant() function and specialised AUTOLOAD from the XS file. -d Turn on debugging messages. -f Force creation of the extension even if the C header does not exist. @@ -240,25 +247,37 @@ extra_libraries } -getopts("AF:OPXcdfhn:p:s:v:x") || usage; +getopts("ACF:OPXcdfhn:p:s:v:x") || usage; usage if $opt_h; if( $opt_v ){ $TEMPLATE_VERSION = $opt_v; } + +# -A implies -c. $opt_c = 1 if $opt_A; + +# -X implies -c and -f +$opt_c = $opt_f = 1 if $opt_X; + %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s; -$path_h = shift; -$extralibs = "@ARGV"; +while (my $arg = shift) { + if ($arg =~ /^-l/i) { + $extralibs = "$arg @ARGV"; + last; + } + push(@path_h, $arg); +} usage "Must supply header file or module name\n" - unless ($path_h or $opt_n); + unless (@path_h or $opt_n); -if( $path_h ){ - $name = $path_h; +if( @path_h ){ + foreach my $path_h (@path_h) { + $name ||= $path_h; if( $path_h =~ s#::#/#g && $opt_n ){ warn "Nesting of headerfile ignored with -n\n"; } @@ -289,7 +308,7 @@ if( $path_h ){ die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h ); # Scan the header file (we should deal with nested header files) # Record the names of simple #define constants into const_names - # Function prototypes are not (currently) processed. + # Function prototypes are processed below. open(CH, "<$path_h") || die "Can't open $path_h: $!\n"; while () { if (/^#[ \t]*define\s+([\$\w]+)\b\s*[^("]/) { @@ -308,8 +327,9 @@ if( $path_h ){ } } close(CH); - @const_names = sort keys %const_names; } + } + @const_names = sort keys %const_names; } @@ -354,8 +374,8 @@ chdir($modpname) || die "Can't chdir $ext$modpname: $!\n"; my %types_seen; my %std_types; -my $fdecls; -my $fdecls_parsed; +my $fdecls = []; +my $fdecls_parsed = []; if( ! $opt_X ){ # use XS, unless it was disabled open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n"; @@ -366,19 +386,20 @@ if( ! $opt_X ){ # use XS, unless it was disabled get_typemap(); my $c; my $filter; - my $filename = $path_h; - my $addflags = $opt_F || ''; - if ($fullpath =~ /,/) { - $filename = $`; - $filter = $'; + foreach my $filename (@path_h) { + my $addflags = $opt_F || ''; + if ($fullpath =~ /,/) { + $filename = $`; + $filter = $'; + } + warn "Scanning $filename for functions...\n"; + $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter, + 'add_cppflags' => $addflags; + $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]); + + push @$fdecls_parsed, @{ $c->get('parsed_fdecls') }; + push(@$fdecls, @{$c->get('fdecls')}); } - warn "Scanning $filename for functions...\n"; - $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter, - 'add_cppflags' => $addflags; - $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]); - - $fdecls_parsed = $c->get('parsed_fdecls'); - $fdecls = $c->get('fdecls'); } } @@ -396,7 +417,7 @@ END if( $opt_X || $opt_c || $opt_A ){ # we won't have our own AUTOLOAD(), so won't have $AUTOLOAD print PM <<'END'; -use vars qw($VERSION @ISA @EXPORT); +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); END } else{ @@ -404,7 +425,7 @@ else{ # will want Carp. print PM <<'END'; use Carp; -use vars qw($VERSION @ISA @EXPORT $AUTOLOAD); +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD); END } @@ -417,46 +438,22 @@ print PM <<"END" if ! $opt_X; # use DynaLoader, unless XS was disabled require DynaLoader; END -# require autoloader if XS is disabled. -# if XS is enabled, require autoloader unless autoloading is disabled. -if( $opt_X || (! $opt_A) ){ - print PM <<"END"; -require AutoLoader; -END -} -if( $opt_X || ($opt_c && ! $opt_A) ){ - # we won't have our own AUTOLOAD(), so we'll inherit it. - if( ! $opt_X ) { # use DynaLoader, unless XS was disabled - print PM <<"END"; - -\@ISA = qw(Exporter AutoLoader DynaLoader); -END +# Are we using AutoLoader or not? +unless ($opt_A) { # no autoloader whatsoever. + unless ($opt_c) { # we're doing the AUTOLOAD + print PM "use AutoLoader;\n"; } - else{ - print PM <<"END"; - -\@ISA = qw(Exporter AutoLoader); -END + else { + print PM "use AutoLoader qw(AUTOLOAD);\n" } } -else{ - # 1) we have our own AUTOLOAD(), so don't need to inherit it. - # or - # 2) we don't want autoloading mentioned. - if( ! $opt_X ){ # use DynaLoader, unless XS was disabled - print PM <<"END"; -\@ISA = qw(Exporter DynaLoader); -END - } - else{ - print PM <<"END"; - -\@ISA = qw(Exporter); -END - } -} +# Determine @ISA. +my $myISA = '@ISA = qw(Exporter'; # We seem to always want this. +$myISA .= ' DynaLoader' unless $opt_X; # no XS +$myISA .= ');'; +print PM "\n$myISA\n\n"; print PM<<"END"; # Items to export into callers namespace by default. Note: do not export @@ -477,9 +474,10 @@ sub AUTOLOAD { my \$constname; (\$constname = \$AUTOLOAD) =~ s/.*:://; + croak "&$module::constant not defined" if \$constname eq 'constant'; my \$val = constant(\$constname, \@_ ? \$_[0] : 0); if (\$! != 0) { - if (\$! =~ /Invalid/) { + if (\$! =~ /Invalid/ || \$!{EINVAL}) { \$AutoLoader::AUTOLOAD = \$AUTOLOAD; goto &AutoLoader::AUTOLOAD; } @@ -487,7 +485,8 @@ sub AUTOLOAD { croak "Your vendor has not defined $module macro \$constname"; } } - eval "sub \$AUTOLOAD { \$val }"; + no strict 'refs'; + *\$AUTOLOAD = sub () { \$val }; goto &\$AUTOLOAD; } @@ -509,8 +508,14 @@ else { print PM <<"END"; # Preloaded methods go here. +END + +print PM <<"END" unless $opt_A; # Autoload methods go after $after, and are processed by the autosplit program. +END + +print PM <<"END"; 1; __END__ @@ -519,11 +524,26 @@ END $author = "A. U. Thor"; $email = 'a.u.thor@a.galaxy.far.far.away'; +my $revhist = ''; +$revhist = <\]]##; } -print XS <<"END"; -#include <$h> - -END + print XS qq{#include <$h>\n}; + } + print XS "\n"; } if( ! $opt_c ){ print XS <<"END"; static int -not_here(s) -char *s; +not_here(char *s) { croak("$module::%s not implemented on this architecture", s); return -1; } static double -constant(name, arg) -char *name; -int arg; +constant(char *name, int arg) { errno = 0; switch (*name) { @@ -858,12 +869,14 @@ print "ok 1\n"; _END_ close(EX) || die "Can't close $ext$modpname/test.pl: $!\n"; -warn "Writing $ext$modpname/Changes\n"; -open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n"; -print EX "Revision history for Perl extension $module.\n\n"; -print EX "$TEMPLATE_VERSION ",scalar localtime,"\n"; -print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n"; -close(EX) || die "Can't close $ext$modpname/Changes: $!\n"; +unless ($opt_C) { + warn "Writing $ext$modpname/Changes\n"; + open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n"; + print EX "Revision history for Perl extension $module.\n\n"; + print EX "$TEMPLATE_VERSION ",scalar localtime,"\n"; + print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n"; + close(EX) || die "Can't close $ext$modpname/Changes: $!\n"; +} warn "Writing $ext$modpname/MANIFEST\n"; open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!"; @@ -883,10 +896,11 @@ if ($^O eq 'VMS') { $_ = 'Makefile.PL' if $_ eq 'makefile.pl'; } } -print MANI join("\n",@files); +print MANI join("\n",@files), "\n"; close MANI; !NO!SUBS! close OUT or die "Can't close $file: $!"; chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir;