perl5.002beta3
[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<-APcf>] [B<-v> version] [B<-n> module_name] [headerfile [extra_libraries]]
45
46 B<h2xs> B<-h>
47
48 =head1 DESCRIPTION
49
50 I<h2xs> builds a Perl extension from any C header file.  The extension will
51 include functions which can be used to retrieve the value of any #define
52 statement which was in the C header.
53
54 The I<module_name> will be used for the name of the extension.  If
55 module_name is not supplied then the name of the header file will be used,
56 with the first character capitalized.
57
58 If the extension might need extra libraries, they should be included
59 here.  The extension Makefile.PL will take care of checking whether
60 the libraries actually exist and how they should be loaded.
61 The extra libraries should be specified in the form -lm -lposix, etc,
62 just as on the cc command line.  By default, the Makefile.PL will
63 search through the library path determined by Configure.  That path
64 can be augmented by including arguments of the form B<-L/another/library/path>
65 in the extra-libraries argument.
66
67 =head1 OPTIONS
68
69 =over 5
70
71 =item B<-A>
72
73 Omit all autoload facilities.  This is the same as B<-c> but also removes the
74 S<C<require AutoLoader>> statement from the .pm file.
75
76 =item B<-P>
77
78 Omit the autogenerated stub POD section. 
79
80 =item B<-c>
81
82 Omit C<constant()> from the .xs file and corresponding specialised
83 C<AUTOLOAD> from the .pm file.
84
85 =item B<-f>
86
87 Allows an extension to be created for a header even if that header is
88 not found in /usr/include.
89
90 =item B<-h>
91
92 Print the usage, help and version for this h2xs and exit.
93
94 =item B<-n> I<module_name>
95
96 Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
97
98 =item B<-v> I<version>
99
100 Specify a version number for this extension.  This version number is added
101 to the templates.  The default is 0.01.
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
136 No environment variables are used.
137
138 =head1 AUTHOR
139
140 Larry Wall and others
141
142 =head1 SEE ALSO
143
144 L<perl>, L<perlxstut>, L<ExtUtils::MakeMaker>, and L<AutoLoader>.
145
146 =head1 DIAGNOSTICS
147
148 The usual warnings if it can't read or write the files involved.
149
150 =cut
151
152 my( $H2XS_VERSION ) = '$Revision: 1.14 $' =~ /\$Revision:\s+([^\s]+)/;
153 my $TEMPLATE_VERSION = '0.01';
154
155 use Getopt::Std;
156
157 sub usage{
158         warn "@_\n" if @_;
159     die "h2xs [-APcfh] [-v version] [-n module_name] [headerfile [extra_libraries]]
160 version: $H2XS_VERSION
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.
164     -A   Omit all autoloading facilities (implies -c).
165     -P   Omit the stub POD section.
166     -v   Specify a version number for this extension.
167     -h   Display this help message
168 extra_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.
171 ";
172 }
173
174
175 getopts("APcfhv:n:") || usage;
176
177 usage if $opt_h;
178
179 if( $opt_v ){
180         $TEMPLATE_VERSION = $opt_v;
181 }
182 $opt_c = 1 if $opt_A;
183
184 $path_h    = shift;
185 $extralibs = "@ARGV";
186
187 usage "Must supply header file or module name\n"
188         unless ($path_h or $opt_n);
189
190
191 if( $path_h ){
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{$_}++;
209         }
210     }
211     close(CH);
212     @const_names = sort keys %const_names;
213 }
214
215
216 $module = $opt_n || do {
217         $name =~ s/\.h$//;
218         if( $name !~ /::/ ){
219                 $name =~ s#^.*/##;
220                 $name = "\u$name";
221         }
222         $name;
223 };
224
225 (chdir 'ext', $ext = 'ext/') if -d 'ext';
226
227 if( $module =~ /::/ ){
228         $nested = 1;
229         @modparts = split(/::/,$module);
230         $modfname = $modparts[-1];
231         $modpname = join('/',@modparts);
232 }
233 else {
234         $nested = 0;
235         @modparts = ();
236         $modfname = $modpname = $module;
237 }
238
239
240 die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
241 if( $nested ){
242         $modpath = "";
243         foreach (@modparts){
244                 mkdir("$modpath$_", 0777);
245                 $modpath .= "$_/";
246         }
247 }
248 mkdir($modpname, 0777);
249 chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
250
251 open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
252 open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
253
254 $" = "\n\t";
255 warn "Writing $ext$modpname/$modfname.pm\n";
256
257 print PM <<"END";
258 package $module;
259
260 require Exporter;
261 require DynaLoader;
262 END
263
264 if( ! $opt_A ){
265         print PM <<"END";
266 require AutoLoader;
267 END
268 }
269
270 if( $opt_c && ! $opt_A ){
271         # we won't have our own AUTOLOAD(), so we'll inherit it.
272         print PM <<"END";
273
274 \@ISA = qw(Exporter AutoLoader DynaLoader);
275 END
276 }
277 else{
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);
284 END
285 }
286
287 print PM<<"END";
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.
291 \@EXPORT = qw(
292         @const_names
293 );
294 \$VERSION = '$TEMPLATE_VERSION';
295
296 END
297
298 print PM <<"END" unless $opt_c;
299 sub AUTOLOAD {
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.
303
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
321 END
322
323 print PM <<"END";
324 bootstrap $module \$VERSION;
325
326 # Preloaded methods go here.
327
328 # Autoload methods go after __END__, and are processed by the autosplit program.
329
330 1;
331 __END__
332 END
333
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
366 END
367
368 $pod =~ s/^\#//gm unless $opt_P;
369 print PM $pod unless $opt_P;
370
371 close PM;
372
373
374 warn "Writing $ext$modpname/$modfname.xs\n";
375
376 print XS <<"END";
377 #ifdef __cplusplus
378 extern "C" {
379 #endif
380 #include "EXTERN.h"
381 #include "perl.h"
382 #include "XSUB.h"
383 #ifdef __cplusplus
384 }
385 #endif
386
387 END
388 if( $path_h ){
389         my($h) = $path_h;
390         $h =~ s#^/usr/include/##;
391 print XS <<"END";
392 #include <$h>
393
394 END
395 }
396
397 if( ! $opt_c ){
398 print XS <<"END";
399 static int
400 not_here(s)
401 char *s;
402 {
403     croak("$module::%s not implemented on this architecture", s);
404     return -1;
405 }
406
407 static double
408 constant(name, arg)
409 char *name;
410 int arg;
411 {
412     errno = 0;
413     switch (*name) {
414 END
415
416 my(@AZ, @az, @under);
417
418 foreach(@const_names){
419     @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
420     @az = 'a' .. 'z' if !@az && /^[a-z]/;
421     @under = '_'  if !@under && /^_/;
422 }
423
424 foreach $letter (@AZ, @az, @under) {
425
426     last if $letter eq 'a' && !@const_names;
427
428     print XS "    case '$letter':\n";
429     my($name);
430     while (substr($const_names[0],0,1) eq $letter) {
431         $name = shift(@const_names);
432         print XS <<"END";
433         if (strEQ(name, "$name"))
434 #ifdef $name
435             return $name;
436 #else
437             goto not_there;
438 #endif
439 END
440     }
441     print XS <<"END";
442         break;
443 END
444 }
445 print XS <<"END";
446     }
447     errno = EINVAL;
448     return 0;
449
450 not_there:
451     errno = ENOENT;
452     return 0;
453 }
454
455 END
456 }
457
458 # Now switch from C to XS by issuing the first MODULE declaration:
459 print XS <<"END";
460
461 MODULE = $module                PACKAGE = $module
462
463 END
464
465 # If a constant() function was written then output a corresponding
466 # XS declaration:
467 print XS <<"END" unless $opt_c;
468
469 double
470 constant(name,arg)
471         char *          name
472         int             arg
473
474 END
475
476 close XS;
477
478
479 warn "Writing $ext$modpname/Makefile.PL\n";
480 open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
481
482 print PL <<'END';
483 use ExtUtils::MakeMaker;
484 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
485 # the contents of the Makefile that is written.
486 END
487 print PL "WriteMakefile(\n";
488 print PL "    'NAME'    => '$module',\n";
489 print PL "    'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n"; 
490 print PL "    'LIBS'    => ['$extralibs'],   # e.g., '-lm' \n";
491 print PL "    'DEFINE'  => '',     # e.g., '-DHAVE_SOMETHING' \n";
492 print PL "    'INC'     => '',     # e.g., '-I/usr/include/other' \n";
493 print PL ");\n";
494 close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
495
496 warn "Writing $ext$modpname/test.pl\n";
497 open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\n";
498 print 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
507 BEGIN {print "1..1\n";}
508 END {print "not ok 1\n" unless $loaded;}
509 _END_
510 print EX <<_END_;
511 use $module;
512 _END_
513 print EX <<'_END_';
514 $loaded = 1;
515 print "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):
522
523 _END_
524 close(EX) || die "Can't close $ext$modpname/test.pl: $!\n";
525
526 warn "Writing $ext$modpname/Changes\n";
527 open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n";
528 print EX "Revision history for Perl extension $module.\n\n";
529 print EX "$TEMPLATE_VERSION  ",scalar localtime,"\n";
530 print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n";
531 close(EX) || die "Can't close $ext$modpname/Changes: $!\n";
532
533 warn "Writing $ext$modpname/MANIFEST\n";
534 system '/bin/ls > MANIFEST' or system 'ls > MANIFEST';
535 !NO!SUBS!
536
537 close OUT or die "Can't close $file: $!";
538 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
539 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';