[perl5.git] / h2xs

#!/usr/bin/perl
'di ';
'ds 00 \"';
'ig 00 ';

use Getopt::Std;

sub usage{
	warn "@_\n" if @_;
    die 'h2xs [-fnch] [-n module_name] [headerfile [extra_libraries]]
    -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.
    -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("fhcAn:") || usage;

usage if $opt_h;
$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' if -d 'ext';

if( $module =~ /::/ ){
	$nested = 1;
	@modparts = split(/::/,$module);
	$modfname = $modparts[-1];
	$modpname = join('/',@modparts);
}
else {
	$nested = 0;
	@modparts = ();
	$modfname = $modpname = $module;
}


die "Won't overwrite existing ext/$modpname\n" if -e $modpname;
# quick hack, should really loop over @modparts
mkdir($modparts[0], 0777) if $nested;
mkdir($modpname, 0777);
chdir($modpname) || die "Can't chdir ext/$modpname: $!\n";

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;

require Exporter;
require AutoLoader;
require DynaLoader;

\@ISA = qw(Exporter AutoLoader DynaLoader);

# 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
);
# Other items we are prepared to export if requested
\@EXPORT_OK = qw(
);

END

print PM <<"END" unless $opt_c;
sub AUTOLOAD {
    # This AUTOLOAD function overrides the one inherited from AutoLoader.
    # It is used to 'autoload' constants from the constant() XS function.

    # NOTE: THIS AUTOLOAD FUNCTION IS FLAWED (but is the best we can do for now).
    # Avoid old-style ``&CONST'' usage. Either remove the ``&'' or add ``()''.
    if (\@_ > 0) {
	\$AutoLoader::AUTOLOAD = \$AUTOLOAD;
	goto &AutoLoader::AUTOLOAD;
    }
    local(\$constname);
    (\$constname = \$AUTOLOAD) =~ s/.*:://;
    \$val = constant(\$constname, \@_ ? \$_[0] : 0);
    if (\$! != 0) {
	if (\$! =~ /Invalid/) {
	    \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
	    goto &AutoLoader::AUTOLOAD;
	}
	else {
	    (\$pack,\$file,\$line) = caller;
	    die "Your vendor has not defined $module macro \$constname, used at \$file line \$line.\n";
	}
    }
    eval "sub \$AUTOLOAD { \$val }";
    goto &\$AUTOLOAD;
}

END

print PM <<"END";
bootstrap $module;

# Preloaded methods go here.

# Autoload methods go after __END__, and are processed by the autosplit program.

1;
__END__
END

close PM;


warn "Writing ext/$modpname/$modfname.xs\n";

print XS <<"END";
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

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;


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'	=> '0.1',\n";
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";


system '/bin/ls > MANIFEST';


##############################################################################

	# These next few lines are legal in both Perl and nroff.

.00 ;			# finish .ig
 
'di			\" finish diversion--previous line must be blank
.nr nl 0-1		\" fake up transition to first page again
.nr % 0			\" start at page 1
'; __END__ ############# From here on it's a standard manual page ############
.TH H2XS 1 "August 9, 1994"
.AT 3
.SH NAME
h2xs \- convert .h C header files to Perl extensions
.SH SYNOPSIS
.B h2xs [-Aachfm] [-n module_name] [headerfile [extra_libraries]]
.SH 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.
.PP
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.
.PP
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 -L/another/library/path
in the extra-libraries argument.
.SH OPTIONS
.TP
.B \-n module_name
Specifies a name to be used for the extension, e.g., -n RPC::DCE
.TP
.B \-f
Allows an extension to be created for a header even if that header is
not found in /usr/include.
.TP
.B \-c
Omit constant() from the .xs file and corresponding specialised AUTOLOAD from
the .pm file.
.TP
.B \-A
Deprecated synonym for -c.
.SH EXAMPLES
.nf

	# 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

.fi
.SH ENVIRONMENT
No environment variables are used.
.SH AUTHOR
Larry Wall and others
.SH "SEE ALSO"
perl(1) ExtUtils::MakeMaker
.SH DIAGNOSTICS
The usual warnings if it can't read or write the files involved.
.ex
Commit	Line	Data
a0d0e21e LW	1	#!/usr/bin/perl
	2	'di ';
	3	'ds 00 \"';
	4	'ig 00 ';
	5
	6	use Getopt::Std;
	7
