This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.002beta2 patch: toke.c
[perl5.git] / utils / h2xs.PL
CommitLineData
4633a7c4
LW
1#!/usr/local/bin/perl
2
3use Config;
4use 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.
15chdir(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
21open OUT,">$file" or die "Can't create $file: $!";
22
23print "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
28print OUT <<"!GROK!THIS!";
29$Config{'startperl'}
30 eval 'exec perl -S \$0 "\$@"'
31 if 0;
40000a8c
AD
32!GROK!THIS!
33
4633a7c4
LW
34# In the following, perl variables are not expanded during extraction.
35
36print OUT <<'!NO!SUBS!';
3edbfbe5
TB
37
38=head1 NAME
39
40h2xs - convert .h C header files to Perl extensions
41
42=head1 SYNOPSIS
43
f508c652
PP
44B<h2xs> [B<-APcf>] [B<-v> version] [B<-n> module_name] [headerfile [extra_libraries]]
45
46B<h2xs> B<-h>
3edbfbe5
TB
47
48=head1 DESCRIPTION
49
50I<h2xs> builds a Perl extension from any C header file. The extension will
51include functions which can be used to retrieve the value of any #define
52statement which was in the C header.
53
54The I<module_name> will be used for the name of the extension. If
55module_name is not supplied then the name of the header file will be used,
56with the first character capitalized.
57
58If the extension might need extra libraries, they should be included
59here. The extension Makefile.PL will take care of checking whether
60the libraries actually exist and how they should be loaded.
61The extra libraries should be specified in the form -lm -lposix, etc,
62just as on the cc command line. By default, the Makefile.PL will
63search through the library path determined by Configure. That path
64can be augmented by including arguments of the form B<-L/another/library/path>
65in the extra-libraries argument.
66
67=head1 OPTIONS
68
69=over 5
70
f508c652 71=item B<-A>
3edbfbe5 72
f508c652
PP
73Omit all autoload facilities. This is the same as B<-c> but also removes the
74S<C<require AutoLoader>> statement from the .pm file.
3edbfbe5 75
f508c652 76=item B<-P>
3edbfbe5 77
f508c652 78Omit the autogenerated stub POD section.
3edbfbe5
TB
79
80=item B<-c>
81
82Omit C<constant()> from the .xs file and corresponding specialised
83C<AUTOLOAD> from the .pm file.
84
f508c652 85=item B<-f>
3edbfbe5 86
f508c652
PP
87Allows an extension to be created for a header even if that header is
88not found in /usr/include.
89
90=item B<-h>
91
92Print the usage, help and version for this h2xs and exit.
93
94=item B<-n> I<module_name>
95
96Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
97
98=item B<-v> I<version>
99
100Specify a version number for this extension. This version number is added
101to the templates. The default is 0.01.
3edbfbe5
TB
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
136No environment variables are used.
137
138=head1 AUTHOR
139
140Larry Wall and others
141
142=head1 SEE ALSO
143
f508c652 144L<perl>, L<perlxstut>, L<ExtUtils::MakeMaker>, and L<AutoLoader>.
3edbfbe5
TB
145
146=head1 DIAGNOSTICS
147
148The usual warnings if it can't read or write the files involved.
149
150=cut
151
f508c652
PP
152my( $H2XS_VERSION ) = '$Revision: 1.12 $' =~ /\$Revision:\s+([^\s]+)/;
153my $TEMPLATE_VERSION = '0.01';
a0d0e21e
LW
154
155use Getopt::Std;
156
e1666bf5
TB
157sub usage{
158 warn "@_\n" if @_;
f508c652
PP
159 die "h2xs [-APcfh] [-v version] [-n module_name] [headerfile [extra_libraries]]
160version: $H2XS_VERSION
e1666bf5
TB
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
PP
165 -P Omit the stub POD section.
166 -v Specify a version number for this extension.
e1666bf5
TB
167 -h Display this help message
168extra_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 175getopts("APcfhv:n:") || usage;
a0d0e21e 176
e1666bf5 177usage if $opt_h;
f508c652
PP
178
179if( $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
TB
186
187usage "Must supply header file or module name\n"
188 unless ($path_h or $opt_n);
189
a0d0e21e
LW
190
191if( $path_h ){
e1666bf5
TB
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
TB
210 }
211 close(CH);
212 @const_names = sort keys %const_names;
a0d0e21e
LW
213}
214
e1666bf5 215
a0d0e21e
LW
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
LW
226
227if( $module =~ /::/ ){
228 $nested = 1;
229 @modparts = split(/::/,$module);
230 $modfname = $modparts[-1];
231 $modpname = join('/',@modparts);
232}
233else {
234 $nested = 0;
235 @modparts = ();
236 $modfname = $modpname = $module;
237}
238
239
8e07c86e 240die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
a0d0e21e
LW
241# quick hack, should really loop over @modparts
242mkdir($modparts[0], 0777) if $nested;
243mkdir($modpname, 0777);
8e07c86e 244chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
a0d0e21e 245
8e07c86e
AD
246open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
247open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
a0d0e21e 248
a0d0e21e 249$" = "\n\t";
8e07c86e 250warn "Writing $ext$modpname/$modfname.pm\n";
a0d0e21e 251
a0d0e21e
LW
252print PM <<"END";
253package $module;
254
255require Exporter;
a0d0e21e 256require DynaLoader;
3edbfbe5
TB
257END
258
259if( ! $opt_A ){
260 print PM <<"END";
261require AutoLoader;
262END
263}
264
265if( $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
TB
270END
271}
272else{
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);
279END
280}
e1666bf5 281
3edbfbe5 282print PM<<"END";
e1666bf5
TB
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
PP
289\$VERSION = '$TEMPLATE_VERSION';
290
e1666bf5
TB
291END
292
293print PM <<"END" unless $opt_c;
a0d0e21e 294sub AUTOLOAD {
3edbfbe5
TB
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
LW
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 316END
a0d0e21e 317
e1666bf5 318print PM <<"END";
f508c652 319bootstrap $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
LW
324
3251;
e1666bf5 326__END__
a0d0e21e 327END
a0d0e21e 328
f508c652
PP
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
361END
362
363$pod =~ s/^\#//gm unless $opt_P;
364print PM $pod unless $opt_P;
365
a0d0e21e
LW
366close PM;
367
e1666bf5 368
8e07c86e 369warn "Writing $ext$modpname/$modfname.xs\n";
e1666bf5 370
a0d0e21e 371print XS <<"END";
4633a7c4
LW
372#ifdef __cplusplus
373extern "C" {
374#endif
a0d0e21e
LW
375#include "EXTERN.h"
376#include "perl.h"
377#include "XSUB.h"
4633a7c4
LW
378#ifdef __cplusplus
379}
380#endif
a0d0e21e
LW
381
382END
383if( $path_h ){
384 my($h) = $path_h;
385 $h =~ s#^/usr/include/##;
386print XS <<"END";
387#include <$h>
388
389END
390}
391
392if( ! $opt_c ){
393print XS <<"END";
394static int
395not_here(s)
396char *s;
397{
398 croak("$module::%s not implemented on this architecture", s);
399 return -1;
400}
401
402static double
403constant(name, arg)
404char *name;
405int arg;
406{
407 errno = 0;
408 switch (*name) {
409END
410
e1666bf5
TB
411my(@AZ, @az, @under);
412
413foreach(@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
LW
419foreach $letter (@AZ, @az, @under) {
420
e1666bf5 421 last if $letter eq 'a' && !@const_names;
a0d0e21e
LW
422
423 print XS " case '$letter':\n";
424 my($name);
e1666bf5
TB
425 while (substr($const_names[0],0,1) eq $letter) {
426 $name = shift(@const_names);
a0d0e21e
LW
427 print XS <<"END";
428 if (strEQ(name, "$name"))
429#ifdef $name
430 return $name;
431#else
432 goto not_there;
433#endif
434END
435 }
436 print XS <<"END";
437 break;
438END
439}
440print XS <<"END";
441 }
442 errno = EINVAL;
443 return 0;
444
445not_there:
446 errno = ENOENT;
447 return 0;
448}
449
e1666bf5
TB
450END
451}
452
453# Now switch from C to XS by issuing the first MODULE declaration:
454print XS <<"END";
a0d0e21e
LW
455
456MODULE = $module PACKAGE = $module
457
e1666bf5
TB
458END
459
460# If a constant() function was written then output a corresponding
461# XS declaration:
462print XS <<"END" unless $opt_c;
463
a0d0e21e
LW
464double
465constant(name,arg)
466 char * name
467 int arg
468
469END
a0d0e21e
LW
470
471close XS;
472
e1666bf5 473
8e07c86e
AD
474warn "Writing $ext$modpname/Makefile.PL\n";
475open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
a0d0e21e 476
a0d0e21e
LW
477print PL <<'END';
478use 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 481END
42793c05
TB
482print PL "WriteMakefile(\n";
483print PL " 'NAME' => '$module',\n";
f508c652 484print PL " 'VERSION' => '$TEMPLATE_VERSION',\n";
42793c05
TB
485print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n";
486print PL " 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' \n";
487print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n";
a0d0e21e 488print PL ");\n";
f508c652
PP
489close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
490
491warn "Writing $ext$modpname/test.pl\n";
492open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\n";
493print 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
502BEGIN {print "1..1\n";}
503END {print "not ok 1\n" unless $loaded;}
504_END_
505print EX <<_END_;
506use $module;
507_END_
508print EX <<'_END_';
509$loaded = 1;
510print "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
PP
518_END_
519close(EX) || die "Can't close $ext$modpname/test.pl: $!\n";
a0d0e21e 520
4633a7c4 521system '/bin/ls > MANIFEST' or system 'ls > MANIFEST';
40000a8c 522!NO!SUBS!
4633a7c4
LW
523
524close OUT or die "Can't close $file: $!";
525chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
526exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';