Commit | Line | Data |
---|---|---|
40000a8c AD |
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!' | |
3edbfbe5 TB |
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 | ||
a0d0e21e LW |
125 | |
126 | use Getopt::Std; | |
127 | ||
e1666bf5 TB |
128 | sub usage{ |
129 | warn "@_\n" if @_; | |
3edbfbe5 | 130 | die 'h2xs [-Acfh] [-n module_name] [headerfile [extra_libraries]] |
e1666bf5 TB |
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. | |
3edbfbe5 | 134 | -A Omit all autoloading facilities (implies -c). |
e1666bf5 TB |
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. | |
a0d0e21e | 139 | '; |
e1666bf5 | 140 | } |
a0d0e21e | 141 | |
a0d0e21e | 142 | |
3edbfbe5 | 143 | getopts("Acfhn:") || usage; |
a0d0e21e | 144 | |
e1666bf5 TB |
145 | usage if $opt_h; |
146 | $opt_c = 1 if $opt_A; | |
a0d0e21e | 147 | |
e1666bf5 | 148 | $path_h = shift; |
a0d0e21e | 149 | $extralibs = "@ARGV"; |
e1666bf5 TB |
150 | |
151 | usage "Must supply header file or module name\n" | |
152 | unless ($path_h or $opt_n); | |
153 | ||
a0d0e21e LW |
154 | |
155 | if( $path_h ){ | |
e1666bf5 TB |
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{$_}++; | |
a0d0e21e | 173 | } |
e1666bf5 TB |
174 | } |
175 | close(CH); | |
176 | @const_names = sort keys %const_names; | |
a0d0e21e LW |
177 | } |
178 | ||
e1666bf5 | 179 | |
a0d0e21e LW |
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 | ||
a0d0e21e LW |
213 | $" = "\n\t"; |
214 | warn "Writing ext/$modpname/$modfname.pm\n"; | |
215 | ||
a0d0e21e LW |
216 | print PM <<"END"; |
217 | package $module; | |
218 | ||
219 | require Exporter; | |
a0d0e21e | 220 | require DynaLoader; |
3edbfbe5 TB |
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"; | |
e1666bf5 | 232 | |
a0d0e21e | 233 | \@ISA = qw(Exporter AutoLoader DynaLoader); |
3edbfbe5 TB |
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 | } | |
e1666bf5 | 245 | |
3edbfbe5 | 246 | print PM<<"END"; |
e1666bf5 TB |
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. | |
a0d0e21e | 250 | \@EXPORT = qw( |
e1666bf5 | 251 | @const_names |
a0d0e21e | 252 | ); |
e1666bf5 TB |
253 | END |
254 | ||
255 | print PM <<"END" unless $opt_c; | |
a0d0e21e | 256 | sub AUTOLOAD { |
3edbfbe5 TB |
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. | |
e1666bf5 | 260 | |
a0d0e21e LW |
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 | ||
a0d0e21e | 278 | END |
a0d0e21e | 279 | |
e1666bf5 TB |
280 | print PM <<"END"; |
281 | bootstrap $module; | |
a0d0e21e | 282 | |
e1666bf5 | 283 | # Preloaded methods go here. |
a0d0e21e | 284 | |
e1666bf5 | 285 | # Autoload methods go after __END__, and are processed by the autosplit program. |
a0d0e21e LW |
286 | |
287 | 1; | |
e1666bf5 | 288 | __END__ |
a0d0e21e | 289 | END |
a0d0e21e LW |
290 | |
291 | close PM; | |
292 | ||
e1666bf5 | 293 | |
a0d0e21e | 294 | warn "Writing ext/$modpname/$modfname.xs\n"; |
e1666bf5 | 295 | |
a0d0e21e LW |
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 | ||
e1666bf5 TB |
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 | ||
a0d0e21e LW |
338 | foreach $letter (@AZ, @az, @under) { |
339 | ||
e1666bf5 | 340 | last if $letter eq 'a' && !@const_names; |
a0d0e21e LW |
341 | |
342 | print XS " case '$letter':\n"; | |
343 | my($name); | |
e1666bf5 TB |
344 | while (substr($const_names[0],0,1) eq $letter) { |
345 | $name = shift(@const_names); | |
a0d0e21e LW |
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 | ||
e1666bf5 TB |
369 | END |
370 | } | |
371 | ||
372 | # Now switch from C to XS by issuing the first MODULE declaration: | |
373 | print XS <<"END"; | |
a0d0e21e LW |
374 | |
375 | MODULE = $module PACKAGE = $module | |
376 | ||
e1666bf5 TB |
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 | ||
a0d0e21e LW |
383 | double |
384 | constant(name,arg) | |
385 | char * name | |
386 | int arg | |
387 | ||
388 | END | |
a0d0e21e LW |
389 | |
390 | close XS; | |
391 | ||
e1666bf5 | 392 | |
a0d0e21e LW |
393 | warn "Writing ext/$modpname/Makefile.PL\n"; |
394 | open(PL, ">Makefile.PL") || die "Can't create ext/$modpname/Makefile.PL: $!\n"; | |
395 | ||
a0d0e21e LW |
396 | print PL <<'END'; |
397 | use ExtUtils::MakeMaker; | |
398 | # See lib/ExtUtils/MakeMaker.pm for details of how to influence | |
42793c05 | 399 | # the contents of the Makefile that is written. |
a0d0e21e | 400 | END |
42793c05 TB |
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"; | |
a0d0e21e | 407 | print PL ");\n"; |
e1666bf5 | 408 | |
a0d0e21e | 409 | |
a0d0e21e | 410 | system '/bin/ls > MANIFEST'; |
40000a8c AD |
411 | !NO!SUBS! |
412 | chmod 755 h2xs | |
413 | $eunicefix h2xs |