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