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