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