This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
NETaa15204 patch problem
[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
c07a80fd 152my( $H2XS_VERSION ) = '$Revision: 1.14 $' =~ /\$Revision:\s+([^\s]+)/;
f508c652 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;
c07a80fd
PP
241if( $nested ){
242 $modpath = "";
243 foreach (@modparts){
244 mkdir("$modpath$_", 0777);
245 $modpath .= "$_/";
246 }
247}
a0d0e21e 248mkdir($modpname, 0777);
8e07c86e 249chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
a0d0e21e 250
8e07c86e
AD
251open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
252open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
a0d0e21e 253
a0d0e21e 254$" = "\n\t";
8e07c86e 255warn "Writing $ext$modpname/$modfname.pm\n";
a0d0e21e 256
a0d0e21e
LW
257print PM <<"END";
258package $module;
259
260require Exporter;
a0d0e21e 261require DynaLoader;
3edbfbe5
TB
262END
263
264if( ! $opt_A ){
265 print PM <<"END";
266require AutoLoader;
267END
268}
269
270if( $opt_c && ! $opt_A ){
271 # we won't have our own AUTOLOAD(), so we'll inherit it.
272 print PM <<"END";
e1666bf5 273
a0d0e21e 274\@ISA = qw(Exporter AutoLoader DynaLoader);
3edbfbe5
TB
275END
276}
277else{
278 # 1) we have our own AUTOLOAD(), so don't need to inherit it.
279 # or
280 # 2) we don't want autoloading mentioned.
281 print PM <<"END";
282
283\@ISA = qw(Exporter DynaLoader);
284END
285}
e1666bf5 286
3edbfbe5 287print PM<<"END";
e1666bf5
TB
288# Items to export into callers namespace by default. Note: do not export
289# names by default without a very good reason. Use EXPORT_OK instead.
290# Do not simply export all your public functions/methods/constants.
a0d0e21e 291\@EXPORT = qw(
e1666bf5 292 @const_names
a0d0e21e 293);
f508c652
PP
294\$VERSION = '$TEMPLATE_VERSION';
295
e1666bf5
TB
296END
297
298print PM <<"END" unless $opt_c;
a0d0e21e 299sub AUTOLOAD {
3edbfbe5
TB
300 # This AUTOLOAD is used to 'autoload' constants from the constant()
301 # XS function. If a constant is not found then control is passed
302 # to the AUTOLOAD in AutoLoader.
e1666bf5 303
a0d0e21e
LW
304 local(\$constname);
305 (\$constname = \$AUTOLOAD) =~ s/.*:://;
306 \$val = constant(\$constname, \@_ ? \$_[0] : 0);
307 if (\$! != 0) {
308 if (\$! =~ /Invalid/) {
309 \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
310 goto &AutoLoader::AUTOLOAD;
311 }
312 else {
313 (\$pack,\$file,\$line) = caller;
314 die "Your vendor has not defined $module macro \$constname, used at \$file line \$line.\n";
315 }
316 }
317 eval "sub \$AUTOLOAD { \$val }";
318 goto &\$AUTOLOAD;
319}
320
a0d0e21e 321END
a0d0e21e 322
e1666bf5 323print PM <<"END";
f508c652 324bootstrap $module \$VERSION;
a0d0e21e 325
e1666bf5 326# Preloaded methods go here.
a0d0e21e 327
e1666bf5 328# Autoload methods go after __END__, and are processed by the autosplit program.
a0d0e21e
LW
329
3301;
e1666bf5 331__END__
a0d0e21e 332END
a0d0e21e 333
f508c652
PP
334$author = "A. U. Thor";
335$email = 'a.u.thor@a.galaxy.far.far.away';
336
337$pod = <<"END" unless $opt_P;
338## Below is the stub of documentation for your module. You better edit it!
339#
340#=head1 NAME
341#
342#$module - Perl extension for blah blah blah
343#
344#=head1 SYNOPSIS
345#
346# use $module;
347# blah blah blah
348#
349#=head1 DESCRIPTION
350#
351#Stub documentation for $module was created by h2xs. It looks like the
352#author of the extension was negligent enough to leave the stub
353#unedited.
354#
355#Blah blah blah.
356#
357#=head1 AUTHOR
358#
359#$author, $email
360#
361#=head1 SEE ALSO
362#
363#perl(1).
364#
365#=cut
366END
367
368$pod =~ s/^\#//gm unless $opt_P;
369print PM $pod unless $opt_P;
370
a0d0e21e
LW
371close PM;
372
e1666bf5 373
8e07c86e 374warn "Writing $ext$modpname/$modfname.xs\n";
e1666bf5 375
a0d0e21e 376print XS <<"END";
4633a7c4
LW
377#ifdef __cplusplus
378extern "C" {
379#endif
a0d0e21e
LW
380#include "EXTERN.h"
381#include "perl.h"
382#include "XSUB.h"
4633a7c4
LW
383#ifdef __cplusplus
384}
385#endif
a0d0e21e
LW
386
387END
388if( $path_h ){
389 my($h) = $path_h;
390 $h =~ s#^/usr/include/##;
391print XS <<"END";
392#include <$h>
393
394END
395}
396
397if( ! $opt_c ){
398print XS <<"END";
399static int
400not_here(s)
401char *s;
402{
403 croak("$module::%s not implemented on this architecture", s);
404 return -1;
405}
406
407static double
408constant(name, arg)
409char *name;
410int arg;
411{
412 errno = 0;
413 switch (*name) {
414END
415
e1666bf5
TB
416my(@AZ, @az, @under);
417
418foreach(@const_names){
419 @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
420 @az = 'a' .. 'z' if !@az && /^[a-z]/;
421 @under = '_' if !@under && /^_/;
422}
423
a0d0e21e
LW
424foreach $letter (@AZ, @az, @under) {
425
e1666bf5 426 last if $letter eq 'a' && !@const_names;
a0d0e21e
LW
427
428 print XS " case '$letter':\n";
429 my($name);
e1666bf5
TB
430 while (substr($const_names[0],0,1) eq $letter) {
431 $name = shift(@const_names);
a0d0e21e
LW
432 print XS <<"END";
433 if (strEQ(name, "$name"))
434#ifdef $name
435 return $name;
436#else
437 goto not_there;
438#endif
439END
440 }
441 print XS <<"END";
442 break;
443END
444}
445print XS <<"END";
446 }
447 errno = EINVAL;
448 return 0;
449
450not_there:
451 errno = ENOENT;
452 return 0;
453}
454
e1666bf5
TB
455END
456}
457
458# Now switch from C to XS by issuing the first MODULE declaration:
459print XS <<"END";
a0d0e21e
LW
460
461MODULE = $module PACKAGE = $module
462
e1666bf5
TB
463END
464
465# If a constant() function was written then output a corresponding
466# XS declaration:
467print XS <<"END" unless $opt_c;
468
a0d0e21e
LW
469double
470constant(name,arg)
471 char * name
472 int arg
473
474END
a0d0e21e
LW
475
476close XS;
477
e1666bf5 478
8e07c86e
AD
479warn "Writing $ext$modpname/Makefile.PL\n";
480open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
a0d0e21e 481
a0d0e21e
LW
482print PL <<'END';
483use ExtUtils::MakeMaker;
484# See lib/ExtUtils/MakeMaker.pm for details of how to influence
42793c05 485# the contents of the Makefile that is written.
a0d0e21e 486END
42793c05
TB
487print PL "WriteMakefile(\n";
488print PL " 'NAME' => '$module',\n";
c07a80fd 489print PL " 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n";
42793c05
TB
490print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n";
491print PL " 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' \n";
492print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n";
a0d0e21e 493print PL ");\n";
f508c652
PP
494close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
495
496warn "Writing $ext$modpname/test.pl\n";
497open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\n";
498print EX <<'_END_';
499# Before `make install' is performed this script should be runnable with
500# `make test'. After `make install' it should work as `perl test.pl'
501
502######################### We start with some black magic to print on failure.
503
504# Change 1..1 below to 1..last_test_to_print .
505# (It may become useful if the test is moved to ./t subdirectory.)
506
507BEGIN {print "1..1\n";}
508END {print "not ok 1\n" unless $loaded;}
509_END_
510print EX <<_END_;
511use $module;
512_END_
513print EX <<'_END_';
514$loaded = 1;
515print "ok 1\n";
516
517######################### End of black magic.
518
519# Insert your test code below (better if it prints "ok 13"
520# (correspondingly "not ok 13") depending on the success of chunk 13
521# of the test code):
e1666bf5 522
f508c652
PP
523_END_
524close(EX) || die "Can't close $ext$modpname/test.pl: $!\n";
a0d0e21e 525
c07a80fd
PP
526warn "Writing $ext$modpname/Changes\n";
527open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n";
528print EX "Revision history for Perl extension $module.\n\n";
529print EX "$TEMPLATE_VERSION ",scalar localtime,"\n";
530print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n";
531close(EX) || die "Can't close $ext$modpname/Changes: $!\n";
532
533warn "Writing $ext$modpname/MANIFEST\n";
4633a7c4 534system '/bin/ls > MANIFEST' or system 'ls > MANIFEST';
40000a8c 535!NO!SUBS!
4633a7c4
LW
536
537close OUT or die "Can't close $file: $!";
538chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
539exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';