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