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