Commit | Line | Data |
---|---|---|
a0d0e21e | 1 | #!/usr/bin/perl |
3edbfbe5 TB |
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 LW |
102 | |
103 | use Getopt::Std; | |
104 | ||
e1666bf5 TB |
105 | sub usage{ |
106 | warn "@_\n" if @_; | |
3edbfbe5 | 107 | die 'h2xs [-Acfh] [-n module_name] [headerfile [extra_libraries]] |
e1666bf5 TB |
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 TB |
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 TB |
122 | usage if $opt_h; |
123 | $opt_c = 1 if $opt_A; | |
a0d0e21e | 124 | |
e1666bf5 | 125 | $path_h = shift; |
a0d0e21e | 126 | $extralibs = "@ARGV"; |
e1666bf5 TB |
127 | |
128 | usage "Must supply header file or module name\n" | |
129 | unless ($path_h or $opt_n); | |
130 | ||
a0d0e21e LW |
131 | |
132 | if( $path_h ){ | |
e1666bf5 TB |
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 TB |
151 | } |
152 | close(CH); | |
153 | @const_names = sort keys %const_names; | |
a0d0e21e LW |
154 | } |
155 | ||
e1666bf5 | 156 | |
a0d0e21e LW |
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 LW |
190 | $" = "\n\t"; |
191 | warn "Writing ext/$modpname/$modfname.pm\n"; | |
192 | ||
a0d0e21e LW |
193 | print PM <<"END"; |
194 | package $module; | |
195 | ||
196 | require Exporter; | |
a0d0e21e | 197 | require DynaLoader; |
3edbfbe5 TB |
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 TB |
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 TB |
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 LW |
229 | ); |
230 | # Other items we are prepared to export if requested | |
231 | \@EXPORT_OK = qw( | |
232 | ); | |
233 | ||
e1666bf5 TB |
234 | END |
235 | ||
236 | print PM <<"END" unless $opt_c; | |
a0d0e21e | 237 | sub AUTOLOAD { |
3edbfbe5 TB |
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 TB |
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 LW |
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 TB |
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 LW |
273 | |
274 | 1; | |
e1666bf5 | 275 | __END__ |
a0d0e21e | 276 | END |
a0d0e21e LW |
277 | |
278 | close PM; | |
279 | ||
e1666bf5 | 280 | |
a0d0e21e | 281 | warn "Writing ext/$modpname/$modfname.xs\n"; |
e1666bf5 | 282 | |
a0d0e21e LW |
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 TB |
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 LW |
325 | foreach $letter (@AZ, @az, @under) { |
326 | ||
e1666bf5 | 327 | last if $letter eq 'a' && !@const_names; |
a0d0e21e LW |
328 | |
329 | print XS " case '$letter':\n"; | |
330 | my($name); | |
e1666bf5 TB |
331 | while (substr($const_names[0],0,1) eq $letter) { |
332 | $name = shift(@const_names); | |
a0d0e21e LW |
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 TB |
356 | END |
357 | } | |
358 | ||
359 | # Now switch from C to XS by issuing the first MODULE declaration: | |
360 | print XS <<"END"; | |
a0d0e21e LW |
361 | |
362 | MODULE = $module PACKAGE = $module | |
363 | ||
e1666bf5 TB |
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 LW |
370 | double |
371 | constant(name,arg) | |
372 | char * name | |
373 | int arg | |
374 | ||
375 | END | |
a0d0e21e LW |
376 | |
377 | close XS; | |
378 | ||
e1666bf5 | 379 | |
a0d0e21e LW |
380 | warn "Writing ext/$modpname/Makefile.PL\n"; |
381 | open(PL, ">Makefile.PL") || die "Can't create ext/$modpname/Makefile.PL: $!\n"; | |
382 | ||
a0d0e21e LW |
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 TB |
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'; |