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