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