summaryrefslogtreecommitdiff
path: root/gnu/usr.bin/perl/utils/h2xs.PL
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/usr.bin/perl/utils/h2xs.PL')
-rw-r--r--gnu/usr.bin/perl/utils/h2xs.PL618
1 files changed, 618 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/utils/h2xs.PL b/gnu/usr.bin/perl/utils/h2xs.PL
new file mode 100644
index 00000000000..f9868dc37f0
--- /dev/null
+++ b/gnu/usr.bin/perl/utils/h2xs.PL
@@ -0,0 +1,618 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate. Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries. Thus you write
+# $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# 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"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+ eval 'exec perl -S \$0 "\$@"'
+ if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+=head1 NAME
+
+h2xs - convert .h C header files to Perl extensions
+
+=head1 SYNOPSIS
+
+B<h2xs> [B<-AOPXcf>] [B<-v> version] [B<-n> module_name] [headerfile [extra_libraries]]
+
+B<h2xs> B<-h>
+
+=head1 DESCRIPTION
+
+I<h2xs> 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.
+
+The I<module_name> 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.
+
+If the extension might need extra libraries, they should be included
+here. The extension Makefile.PL will take care of checking whether
+the libraries actually exist and how they should be loaded.
+The extra libraries should be specified in the form -lm -lposix, etc,
+just as on the cc command line. By default, the Makefile.PL will
+search through 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.
+
+=head1 OPTIONS
+
+=over 5
+
+=item B<-A>
+
+Omit all autoload facilities. This is the same as B<-c> but also removes the
+S<C<require AutoLoader>> statement from the .pm file.
+
+=item B<-O>
+
+Allows a pre-existing extension directory to be overwritten.
+
+=item B<-P>
+
+Omit the autogenerated stub POD section.
+
+=item B<-c>
+
+Omit C<constant()> from the .xs file and corresponding specialised
+C<AUTOLOAD> from the .pm file.
+
+=item B<-f>
+
+Allows an extension to be created for a header even if that header is
+not found in /usr/include.
+
+=item B<-h>
+
+Print the usage, help and version for this h2xs and exit.
+
+=item B<-n> I<module_name>
+
+Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
+
+=item B<-v> I<version>
+
+Specify a version number for this extension. This version number is added
+to the templates. The default is 0.01.
+
+=item B<-X>
+
+Omit the XS portion. Used to generate templates for a module which is not
+XS-based.
+
+=back
+
+=head1 EXAMPLES
+
+
+ # Default behavior, extension is Rusers
+ h2xs rpcsvc/rusers
+
+ # Same, but extension is RUSERS
+ h2xs -n RUSERS rpcsvc/rusers
+
+ # Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
+ h2xs rpcsvc::rusers
+
+ # Extension is ONC::RPC. Still finds <rpcsvc/rusers.h>
+ h2xs -n ONC::RPC rpcsvc/rusers
+
+ # Without constant() or AUTOLOAD
+ h2xs -c rpcsvc/rusers
+
+ # Creates templates for an extension named RPC
+ h2xs -cfn RPC
+
+ # Extension is ONC::RPC.
+ h2xs -cfn ONC::RPC
+
+ # Makefile.PL will look for library -lrpc in
+ # additional directory /opt/net/lib
+ h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
+
+
+=head1 ENVIRONMENT
+
+No environment variables are used.
+
+=head1 AUTHOR
+
+Larry Wall and others
+
+=head1 SEE ALSO
+
+L<perl>, L<perlxstut>, L<ExtUtils::MakeMaker>, and L<AutoLoader>.
+
+=head1 DIAGNOSTICS
+
+The usual warnings if it can't read or write the files involved.
+
+=cut
+
+my( $H2XS_VERSION ) = '$Revision: 1.16 $' =~ /\$Revision:\s+([^\s]+)/;
+my $TEMPLATE_VERSION = '0.01';
+
+use Getopt::Std;
+
+sub usage{
+ warn "@_\n" if @_;
+ die "h2xs [-AOPXcfh] [-v version] [-n module_name] [headerfile [extra_libraries]]
+version: $H2XS_VERSION
+ -f Force creation of the extension even if the C header does not exist.
+ -n Specify a name to use for the extension (recommended).
+ -c Omit the constant() function and specialised AUTOLOAD from the XS file.
+ -A Omit all autoloading facilities (implies -c).
+ -O Allow overwriting of a pre-existing extension directory.
+ -P Omit the stub POD section.
+ -X Omit the XS portion.
+ -v Specify a version number for this extension.
+ -h Display this help message
+extra_libraries
+ are any libraries that might be needed for loading the
+ extension, e.g. -lm would try to link in the math library.
+";
+}
+
+
+getopts("AOPXcfhv:n:") || usage;
+
+usage if $opt_h;
+
+if( $opt_v ){
+ $TEMPLATE_VERSION = $opt_v;
+}
+$opt_c = 1 if $opt_A;
+
+$path_h = shift;
+$extralibs = "@ARGV";
+
+usage "Must supply header file or module name\n"
+ unless ($path_h or $opt_n);
+
+
+if( $path_h ){
+ $name = $path_h;
+ if( $path_h =~ s#::#/#g && $opt_n ){
+ warn "Nesting of headerfile ignored with -n\n";
+ }
+ $path_h .= ".h" unless $path_h =~ /\.h$/;
+ $path_h = "/usr/include/$path_h" unless $path_h =~ m#^[./]#;
+ 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.
+ open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
+ while (<CH>) {
+ if (/^#[ \t]*define\s+(\w+)\b\s*[^("]/) {
+ $_ = $1;
+ next if /^_.*_h_*$/i; # special case, but for what?
+ $const_names{$_}++;
+ }
+ }
+ close(CH);
+ @const_names = sort keys %const_names;
+}
+
+
+$module = $opt_n || do {
+ $name =~ s/\.h$//;
+ if( $name !~ /::/ ){
+ $name =~ s#^.*/##;
+ $name = "\u$name";
+ }
+ $name;
+};
+
+(chdir 'ext', $ext = 'ext/') if -d 'ext';
+
+if( $module =~ /::/ ){
+ $nested = 1;
+ @modparts = split(/::/,$module);
+ $modfname = $modparts[-1];
+ $modpname = join('/',@modparts);
+}
+else {
+ $nested = 0;
+ @modparts = ();
+ $modfname = $modpname = $module;
+}
+
+
+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 ){
+ $modpath = "";
+ foreach (@modparts){
+ mkdir("$modpath$_", 0777);
+ $modpath .= "$_/";
+ }
+}
+mkdir($modpname, 0777);
+chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
+
+if( ! $opt_X ){ # use XS, unless it was disabled
+ open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
+}
+open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
+
+$" = "\n\t";
+warn "Writing $ext$modpname/$modfname.pm\n";
+
+print PM <<"END";
+package $module;
+
+use strict;
+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);
+END
+}
+else{
+ # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
+ # will want Carp.
+ print PM <<'END';
+use Carp;
+use vars qw($VERSION @ISA @EXPORT $AUTOLOAD);
+END
+}
+
+print PM <<'END';
+
+require Exporter;
+END
+
+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
+ }
+ else{
+ print PM <<"END";
+
+\@ISA = qw(Exporter AutoLoader);
+END
+ }
+}
+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
+ }
+}
+
+print PM<<"END";
+# 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.
+\@EXPORT = qw(
+ @const_names
+);
+\$VERSION = '$TEMPLATE_VERSION';
+
+END
+
+print PM <<"END" unless $opt_c or $opt_X;
+sub AUTOLOAD {
+ # This AUTOLOAD is used to 'autoload' constants from the constant()
+ # XS function. If a constant is not found then control is passed
+ # to the AUTOLOAD in AutoLoader.
+
+ my \$constname;
+ (\$constname = \$AUTOLOAD) =~ s/.*:://;
+ my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
+ if (\$! != 0) {
+ if (\$! =~ /Invalid/) {
+ \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
+ goto &AutoLoader::AUTOLOAD;
+ }
+ else {
+ croak "Your vendor has not defined $module macro \$constname";
+ }
+ }
+ eval "sub \$AUTOLOAD { \$val }";
+ goto &\$AUTOLOAD;
+}
+
+END
+
+if( ! $opt_X ){ # print bootstrap, unless XS is disabled
+ print PM <<"END";
+bootstrap $module \$VERSION;
+END
+}
+
+if( $opt_P ){ # if POD is disabled
+ $after = '__END__';
+}
+else {
+ $after = '=cut';
+}
+
+print PM <<"END";
+
+# Preloaded methods go here.
+
+# Autoload methods go after $after, and are processed by the autosplit program.
+
+1;
+__END__
+END
+
+$author = "A. U. Thor";
+$email = 'a.u.thor@a.galaxy.far.far.away';
+
+$pod = <<"END" unless $opt_P;
+## Below is the stub of documentation for your module. You better edit it!
+#
+#=head1 NAME
+#
+#$module - Perl extension for blah blah blah
+#
+#=head1 SYNOPSIS
+#
+# use $module;
+# blah blah blah
+#
+#=head1 DESCRIPTION
+#
+#Stub documentation for $module was created by h2xs. It looks like the
+#author of the extension was negligent enough to leave the stub
+#unedited.
+#
+#Blah blah blah.
+#
+#=head1 AUTHOR
+#
+#$author, $email
+#
+#=head1 SEE ALSO
+#
+#perl(1).
+#
+#=cut
+END
+
+$pod =~ s/^\#//gm unless $opt_P;
+print PM $pod unless $opt_P;
+
+close PM;
+
+
+if( ! $opt_X ){ # print XS, unless it is disabled
+warn "Writing $ext$modpname/$modfname.xs\n";
+
+print XS <<"END";
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#ifdef __cplusplus
+}
+#endif
+
+END
+if( $path_h ){
+ my($h) = $path_h;
+ $h =~ s#^/usr/include/##;
+print XS <<"END";
+#include <$h>
+
+END
+}
+
+if( ! $opt_c ){
+print XS <<"END";
+static int
+not_here(s)
+char *s;
+{
+ croak("$module::%s not implemented on this architecture", s);
+ return -1;
+}
+
+static double
+constant(name, arg)
+char *name;
+int arg;
+{
+ errno = 0;
+ switch (*name) {
+END
+
+my(@AZ, @az, @under);
+
+foreach(@const_names){
+ @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
+ @az = 'a' .. 'z' if !@az && /^[a-z]/;
+ @under = '_' if !@under && /^_/;
+}
+
+foreach $letter (@AZ, @az, @under) {
+
+ last if $letter eq 'a' && !@const_names;
+
+ print XS " case '$letter':\n";
+ my($name);
+ while (substr($const_names[0],0,1) eq $letter) {
+ $name = shift(@const_names);
+ print XS <<"END";
+ if (strEQ(name, "$name"))
+#ifdef $name
+ return $name;
+#else
+ goto not_there;
+#endif
+END
+ }
+ print XS <<"END";
+ break;
+END
+}
+print XS <<"END";
+ }
+ errno = EINVAL;
+ return 0;
+
+not_there:
+ errno = ENOENT;
+ return 0;
+}
+
+END
+}
+
+# Now switch from C to XS by issuing the first MODULE declaration:
+print XS <<"END";
+
+MODULE = $module PACKAGE = $module
+
+END
+
+# If a constant() function was written then output a corresponding
+# XS declaration:
+print XS <<"END" unless $opt_c;
+
+double
+constant(name,arg)
+ char * name
+ int arg
+
+END
+
+close XS;
+} # if( ! $opt_X )
+
+warn "Writing $ext$modpname/Makefile.PL\n";
+open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
+
+print PL <<'END';
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+END
+print PL "WriteMakefile(\n";
+print PL " 'NAME' => '$module',\n";
+print PL " 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n";
+if( ! $opt_X ){ # print C stuff, unless XS is disabled
+ print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n";
+ print PL " 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' \n";
+ print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n";
+}
+print PL ");\n";
+close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
+
+warn "Writing $ext$modpname/test.pl\n";
+open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\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 test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+_END_
+print EX <<_END_;
+use $module;
+_END_
+print EX <<'_END_';
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+_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";
+
+warn "Writing $ext$modpname/MANIFEST\n";
+open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!";
+@files = <*>;
+if (!@files) {
+ eval {opendir(D,'.');};
+ unless ($@) { @files = readdir(D); closedir(D); }
+}
+if (!@files) { @files = map {chomp && $_} `ls`; }
+print MANI join("\n",@files);
+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 ':';
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-25 09:37:25 +0000