=item B<-P>, B<--omit-pod>
-Omit the autogenerated stub POD section.
+Omit the autogenerated stub POD section.
=item B<-X>, B<--omit-XS>
=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>
# 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.
# 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
+ # 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
- # subroutines are created for sec_rgy_wildcard_name and
+ # 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
# 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
+ # 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
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<interface_simple.h> and
I<interface_hairy.h>, and you want the perl module be named as
C<Ext::Ension>. If you need some preprocessor directives and/or
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 = $];
$Text::Wrap::columns = 80;
use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload);
use File::Compare;
+use File::Path;
sub usage {
warn "@_\n" if @_;
-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
+ 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
-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<AutoLoader>
- --skip-strict Do not use the pragma C<strict>
- --skip-warnings Do not use the pragma C<warnings>
+ -t, --default-type Default type for autoloaded constants (default is IV).
+ --use-new-tests Use Test::More in backward compatible modules.
+ --use-old-tests Use the module Test rather than Test::More.
+ --skip-exporter Do not export symbols.
+ --skip-ppport Do not use portability layer.
+ --skip-autoloader Do not use the module C<AutoLoader>.
+ --skip-strict Do not use the pragma C<strict>.
+ --skip-warnings Do not use the pragma C<warnings>.
-v, --version Specify a version number for this extension.
-x, --autogen-xsubs Autogenerate XSUBs using C::Scan.
+ --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
$skip_autoloader,
$skip_strict,
$skip_warnings,
+ $use_xsloader
);
Getopt::Long::Configure('bundling');
+Getopt::Long::Configure('pass_through');
my %options = (
'omit-autoload|A' => \$opt_A,
'skip-autoloader' => \$skip_autoloader,
'skip-warnings' => \$skip_warnings,
'skip-strict' => \$skip_strict,
+ 'use-xsloader' => \$use_xsloader,
);
GetOptions(%options) || usage;
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) :
$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 = '';
while (my $arg = shift) {
if ($arg =~ /^-l/i) {
- $extralibs = "$arg @ARGV";
- last;
+ $extralibs .= "$arg ";
+ next;
}
+ last if $extralibs;
push(@path_h, $arg);
}
}
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
defines:
while (<CH>) {
if ($pre_sub_tri_graphs) {
- # Preprocess all tri-graphs
+ # Preprocess all tri-graphs
# including things stuck in quoted string constants.
s/\?\?=/#/g; # | ??=| #|
s/\?\?\!/|/g; # | ??!| ||
close(CH);
}
else {
- use Fcntl qw/SEEK_SET/;
- seek CH, 0, SEEK_SET;
+ # 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 $/; <CH> };
close CH;
no warnings 'uninitialized';
-
- # Remove C and C++ comments
+
+ # 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;
+
+ 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) {
- my ($key, $declared_val) = $item =~ /(\w*)\s*=\s*(.*)/;
- $val = length($declared_val) ? $declared_val : 1 + $val;
- $seen_define{$key} = $declared_val;
+ 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 (...)
# 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 $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;
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;
'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')});
$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};
}
}
}
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;
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
# 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;
__END__
END
-my ($email,$author);
+my ($email,$author,$licence);
eval {
my $username;
}
};
+$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 = <<EOT if $opt_C;
#
while ($name, $struct) = each %structs;
}
-my $pod = <<"END" unless $opt_P;
+# Prefix the default licence with hash symbols.
+# Is this just cargo cult - it seems that the first thing that happens to this
+# block is that all the hashes are then s///g out.
+my $licence_hash = $licence;
+$licence_hash =~ s/^/#/gm;
+
+my $pod;
+$pod = <<"END" unless $opt_P;
## Below is stub documentation for your module. You'd better edit it!
#
#=head1 NAME
#
#=head1 COPYRIGHT AND LICENSE
#
-#Copyright ${\(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.
+$licence_hash
#
#=cut
END
croak("Size \%d of packed data != expected \%d",
len, sizeof(THIS));
RETVAL = ($name *)s;
- }
+ }
else
croak("THIS is not of type $name");
OUTPUT:
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 (<TYPEMAP>) {
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;
$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;
}
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";
# 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
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";
}
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'
#########################
print "# pass: \$\@";
} else {
print "# fail: \$\@";
- \$fail = 1;
+ \$fail = 1;
}
}
if (\$fail) {
warn "Writing $ext$modpname/MANIFEST\n";
open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!";
-my @files = grep { -f } (<*>, <t/*>, <$fallbackdirname/*>);
+my @files = grep { -f } (<*>, <t/*>, <$fallbackdirname/*>, <$modpmdir/*>);
if (!@files) {
eval {opendir(D,'.');};
unless ($@) { @files = readdir(D); closedir(D); }
https://perl5.git.perl.org / perl5.git / blobdiff