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