e1666bf5 TB	8	sub usage{
	9	warn "@_\n" if @_;
	10	die 'h2xs [-fnch] [-n module_name] [headerfile [extra_libraries]]
	11	-f Force creation of the extension even if the C header does not exist.
	12	-n Specify a name to use for the extension (recommended).
	13	-c Omit the constant() function and specialised AUTOLOAD from the XS file.
	14	-h Display this help message
	15	extra_libraries
	16	are any libraries that might be needed for loading the
	17	extension, e.g. -lm would try to link in the math library.
a0d0e21e	18	';
e1666bf5	19	}
a0d0e21e	20
a0d0e21e	21
e1666bf5	22	getopts("fhcAn:") \|\| usage;
a0d0e21e	23
e1666bf5 TB	24	usage if $opt_h;
e1666bf5 TB	25	$opt_c = 1 if $opt_A;
a0d0e21e	26
e1666bf5	27	$path_h = shift;
a0d0e21e	28	$extralibs = "@ARGV";
e1666bf5 TB	29
	30	usage "Must supply header file or module name\n"
	31	unless ($path_h or $opt_n);
	32
a0d0e21e LW	33
a0d0e21e LW	34	if( $path_h ){
e1666bf5 TB	35	$name = $path_h;
	36	if( $path_h =~ s#::#/#g && $opt_n ){
	37	warn "Nesting of headerfile ignored with -n\n";
	38	}
	39	$path_h .= ".h" unless $path_h =~ /\.h$/;
	40	$path_h = "/usr/include/$path_h" unless $path_h =~ m#^[./]#;
	41	die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
	42
	43	# Scan the header file (we should deal with nested header files)
	44	# Record the names of simple #define constants into const_names
	45	# Function prototypes are not (currently) processed.
	46	open(CH, "<$path_h") \|\| die "Can't open $path_h: $!\n";
	47	while (<CH>) {
	48	if (/^#[ \t]define\s+(\w+)\b\s[^("]/) {
	49	$_ = $1;
	50	next if /^_._h_$/i; # special case, but for what?
	51	$const_names{$_}++;
a0d0e21e	52	}
e1666bf5 TB	53	}
	54	close(CH);
	55	@const_names = sort keys %const_names;
a0d0e21e LW	56	}
a0d0e21e LW	57
e1666bf5	58
a0d0e21e LW	59	$module = $opt_n \|\| do {
	60	$name =~ s/\.h$//;
	61	if( $name !~ /::/ ){
	62	$name =~ s#^.*/##;
	63	$name = "\u$name";
	64	}
	65	$name;
	66	};
	67
	68	chdir 'ext' if -d 'ext';
	69
	70	if( $module =~ /::/ ){
	71	$nested = 1;
	72	@modparts = split(/::/,$module);
	73	$modfname = $modparts[-1];
	74	$modpname = join('/',@modparts);
	75	}
	76	else {
	77	$nested = 0;
	78	@modparts = ();
	79	$modfname = $modpname = $module;
	80	}
	81
	82
	83	die "Won't overwrite existing ext/$modpname\n" if -e $modpname;
	84	# quick hack, should really loop over @modparts
	85	mkdir($modparts[0], 0777) if $nested;
	86	mkdir($modpname, 0777);
	87	chdir($modpname) \|\| die "Can't chdir ext/$modpname: $!\n";
	88
	89	open(XS, ">$modfname.xs") \|\| die "Can't create ext/$modpname/$modfname.xs: $!\n";
	90	open(PM, ">$modfname.pm") \|\| die "Can't create ext/$modpname/$modfname.pm: $!\n";
	91
a0d0e21e LW	92	$" = "\n\t";
	93	warn "Writing ext/$modpname/$modfname.pm\n";
	94
a0d0e21e LW	95	print PM <<"END";
	96	package $module;
	97
	98	require Exporter;
	99	require AutoLoader;
	100	require DynaLoader;
e1666bf5	101
a0d0e21e	102	\@ISA = qw(Exporter AutoLoader DynaLoader);
e1666bf5 TB	103
	104	# Items to export into callers namespace by default. Note: do not export
	105	# names by default without a very good reason. Use EXPORT_OK instead.
	106	# Do not simply export all your public functions/methods/constants.
a0d0e21e	107	\@EXPORT = qw(
e1666bf5	108	@const_names
a0d0e21e LW	109	);
	110	# Other items we are prepared to export if requested
	111	\@EXPORT_OK = qw(
	112	);
	113
e1666bf5 TB	114	END
	115
	116	print PM <<"END" unless $opt_c;
