[p5sagit/p5-mst-13.2.git] / utils / h2xs.PL

#!/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 ($Config{'osname'} eq 'VMS' or
	    $Config{'osname'} 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<-APcf>] [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<-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.

=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.12 $' =~ /\$Revision:\s+([^\s]+)/;
my $TEMPLATE_VERSION = '0.01';

use Getopt::Std;

sub usage{
	warn "@_\n" if @_;
    die "h2xs [-APcfh] [-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).
    -P   Omit the stub POD section.
    -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("APcfhv: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;
}


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 DynaLoader;
END

if( ! $opt_A ){
	print PM <<"END";
require AutoLoader;
END
}

if( $opt_c && ! $opt_A ){
	# we won't have our own AUTOLOAD(), so we'll inherit it.
	print PM <<"END";

\@ISA = qw(Exporter AutoLoader DynaLoader);
END
}
else{
	# 1) we have our own AUTOLOAD(), so don't need to inherit it.
	# or
	# 2) we don't want autoloading mentioned.
	print PM <<"END";

\@ISA = qw(Exporter DynaLoader);
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;
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.

    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 \$VERSION;

# Preloaded methods go here.

# Autoload methods go after __END__, 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;


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;


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'	=> '$TEMPLATE_VERSION',\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";
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 {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";

system '/bin/ls > MANIFEST' or system 'ls > MANIFEST';
!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 ':';
Commit	Line	Data
4633a7c4	1	#!/usr/local/bin/perl
	2
	3	use Config;
	4	use File::Basename qw(&basename &dirname);
	5
	6	# List explicitly here the variables you want Configure to
	7	# generate. Metaconfig only looks for shell variables, so you
	8	# have to mention them as if they were shell variables, not
	9	# %Config entries. Thus you write
	10	# $startperl
	11	# to ensure Configure will look for $Config{startperl}.
	12
	13	# This forces PL files to create target in same directory as PL file.
	14	# This is so that make depend always knows where to find PL derivatives.
	15	chdir(dirname($0));
	16	($file = basename($0)) =~ s/\.PL$//;
	17	$file =~ s/\.pl$//
	18	if ($Config{'osname'} eq 'VMS' or
	19	$Config{'osname'} eq 'OS2'); # "case-forgiving"
	20
	21	open OUT,">$file" or die "Can't create $file: $!";
	22
	23	print "Extracting $file (with variable substitutions)\n";
	24
	25	# In this section, perl variables will be expanded during extraction.
	26	# You can use $Config{...} to use Configure variables.
	27
	28	print OUT <<"!GROK!THIS!";
	29	$Config{'startperl'}
	30	eval 'exec perl -S \$0 "\$@"'
	31	if 0;
40000a8c	32	!GROK!THIS!
40000a8c	33
4633a7c4	34	# In the following, perl variables are not expanded during extraction.
	35
	36	print OUT <<'!NO!SUBS!';
3edbfbe5	37
	38	=head1 NAME
	39
	40	h2xs - convert .h C header files to Perl extensions
	41
	42	=head1 SYNOPSIS
	43
f508c652	44	B<h2xs> [B<-APcf>] [B<-v> version] [B<-n> module_name] [headerfile [extra_libraries]]
	45
	46	B<h2xs> B<-h>
3edbfbe5	47
	48	=head1 DESCRIPTION
	49
	50	I<h2xs> builds a Perl extension from any C header file. The extension will
	51	include functions which can be used to retrieve the value of any #define
	52	statement which was in the C header.
	53
	54	The I<module_name> will be used for the name of the extension. If
	55	module_name is not supplied then the name of the header file will be used,
	56	with the first character capitalized.
	57
	58	If the extension might need extra libraries, they should be included
	59	here. The extension Makefile.PL will take care of checking whether
	60	the libraries actually exist and how they should be loaded.
	61	The extra libraries should be specified in the form -lm -lposix, etc,
	62	just as on the cc command line. By default, the Makefile.PL will
	63	search through the library path determined by Configure. That path
	64	can be augmented by including arguments of the form B<-L/another/library/path>
	65	in the extra-libraries argument.
	66
	67	=head1 OPTIONS
	68
	69	=over 5
	70
f508c652	71	=item B<-A>
3edbfbe5	72
f508c652	73	Omit all autoload facilities. This is the same as B<-c> but also removes the
f508c652	74	S<C<require AutoLoader>> statement from the .pm file.
3edbfbe5	75
f508c652	76	=item B<-P>
3edbfbe5	77
f508c652	78	Omit the autogenerated stub POD section.
3edbfbe5	79
	80	=item B<-c>
	81
	82	Omit C<constant()> from the .xs file and corresponding specialised
	83	C<AUTOLOAD> from the .pm file.
	84
f508c652	85	=item B<-f>
3edbfbe5	86
f508c652	87	Allows an extension to be created for a header even if that header is
	88	not found in /usr/include.
	89
	90	=item B<-h>
	91
	92	Print the usage, help and version for this h2xs and exit.
	93
	94	=item B<-n> I<module_name>
	95
	96	Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
	97
	98	=item B<-v> I<version>
	99
	100	Specify a version number for this extension. This version number is added
	101	to the templates. The default is 0.01.
3edbfbe5	102
	103	=back
	104
	105	=head1 EXAMPLES
	106
	107
	108	# Default behavior, extension is Rusers
	109	h2xs rpcsvc/rusers
	110
	111	# Same, but extension is RUSERS
	112	h2xs -n RUSERS rpcsvc/rusers
	113
	114	# Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
	115	h2xs rpcsvc::rusers
	116
	117	# Extension is ONC::RPC. Still finds <rpcsvc/rusers.h>
	118	h2xs -n ONC::RPC rpcsvc/rusers
	119
	120	# Without constant() or AUTOLOAD
	121	h2xs -c rpcsvc/rusers
	122
	123	# Creates templates for an extension named RPC
	124	h2xs -cfn RPC
	125
	126	# Extension is ONC::RPC.
	127	h2xs -cfn ONC::RPC
	128
	129	# Makefile.PL will look for library -lrpc in
	130	# additional directory /opt/net/lib
	131	h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
	132
	133
	134	=head1 ENVIRONMENT
	135
	136	No environment variables are used.
	137
	138	=head1 AUTHOR
	139
	140	Larry Wall and others
	141
	142	=head1 SEE ALSO
	143
f508c652	144	L<perl>, L<perlxstut>, L<ExtUtils::MakeMaker>, and L<AutoLoader>.
3edbfbe5	145
	146	=head1 DIAGNOSTICS
	147
	148	The usual warnings if it can't read or write the files involved.
	149
	150	=cut
	151
f508c652	152	my( $H2XS_VERSION ) = '$Revision: 1.12 $' =~ /\$Revision:\s+([^\s]+)/;
f508c652	153	my $TEMPLATE_VERSION = '0.01';
a0d0e21e	154
	155	use Getopt::Std;
	156
e1666bf5	157	sub usage{
e1666bf5	158	warn "@_\n" if @_;
f508c652	159	die "h2xs [-APcfh] [-v version] [-n module_name] [headerfile [extra_libraries]]
f508c652	160	version: $H2XS_VERSION
e1666bf5	161	-f Force creation of the extension even if the C header does not exist.
	162	-n Specify a name to use for the extension (recommended).
	163	-c Omit the constant() function and specialised AUTOLOAD from the XS file.
3edbfbe5	164	-A Omit all autoloading facilities (implies -c).
f508c652	165	-P Omit the stub POD section.
f508c652	166	-v Specify a version number for this extension.
e1666bf5	167	-h Display this help message
	168	extra_libraries
	169	are any libraries that might be needed for loading the
	170	extension, e.g. -lm would try to link in the math library.
f508c652	171	";
e1666bf5	172	}
a0d0e21e	173
a0d0e21e	174
f508c652	175	getopts("APcfhv:n:") \|\| usage;
a0d0e21e	176
e1666bf5	177	usage if $opt_h;
f508c652	178
	179	if( $opt_v ){
	180	$TEMPLATE_VERSION = $opt_v;
	181	}
e1666bf5	182	$opt_c = 1 if $opt_A;
a0d0e21e	183
e1666bf5	184	$path_h = shift;
a0d0e21e	185	$extralibs = "@ARGV";
e1666bf5	186
	187	usage "Must supply header file or module name\n"
	188	unless ($path_h or $opt_n);
	189
a0d0e21e	190
a0d0e21e	191	if( $path_h ){
e1666bf5	192	$name = $path_h;
	193	if( $path_h =~ s#::#/#g && $opt_n ){
	194	warn "Nesting of headerfile ignored with -n\n";
	195	}
	196	$path_h .= ".h" unless $path_h =~ /\.h$/;
	197	$path_h = "/usr/include/$path_h" unless $path_h =~ m#^[./]#;
	198	die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
	199
	200	# Scan the header file (we should deal with nested header files)
	201	# Record the names of simple #define constants into const_names
	202	# Function prototypes are not (currently) processed.
	203	open(CH, "<$path_h") \|\| die "Can't open $path_h: $!\n";
	204	while (<CH>) {
	205	if (/^#[ \t]define\s+(\w+)\b\s[^("]/) {
	206	$_ = $1;
	207	next if /^_._h_$/i; # special case, but for what?
	208	$const_names{$_}++;
a0d0e21e	209	}
e1666bf5	210	}
	211	close(CH);
	212	@const_names = sort keys %const_names;
a0d0e21e	213	}
a0d0e21e	214
e1666bf5	215
a0d0e21e	216	$module = $opt_n \|\| do {
	217	$name =~ s/\.h$//;
	218	if( $name !~ /::/ ){
	219	$name =~ s#^.*/##;
	220	$name = "\u$name";
	221	}
	222	$name;
	223	};
	224
8e07c86e	225	(chdir 'ext', $ext = 'ext/') if -d 'ext';
a0d0e21e	226
	227	if( $module =~ /::/ ){
	228	$nested = 1;
	229	@modparts = split(/::/,$module);
	230	$modfname = $modparts[-1];
	231	$modpname = join('/',@modparts);
	232	}
	233	else {
	234	$nested = 0;
	235	@modparts = ();
	236	$modfname = $modpname = $module;
	237	}
	238
	239
8e07c86e	240	die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
a0d0e21e	241	# quick hack, should really loop over @modparts
	242	mkdir($modparts[0], 0777) if $nested;
	243	mkdir($modpname, 0777);
8e07c86e	244	chdir($modpname) \|\| die "Can't chdir $ext$modpname: $!\n";
a0d0e21e	245
8e07c86e	246	open(XS, ">$modfname.xs") \|\| die "Can't create $ext$modpname/$modfname.xs: $!\n";
8e07c86e	247	open(PM, ">$modfname.pm") \|\| die "Can't create $ext$modpname/$modfname.pm: $!\n";
a0d0e21e	248
a0d0e21e	249	$" = "\n\t";
8e07c86e	250	warn "Writing $ext$modpname/$modfname.pm\n";
a0d0e21e	251
a0d0e21e	252	print PM <<"END";
	253	package $module;
	254
	255	require Exporter;
a0d0e21e	256	require DynaLoader;
3edbfbe5	257	END
	258
	259	if( ! $opt_A ){
	260	print PM <<"END";
	261	require AutoLoader;
	262	END
	263	}
	264
	265	if( $opt_c && ! $opt_A ){
	266	# we won't have our own AUTOLOAD(), so we'll inherit it.
	267	print PM <<"END";
e1666bf5	268
a0d0e21e	269	\@ISA = qw(Exporter AutoLoader DynaLoader);
3edbfbe5	270	END
	271	}
	272	else{
	273	# 1) we have our own AUTOLOAD(), so don't need to inherit it.
	274	# or
	275	# 2) we don't want autoloading mentioned.
	276	print PM <<"END";
	277
	278	\@ISA = qw(Exporter DynaLoader);
	279	END
	280	}
e1666bf5	281
3edbfbe5	282	print PM<<"END";
e1666bf5	283	# Items to export into callers namespace by default. Note: do not export
	284	# names by default without a very good reason. Use EXPORT_OK instead.
	285	# Do not simply export all your public functions/methods/constants.
a0d0e21e	286	\@EXPORT = qw(
e1666bf5	287	@const_names
a0d0e21e	288	);
f508c652	289	\$VERSION = '$TEMPLATE_VERSION';
f508c652	290
e1666bf5	291	END
	292
	293	print PM <<"END" unless $opt_c;
a0d0e21e	294	sub AUTOLOAD {
3edbfbe5	295	# This AUTOLOAD is used to 'autoload' constants from the constant()
	296	# XS function. If a constant is not found then control is passed
	297	# to the AUTOLOAD in AutoLoader.
e1666bf5	298
a0d0e21e	299	local(\$constname);
	300	(\$constname = \$AUTOLOAD) =~ s/.*:://;
	301	\$val = constant(\$constname, \@_ ? \$_[0] : 0);
	302	if (\$! != 0) {
	303	if (\$! =~ /Invalid/) {
	304	\$AutoLoader::AUTOLOAD = \$AUTOLOAD;
	305	goto &AutoLoader::AUTOLOAD;
	306	}
	307	else {
	308	(\$pack,\$file,\$line) = caller;
	309	die "Your vendor has not defined $module macro \$constname, used at \$file line \$line.\n";
	310	}
	311	}
	312	eval "sub \$AUTOLOAD { \$val }";
	313	goto &\$AUTOLOAD;
	314	}
	315
a0d0e21e	316	END
a0d0e21e	317
e1666bf5	318	print PM <<"END";
f508c652	319	bootstrap $module \$VERSION;
a0d0e21e	320
e1666bf5	321	# Preloaded methods go here.
a0d0e21e	322
e1666bf5	323	# Autoload methods go after __END__, and are processed by the autosplit program.
a0d0e21e	324
a0d0e21e	325	1;
e1666bf5	326	__END__
a0d0e21e	327	END
a0d0e21e	328
f508c652	329	$author = "A. U. Thor";
	330	$email = 'a.u.thor@a.galaxy.far.far.away';
	331
	332	$pod = <<"END" unless $opt_P;
	333	## Below is the stub of documentation for your module. You better edit it!
	334	#
	335	#=head1 NAME
	336	#
	337	#$module - Perl extension for blah blah blah
	338	#
	339	#=head1 SYNOPSIS
	340	#
	341	# use $module;
	342	# blah blah blah
	343	#
	344	#=head1 DESCRIPTION
	345	#
	346	#Stub documentation for $module was created by h2xs. It looks like the
	347	#author of the extension was negligent enough to leave the stub
	348	#unedited.
	349	#
	350	#Blah blah blah.
	351	#
	352	#=head1 AUTHOR
	353	#
	354	#$author, $email
	355	#
	356	#=head1 SEE ALSO
	357	#
	358	#perl(1).
	359	#
	360	#=cut
	361	END
	362
	363	$pod =~ s/^\#//gm unless $opt_P;
	364	print PM $pod unless $opt_P;
	365
a0d0e21e	366	close PM;
a0d0e21e	367
e1666bf5	368
8e07c86e	369	warn "Writing $ext$modpname/$modfname.xs\n";
e1666bf5	370
a0d0e21e	371	print XS <<"END";
4633a7c4	372	#ifdef __cplusplus
	373	extern "C" {
	374	#endif
a0d0e21e	375	#include "EXTERN.h"
	376	#include "perl.h"
	377	#include "XSUB.h"
4633a7c4	378	#ifdef __cplusplus
	379	}
	380	#endif
a0d0e21e	381
	382	END
	383	if( $path_h ){
	384	my($h) = $path_h;
	385	$h =~ s#^/usr/include/##;
	386	print XS <<"END";
	387	#include <$h>
	388
	389	END
	390	}
	391
	392	if( ! $opt_c ){
	393	print XS <<"END";
	394	static int
	395	not_here(s)
	396	char *s;
	397	{
	398	croak("$module::%s not implemented on this architecture", s);
	399	return -1;
	400	}
	401
	402	static double
	403	constant(name, arg)
	404	char *name;
	405	int arg;
	406	{
	407	errno = 0;
	408	switch (*name) {
	409	END
	410
e1666bf5	411	my(@AZ, @az, @under);
	412
	413	foreach(@const_names){
	414	@AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
	415	@az = 'a' .. 'z' if !@az && /^[a-z]/;
	416	@under = '_' if !@under && /^_/;
	417	}
	418
a0d0e21e	419	foreach $letter (@AZ, @az, @under) {
a0d0e21e	420
e1666bf5	421	last if $letter eq 'a' && !@const_names;
a0d0e21e	422
	423	print XS " case '$letter':\n";
	424	my($name);
e1666bf5	425	while (substr($const_names[0],0,1) eq $letter) {
e1666bf5	426	$name = shift(@const_names);
a0d0e21e	427	print XS <<"END";
	428	if (strEQ(name, "$name"))
	429	#ifdef $name
	430	return $name;
	431	#else
	432	goto not_there;
	433	#endif
	434	END
	435	}
	436	print XS <<"END";
	437	break;
	438	END
	439	}
	440	print XS <<"END";
	441	}
	442	errno = EINVAL;
	443	return 0;
	444
	445	not_there:
	446	errno = ENOENT;
	447	return 0;
	448	}
	449
e1666bf5	450	END
	451	}
	452
	453	# Now switch from C to XS by issuing the first MODULE declaration:
	454	print XS <<"END";
a0d0e21e	455
	456	MODULE = $module PACKAGE = $module
	457
e1666bf5	458	END
	459
	460	# If a constant() function was written then output a corresponding
	461	# XS declaration:
	462	print XS <<"END" unless $opt_c;
	463
a0d0e21e	464	double
	465	constant(name,arg)
	466	char * name
	467	int arg
	468
	469	END
a0d0e21e	470
	471	close XS;
	472
e1666bf5	473
8e07c86e	474	warn "Writing $ext$modpname/Makefile.PL\n";
8e07c86e	475	open(PL, ">Makefile.PL") \|\| die "Can't create $ext$modpname/Makefile.PL: $!\n";
a0d0e21e	476
a0d0e21e	477	print PL <<'END';
	478	use ExtUtils::MakeMaker;
	479	# See lib/ExtUtils/MakeMaker.pm for details of how to influence
42793c05	480	# the contents of the Makefile that is written.
a0d0e21e	481	END
42793c05	482	print PL "WriteMakefile(\n";
42793c05	483	print PL " 'NAME' => '$module',\n";
f508c652	484	print PL " 'VERSION' => '$TEMPLATE_VERSION',\n";
42793c05	485	print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n";
	486	print PL " 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' \n";
	487	print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n";
a0d0e21e	488	print PL ");\n";
f508c652	489	close(PL) \|\| die "Can't close $ext$modpname/Makefile.PL: $!\n";
	490
	491	warn "Writing $ext$modpname/test.pl\n";
	492	open(EX, ">test.pl") \|\| die "Can't create $ext$modpname/test.pl: $!\n";
	493	print EX <<'_END_';
	494	# Before `make install' is performed this script should be runnable with
	495	# `make test'. After `make install' it should work as `perl test.pl'
	496
	497	######################### We start with some black magic to print on failure.
	498
	499	# Change 1..1 below to 1..last_test_to_print .
	500	# (It may become useful if the test is moved to ./t subdirectory.)
	501
	502	BEGIN {print "1..1\n";}
	503	END {print "not ok 1\n" unless $loaded;}
	504	_END_
	505	print EX <<_END_;
	506	use $module;
	507	_END_
	508	print EX <<'_END_';
	509	$loaded = 1;
	510	print "ok 1\n";
	511
	512	######################### End of black magic.
	513
	514	# Insert your test code below (better if it prints "ok 13"
	515	# (correspondingly "not ok 13") depending on the success of chunk 13
	516	# of the test code):
e1666bf5	517
f508c652	518	_END_
f508c652	519	close(EX) \|\| die "Can't close $ext$modpname/test.pl: $!\n";
a0d0e21e	520
4633a7c4	521	system '/bin/ls > MANIFEST' or system 'ls > MANIFEST';
40000a8c	522	!NO!SUBS!
4633a7c4	523
	524	close OUT or die "Can't close $file: $!";
	525	chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
	526	exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';