b7bf49654d2b2b66ef611e1d45b1c8ca9027cab1
[perl.git] / utils / h2xs.PL
1 #!/usr/local/bin/perl
2
3 use Config;
4 use 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.
15 chdir(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
21 open OUT,">$file" or die "Can't create $file: $!";
22
23 print "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
28 print OUT <<"!GROK!THIS!";
29 $Config{'startperl'}
30     eval 'exec perl -S \$0 "\$@"'
31         if 0;
32 !GROK!THIS!
33
34 # In the following, perl variables are not expanded during extraction.
35
36 print OUT <<'!NO!SUBS!';
37
38 =head1 NAME
39
40 h2xs - convert .h C header files to Perl extensions
41
42 =head1 SYNOPSIS
43
44 B<h2xs> [B<-Acfh>] [B<-n> module_name] [headerfile [extra_libraries]]
45
46 =head1 DESCRIPTION
47
48 I<h2xs> builds a Perl extension from any C header file.  The extension will
49 include functions which can be used to retrieve the value of any #define
50 statement which was in the C header.
51
52 The I<module_name> will be used for the name of the extension.  If
53 module_name is not supplied then the name of the header file will be used,
54 with the first character capitalized.
55
56 If the extension might need extra libraries, they should be included
57 here.  The extension Makefile.PL will take care of checking whether
58 the libraries actually exist and how they should be loaded.
59 The extra libraries should be specified in the form -lm -lposix, etc,
60 just as on the cc command line.  By default, the Makefile.PL will
61 search through the library path determined by Configure.  That path
62 can be augmented by including arguments of the form B<-L/another/library/path>
63 in the extra-libraries argument.
64
65 =head1 OPTIONS
66
67 =over 5
68
69 =item B<-n> I<module_name>
70
71 Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
72
73 =item B<-f>
74
75 Allows an extension to be created for a header even if that header is
76 not found in /usr/include.
77
78 =item B<-c>
79
80 Omit C<constant()> from the .xs file and corresponding specialised
81 C<AUTOLOAD> from the .pm file.
82
83 =item B<-A>
84
85 Omit all autoload facilities.  This is the same as B<-c> but also removes the
86 S<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
121 No environment variables are used.
122
123 =head1 AUTHOR
124
125 Larry Wall and others
126
127 =head1 SEE ALSO
128
129 L<perl>, L<ExtUtils::MakeMaker>, L<AutoLoader>
130
131 =head1 DIAGNOSTICS
132
133 The usual warnings if it can't read or write the files involved.
134
135 =cut
136
137
138 use Getopt::Std;
139
140 sub usage{
141         warn "@_\n" if @_;
142     die 'h2xs [-Acfh] [-n module_name] [headerfile [extra_libraries]]
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.
146     -A   Omit all autoloading facilities (implies -c).
147     -h   Display this help message
148 extra_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.
151 ';
152 }
153
154
155 getopts("Acfhn:") || usage;
156
157 usage if $opt_h;
158 $opt_c = 1 if $opt_A;
159
160 $path_h    = shift;
161 $extralibs = "@ARGV";
162
163 usage "Must supply header file or module name\n"
164         unless ($path_h or $opt_n);
165
166
167 if( $path_h ){
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{$_}++;
185         }
186     }
187     close(CH);
188     @const_names = sort keys %const_names;
189 }
190
191
192 $module = $opt_n || do {
193         $name =~ s/\.h$//;
194         if( $name !~ /::/ ){
195                 $name =~ s#^.*/##;
196                 $name = "\u$name";
197         }
198         $name;
199 };
200
201 (chdir 'ext', $ext = 'ext/') if -d 'ext';
202
203 if( $module =~ /::/ ){
204         $nested = 1;
205         @modparts = split(/::/,$module);
206         $modfname = $modparts[-1];
207         $modpname = join('/',@modparts);
208 }
209 else {
210         $nested = 0;
211         @modparts = ();
212         $modfname = $modpname = $module;
213 }
214
215
216 die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
217 # quick hack, should really loop over @modparts
218 mkdir($modparts[0], 0777) if $nested;
219 mkdir($modpname, 0777);
220 chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
221
222 open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
223 open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
224
225 $" = "\n\t";
226 warn "Writing $ext$modpname/$modfname.pm\n";
227
228 print PM <<"END";
229 package $module;
230
231 require Exporter;
232 require DynaLoader;
233 END
234
235 if( ! $opt_A ){
236         print PM <<"END";
237 require AutoLoader;
238 END
239 }
240
241 if( $opt_c && ! $opt_A ){
242         # we won't have our own AUTOLOAD(), so we'll inherit it.
243         print PM <<"END";
244
245 \@ISA = qw(Exporter AutoLoader DynaLoader);
246 END
247 }
248 else{
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);
255 END
256 }
257
258 print PM<<"END";
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.
262 \@EXPORT = qw(
263         @const_names
264 );
265 END
266
267 print PM <<"END" unless $opt_c;
268 sub AUTOLOAD {
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.
272
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
290 END
291
292 print PM <<"END";
293 bootstrap $module;
294
295 # Preloaded methods go here.
296
297 # Autoload methods go after __END__, and are processed by the autosplit program.
298
299 1;
300 __END__
301 END
302
303 close PM;
304
305
306 warn "Writing $ext$modpname/$modfname.xs\n";
307
308 print XS <<"END";
309 #ifdef __cplusplus
310 extern "C" {
311 #endif
312 #include "EXTERN.h"
313 #include "perl.h"
314 #include "XSUB.h"
315 #ifdef __cplusplus
316 }
317 #endif
318
319 END
320 if( $path_h ){
321         my($h) = $path_h;
322         $h =~ s#^/usr/include/##;
323 print XS <<"END";
324 #include <$h>
325
326 END
327 }
328
329 if( ! $opt_c ){
330 print XS <<"END";
331 static int
332 not_here(s)
333 char *s;
334 {
335     croak("$module::%s not implemented on this architecture", s);
336     return -1;
337 }
338
339 static double
340 constant(name, arg)
341 char *name;
342 int arg;
343 {
344     errno = 0;
345     switch (*name) {
346 END
347
348 my(@AZ, @az, @under);
349
350 foreach(@const_names){
351     @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
352     @az = 'a' .. 'z' if !@az && /^[a-z]/;
353     @under = '_'  if !@under && /^_/;
354 }
355
356 foreach $letter (@AZ, @az, @under) {
357
358     last if $letter eq 'a' && !@const_names;
359
360     print XS "    case '$letter':\n";
361     my($name);
362     while (substr($const_names[0],0,1) eq $letter) {
363         $name = shift(@const_names);
364         print XS <<"END";
365         if (strEQ(name, "$name"))
366 #ifdef $name
367             return $name;
368 #else
369             goto not_there;
370 #endif
371 END
372     }
373     print XS <<"END";
374         break;
375 END
376 }
377 print XS <<"END";
378     }
379     errno = EINVAL;
380     return 0;
381
382 not_there:
383     errno = ENOENT;
384     return 0;
385 }
386
387 END
388 }
389
390 # Now switch from C to XS by issuing the first MODULE declaration:
391 print XS <<"END";
392
393 MODULE = $module                PACKAGE = $module
394
395 END
396
397 # If a constant() function was written then output a corresponding
398 # XS declaration:
399 print XS <<"END" unless $opt_c;
400
401 double
402 constant(name,arg)
403         char *          name
404         int             arg
405
406 END
407
408 close XS;
409
410
411 warn "Writing $ext$modpname/Makefile.PL\n";
412 open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
413
414 print PL <<'END';
415 use ExtUtils::MakeMaker;
416 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
417 # the contents of the Makefile that is written.
418 END
419 print PL "WriteMakefile(\n";
420 print PL "    'NAME'    => '$module',\n";
421 print PL "    'VERSION' => '0.1',\n";
422 print PL "    'LIBS'    => ['$extralibs'],   # e.g., '-lm' \n";
423 print PL "    'DEFINE'  => '',     # e.g., '-DHAVE_SOMETHING' \n";
424 print PL "    'INC'     => '',     # e.g., '-I/usr/include/other' \n";
425 print PL ");\n";
426
427
428 system '/bin/ls > MANIFEST' or system 'ls > MANIFEST';
429 !NO!SUBS!
430
431 close OUT or die "Can't close $file: $!";
432 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
433 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';