158e5e21c8587f1cf56de5d22077a00df2b02c57
[perl.git] / h2xs
1 #!/usr/bin/perl
2 'di ';
3 'ds 00 \"';
4 'ig 00 ';
5
6 use Getopt::Std;
7
8 $usage='h2xs [-Aachfm] [-n module_name] [headerfile [extra_libraries]]
9         -a      Omit AutoLoad facilities from .pm file.
10         -c      Omit the constant() function from the XS file.
11         -A      Equivalent to -a -c 
12         -f      Force creation of the extension even if the C header does not exist.
13         -h      help
14         -n      Specify a name to use for the extension.
15 extra_libraries are any libraries that might be needed for loading
16         the extension, e.g. -lm would try to link in the math library.
17 ';
18
19 sub usage{ die "Usage: $usage\n" }
20
21 getopts("fhcaAn:") || &usage;
22
23 &usage if $opt_h;
24
25 if( @ARGV ){
26         $path_h = shift;
27 }
28 elsif( ! @ARGV && ! $opt_n ){
29         die "Must supply header file or module name\n";
30 }
31
32 $extralibs = "@ARGV";
33 if( $opt_A ){
34         $opt_a = $opt_c = 1;
35 }
36
37 if( $path_h ){
38         $name = $path_h;
39         if( $path_h =~ s#::#/#g && $opt_n ){
40                 warn "Nesting of headerfile ignored with -n\n";
41         }
42         $path_h .= ".h" unless $path_h =~ /\.h$/;
43         $path_h = "/usr/include/$path_h" unless $path_h =~ m#^[./]#;
44         die "Can't find $path_h\n" if( ! $opt_f && ! -f $path_h );
45 }
46
47 $module = $opt_n || do {
48         $name =~ s/\.h$//;
49         if( $name !~ /::/ ){
50                 $name =~ s#^.*/##;
51                 $name = "\u$name";
52         }
53         $name;
54 };
55
56 chdir 'ext' if -d 'ext';
57
58 if( $module =~ /::/ ){
59         $nested = 1;
60         @modparts = split(/::/,$module);
61         $modfname = $modparts[-1];
62         $modpname = join('/',@modparts);
63 }
64 else {
65         $nested = 0;
66         @modparts = ();
67         $modfname = $modpname = $module;
68 }
69
70
71 die "Won't overwrite existing ext/$modpname\n" if -e $modpname;
72 # quick hack, should really loop over @modparts
73 mkdir($modparts[0], 0777) if $nested;
74 mkdir($modpname, 0777);
75 chdir($modpname) || die "Can't chdir ext/$modpname: $!\n";
76
77 open(XS, ">$modfname.xs") || die "Can't create ext/$modpname/$modfname.xs: $!\n";
78 open(PM, ">$modfname.pm") || die "Can't create ext/$modpname/$modfname.pm: $!\n";
79
80
81 if( -r $path_h ){
82     open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
83     while (<CH>) {
84         if (/^#[ \t]*define\s+(\w+)\b\s*[^("]/) {
85             $_ = $1;
86             next if /^_.*_h_*$/i;
87             $names{$_}++;
88             @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
89             @az = 'a' .. 'z' if !@az && /^[a-z]/;
90             @under = '_' if !@under && /^_/;
91         }
92     }
93     close(CH);
94     @names = sort keys %names;
95 }
96
97 $" = "\n\t";
98 warn "Writing ext/$modpname/$modfname.pm\n";
99
100 if( ! $opt_a ){
101 print PM <<"END";
102 package $module;
103
104 require Exporter;
105 require AutoLoader;
106 require DynaLoader;
107 \@ISA = qw(Exporter AutoLoader DynaLoader);
108 # Items to export into callers namespace by default
109 # (move infrequently used names to \@EXPORT_OK below)
110 \@EXPORT = qw(
111         @names
112 );
113 # Other items we are prepared to export if requested
114 \@EXPORT_OK = qw(
115 );
116
117 sub AUTOLOAD {
118     if (\@_ > 1) {
119         \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
120         goto &AutoLoader::AUTOLOAD;
121     }
122     local(\$constname);
123     (\$constname = \$AUTOLOAD) =~ s/.*:://;
124     \$val = constant(\$constname, \@_ ? \$_[0] : 0);
125     if (\$! != 0) {
126         if (\$! =~ /Invalid/) {
127             \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
128             goto &AutoLoader::AUTOLOAD;
129         }
130         else {
131             (\$pack,\$file,\$line) = caller;
132             die "Your vendor has not defined $module macro \$constname, used at \$file line \$line.\n";
133         }
134     }
135     eval "sub \$AUTOLOAD { \$val }";
136     goto &\$AUTOLOAD;
137 }
138
139 bootstrap $module;
140
141 # Preloaded methods go here.  Autoload methods go after __END__, and are
142 # processed by the autosplit program.
143
144 1;
145 __END__
146 END
147 }
148 else{
149 print PM <<"END";
150 package $module;
151
152 require Exporter;
153 require DynaLoader;
154 \@ISA = qw(Exporter DynaLoader);
155 # Items to export into callers namespace by default
156 \@EXPORT = qw();
157 # Other items we are prepared to export if requested
158 \@EXPORT_OK = qw();
159
160
161 bootstrap $module;
162
163 1;
164 END
165 }
166
167 close PM;
168
169 warn "Writing ext/$modpname/$modfname.xs\n";
170 print XS <<"END";
171 #include "EXTERN.h"
172 #include "perl.h"
173 #include "XSUB.h"
174
175 END
176 if( $path_h ){
177         my($h) = $path_h;
178         $h =~ s#^/usr/include/##;
179 print XS <<"END";
180 #include <$h>
181
182 END
183 }
184
185 if( ! $opt_c ){
186 print XS <<"END";
187 static int
188 not_here(s)
189 char *s;
190 {
191     croak("$module::%s not implemented on this architecture", s);
192     return -1;
193 }
194
195 static double
196 constant(name, arg)
197 char *name;
198 int arg;
199 {
200     errno = 0;
201     switch (*name) {
202 END
203
204 foreach $letter (@AZ, @az, @under) {
205
206     last if $letter eq 'a' && !@names;
207
208     print XS "    case '$letter':\n";
209     my($name);
210     while (substr($names[0],0,1) eq $letter) {
211         $name = shift(@names);
212         print XS <<"END";
213         if (strEQ(name, "$name"))
214 #ifdef $name
215             return $name;
216 #else
217             goto not_there;
218 #endif
219 END
220     }
221     print XS <<"END";
222         break;
223 END
224 }
225 print XS <<"END";
226     }
227     errno = EINVAL;
228     return 0;
229
230 not_there:
231     errno = ENOENT;
232     return 0;
233 }
234
235
236 MODULE = $module                PACKAGE = $module
237
238 double
239 constant(name,arg)
240         char *          name
241         int             arg
242
243 END
244 }
245 else{
246 print XS <<"END";
247
248 MODULE = $module                PACKAGE = $module
249
250 END
251 }
252
253 close XS;
254
255 {
256 warn "Writing ext/$modpname/Makefile.PL\n";
257 open(PL, ">Makefile.PL") || die "Can't create ext/$modpname/Makefile.PL: $!\n";
258
259 print PL <<'END';
260 use ExtUtils::MakeMaker;
261 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
262 # the contents of the Makefile that is written.
263 END
264 print PL "WriteMakefile(\n";
265 print PL "    'NAME'    => '$module',\n";
266 print PL "    'VERSION' => '0.1',\n";
267 print PL "    'LIBS'    => ['$extralibs'],   # e.g., '-lm' \n";
268 print PL "    'DEFINE'  => '',     # e.g., '-DHAVE_SOMETHING' \n";
269 print PL "    'INC'     => '',     # e.g., '-I/usr/include/other' \n";
270 print PL ");\n";
271 }
272
273 system '/bin/ls > MANIFEST';
274
275
276 ##############################################################################
277
278         # These next few lines are legal in both Perl and nroff.
279
280 .00 ;                   # finish .ig
281  
282 'di                     \" finish diversion--previous line must be blank
283 .nr nl 0-1              \" fake up transition to first page again
284 .nr % 0                 \" start at page 1
285 '; __END__ ############# From here on it's a standard manual page ############
286 .TH H2XS 1 "August 9, 1994"
287 .AT 3
288 .SH NAME
289 h2xs \- convert .h C header files to Perl extensions
290 .SH SYNOPSIS
291 .B h2xs [-Aachfm] [-n module_name] [headerfile [extra_libraries]]
292 .SH DESCRIPTION
293 .I h2xs
294 builds a Perl extension from any C header file.  The extension will include
295 functions which can be used to retrieve the value of any #define statement
296 which was in the C header.
297 .PP
298 The 
299 .I module_name
300 will be used for the name of the extension.  If module_name is not supplied
301 then the name of the header file will be used, with the first character
302 capitalized.
303 .PP
304 If the extension might need extra libraries, they should be included
305 here.  The extension Makefile.PL will take care of checking whether
306 the libraries actually exist and how they should be loaded.
307 The extra libraries should be specified in the form -lm -lposix, etc,
308 just as on the cc command line.  By default, the Makefile.PL will
309 search through the library path determined by Configure.  That path
310 can be augmented by including arguments of the form -L/another/library/path
311 in the extra-libraries argument.
312 .SH OPTIONS
313 .TP
314 .B \-f
315 Allows an extension to be created for a header even if that
316 header is not found in /usr/include.
317 .TP
318 .B \-a
319 Omit AutoLoad(), AUTOLOAD, and autosplit from the .pm and Makefile files.
320 .TP
321 .B \-c
322 Omit constant() from the .xs file.
323 .TP
324 .B \-n module_name
325 Specifies a name to be used for the extension.
326 .TP
327 .B \-A
328 Turns on both -a and -c.
329 .SH EXAMPLES
330 .nf
331
332         # Default behavior, extension is Rusers
333         h2xs rpcsvc/rusers
334
335         # Same, but extension is RUSERS
336         h2xs -n RUSERS rpcsvc/rusers
337
338         # Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
339         h2xs rpcsvc::rusers
340
341         # Extension is ONC::RPC.  Still finds <rpcsvc/rusers.h>
342         h2xs -n ONC::RPC rpcsvc/rusers
343
344         # Without AUTOLOAD, AutoLoad, autosplit
345         h2xs -a rpcsvc/rusers
346
347         # Creates templates for an extension named RPC
348         h2xs -Afn RPC
349
350         # Extension is ONC::RPC.
351         h2xs -An ONC::RPC
352
353         # Makefile.PL will look for library -lrpc in 
354         # additional directory /opt/net/lib
355         h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
356
357 .fi
358 .SH ENVIRONMENT
359 No environment variables are used.
360 .SH AUTHOR
361 Larry Wall
362 .SH "SEE ALSO"
363 perl(1) ExtUtils::MakeMaker
364 .SH DIAGNOSTICS
365 The usual warnings if it can't read or write the files involved.
366 .ex