a0d0e21e	117	sub AUTOLOAD {
e1666bf5 TB	118	# This AUTOLOAD function overrides the one inherited from AutoLoader.
	119	# It is used to 'autoload' constants from the constant() XS function.
	120
	121	# NOTE: THIS AUTOLOAD FUNCTION IS FLAWED (but is the best we can do for now).
	122	# Avoid old-style ``&CONST'' usage. Either remove the ``&'' or add ``()''.
	123	if (\@_ > 0) {
a0d0e21e LW	124	\$AutoLoader::AUTOLOAD = \$AUTOLOAD;
	125	goto &AutoLoader::AUTOLOAD;
	126	}
	127	local(\$constname);
	128	(\$constname = \$AUTOLOAD) =~ s/.*:://;
	129	\$val = constant(\$constname, \@_ ? \$_[0] : 0);
	130	if (\$! != 0) {
	131	if (\$! =~ /Invalid/) {
	132	\$AutoLoader::AUTOLOAD = \$AUTOLOAD;
	133	goto &AutoLoader::AUTOLOAD;
	134	}
	135	else {
	136	(\$pack,\$file,\$line) = caller;
	137	die "Your vendor has not defined $module macro \$constname, used at \$file line \$line.\n";
	138	}
	139	}
	140	eval "sub \$AUTOLOAD { \$val }";
	141	goto &\$AUTOLOAD;
	142	}
	143
a0d0e21e	144	END
a0d0e21e	145
e1666bf5 TB	146	print PM <<"END";
e1666bf5 TB	147	bootstrap $module;
a0d0e21e	148
e1666bf5	149	# Preloaded methods go here.
a0d0e21e	150
e1666bf5	151	# Autoload methods go after __END__, and are processed by the autosplit program.
a0d0e21e LW	152
a0d0e21e LW	153	1;
e1666bf5	154	__END__
a0d0e21e	155	END
a0d0e21e LW	156
	157	close PM;
	158
e1666bf5	159
a0d0e21e	160	warn "Writing ext/$modpname/$modfname.xs\n";
e1666bf5	161
a0d0e21e LW	162	print XS <<"END";
	163	#include "EXTERN.h"
	164	#include "perl.h"
	165	#include "XSUB.h"
	166
	167	END
	168	if( $path_h ){
	169	my($h) = $path_h;
	170	$h =~ s#^/usr/include/##;
	171	print XS <<"END";
	172	#include <$h>
	173
	174	END
	175	}
	176
	177	if( ! $opt_c ){
	178	print XS <<"END";
	179	static int
	180	not_here(s)
	181	char *s;
	182	{
	183	croak("$module::%s not implemented on this architecture", s);
	184	return -1;
	185	}
	186
	187	static double
	188	constant(name, arg)
	189	char *name;
	190	int arg;
	191	{
	192	errno = 0;
	193	switch (*name) {
	194	END
	195
e1666bf5 TB	196	my(@AZ, @az, @under);
	197
	198	foreach(@const_names){
	199	@AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
	200	@az = 'a' .. 'z' if !@az && /^[a-z]/;
	201	@under = '_' if !@under && /^_/;
	202	}
	203
a0d0e21e LW	204	foreach $letter (@AZ, @az, @under) {
a0d0e21e LW	205
e1666bf5	206	last if $letter eq 'a' && !@const_names;
a0d0e21e LW	207
	208	print XS " case '$letter':\n";
	209	my($name);
e1666bf5 TB	210	while (substr($const_names[0],0,1) eq $letter) {
e1666bf5 TB	211	$name = shift(@const_names);
a0d0e21e LW	212	print XS <<"END";
	213	if (strEQ(name, "$name"))
	214	#ifdef $name
	215	return $name;
	216	#else
	217	goto not_there;
	218	#endif
	219	END
	220	}
	221	print XS <<"END";
	222	break;
	223	END
	224	}
	225	print XS <<"END";
	226	}
	227	errno = EINVAL;
	228	return 0;
	229
	230	not_there:
	231	errno = ENOENT;
	232	return 0;
	233	}
	234
e1666bf5 TB	235	END
	236	}
	237
	238	# Now switch from C to XS by issuing the first MODULE declaration:
	239	print XS <<"END";
a0d0e21e LW	240
	241	MODULE = $module PACKAGE = $module
	242
e1666bf5 TB	243	END
	244
	245	# If a constant() function was written then output a corresponding
	246	# XS declaration:
	247	print XS <<"END" unless $opt_c;
	248
a0d0e21e LW	249	double
	250	constant(name,arg)
	251	char * name
	252	int arg
	253
	254	END
a0d0e21e LW	255
	256	close XS;
	257
e1666bf5	258
a0d0e21e LW	259	warn "Writing ext/$modpname/Makefile.PL\n";
	260	open(PL, ">Makefile.PL") \|\| die "Can't create ext/$modpname/Makefile.PL: $!\n";
	261
