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