a0d0e21e LW	262	print PL <<'END';
	263	use ExtUtils::MakeMaker;
	264	# See lib/ExtUtils/MakeMaker.pm for details of how to influence
42793c05	265	# the contents of the Makefile that is written.
a0d0e21e	266	END
42793c05 TB	267	print PL "WriteMakefile(\n";
	268	print PL " 'NAME' => '$module',\n";
	269	print PL " 'VERSION' => '0.1',\n";
	270	print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n";
	271	print PL " 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' \n";
	272	print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n";
a0d0e21e	273	print PL ");\n";
e1666bf5	274
a0d0e21e	275
a0d0e21e LW	276	system '/bin/ls > MANIFEST';
a0d0e21e LW	277
a0d0e21e LW	278
	279	##############################################################################
	280
	281	# These next few lines are legal in both Perl and nroff.
	282
	283	.00 ; # finish .ig
	284
	285	'di \" finish diversion--previous line must be blank
	286	.nr nl 0-1 \" fake up transition to first page again
	287	.nr % 0 \" start at page 1
	288	'; __END__ ############# From here on it's a standard manual page ############
	289	.TH H2XS 1 "August 9, 1994"
	290	.AT 3
	291	.SH NAME
	292	h2xs \- convert .h C header files to Perl extensions
	293	.SH SYNOPSIS
	294	.B h2xs [-Aachfm] [-n module_name] [headerfile [extra_libraries]]
	295	.SH DESCRIPTION
	296	.I h2xs
	297	builds a Perl extension from any C header file. The extension will include
	298	functions which can be used to retrieve the value of any #define statement
	299	which was in the C header.
	300	.PP
	301	The
	302	.I module_name
	303	will be used for the name of the extension. If module_name is not supplied
	304	then the name of the header file will be used, with the first character
	305	capitalized.
	306	.PP
	307	If the extension might need extra libraries, they should be included
42793c05	308	here. The extension Makefile.PL will take care of checking whether
a0d0e21e LW	309	the libraries actually exist and how they should be loaded.
a0d0e21e LW	310	The extra libraries should be specified in the form -lm -lposix, etc,
42793c05	311	just as on the cc command line. By default, the Makefile.PL will
a0d0e21e LW	312	search through the library path determined by Configure. That path
	313	can be augmented by including arguments of the form -L/another/library/path
	314	in the extra-libraries argument.
	315	.SH OPTIONS
	316	.TP
e1666bf5 TB	317	.B \-n module_name
e1666bf5 TB	318	Specifies a name to be used for the extension, e.g., -n RPC::DCE
a0d0e21e	319	.TP
e1666bf5 TB	320	.B \-f
	321	Allows an extension to be created for a header even if that header is
	322	not found in /usr/include.
a0d0e21e LW	323	.TP
a0d0e21e LW	324	.B \-c
e1666bf5 TB	325	Omit constant() from the .xs file and corresponding specialised AUTOLOAD from
e1666bf5 TB	326	the .pm file.
a0d0e21e LW	327	.TP
a0d0e21e LW	328	.B \-A
e1666bf5	329	Deprecated synonym for -c.
a0d0e21e LW	330	.SH EXAMPLES
	331	.nf
	332
	333	# Default behavior, extension is Rusers
	334	h2xs rpcsvc/rusers
	335
	336	# Same, but extension is RUSERS
	337	h2xs -n RUSERS rpcsvc/rusers
	338
	339	# Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
	340	h2xs rpcsvc::rusers
	341
	342	# Extension is ONC::RPC. Still finds <rpcsvc/rusers.h>
	343	h2xs -n ONC::RPC rpcsvc/rusers
	344
e1666bf5 TB	345	# Without constant() or AUTOLOAD
e1666bf5 TB	346	h2xs -c rpcsvc/rusers
a0d0e21e LW	347
a0d0e21e LW	348	# Creates templates for an extension named RPC
e1666bf5	349	h2xs -cfn RPC
a0d0e21e LW	350
a0d0e21e LW	351	# Extension is ONC::RPC.
e1666bf5	352	h2xs -cfn ONC::RPC
a0d0e21e	353
42793c05	354	# Makefile.PL will look for library -lrpc in
a0d0e21e LW	355	# additional directory /opt/net/lib
	356	h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
	357
	358	.fi
	359	.SH ENVIRONMENT
	360	No environment variables are used.
	361	.SH AUTHOR
e1666bf5	362	Larry Wall and others
a0d0e21e	363	.SH "SEE ALSO"
42793c05	364	perl(1) ExtUtils::MakeMaker
a0d0e21e LW	365	.SH DIAGNOSTICS
	366	The usual warnings if it can't read or write the files involved.
	367	.ex