4 use File::Basename qw(&basename &dirname);
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
11 # to ensure Configure will look for $Config{startperl}.
14 # This forces PL files to create target in same directory as PL file.
15 # This is so that make depend always knows where to find PL derivatives.
17 $file = basename($0, '.PL');
18 $file .= '.com' if $^O eq 'VMS';
20 open OUT,">$file" or die "Can't create $file: $!";
22 print "Extracting $file (with variable substitutions)\n";
24 # In this section, perl variables will be expanded during extraction.
25 # You can use $Config{...} to use Configure variables.
27 print OUT <<"!GROK!THIS!";
29 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
30 if \$running_under_some_shell;
33 # In the following, perl variables are not expanded during extraction.
35 print OUT <<'!NO!SUBS!';
38 $perlincl = @Config{installsitearch};
40 chdir '/usr/include' || die "Can't cd /usr/include";
42 @isatype = split(' ',<<END);
50 @isatype{@isatype} = (1) x @isatype;
53 @ARGV = ('-') unless @ARGV;
55 foreach $file (@ARGV) {
56 # Recover from header files with unbalanced cpp directives
65 ($outfile = $file) =~ s/\.h$/.ph/ || next;
66 print "$file -> $outfile\n";
67 if ($file =~ m|^(.*)/|) {
69 if (!-d "$perlincl/$dir") {
70 mkdir("$perlincl/$dir",0777);
73 open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
74 open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n";
85 s/\200[^\201]*\201//g; # delete single line comments
86 if (s/\200.*//) { # begin multi-line comment?
93 if (s/^define\s+(\w+)//) {
97 if (s/^\(([\w,\s]*)\)//) {
100 foreach $arg (split(/,\s*/,$args)) {
101 $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
104 $args =~ s/\b(\w)/\$$1/g;
105 $args = "local($args) = \@_;\n$t ";
109 $new =~ s/(["\\])/\\$1/g;
111 $new =~ s/(['\\])/\\$1/g;
113 "eval 'sub $name {\n$t ${args}eval \"$new\";\n$t}';\n";
116 print OUT "sub $name {\n ${args}eval \"$new\";\n}\n";
123 $new = 1 if $new eq '';
125 $new =~ s/(['\\])/\\$1/g;
126 print OUT $t,"eval 'sub $name {",$new,";}';\n";
129 print OUT $t,"sub $name {",$new,";}\n";
133 elsif (/^include\s*<(.*)>/) {
134 ($incl = $1) =~ s/\.h$/.ph/;
135 print OUT $t,"require '$incl';\n";
137 elsif (/^ifdef\s+(\w+)/) {
138 print OUT $t,"if (defined &$1) {\n";
140 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
142 elsif (/^ifndef\s+(\w+)/) {
143 print OUT $t,"if (!defined &$1) {\n";
145 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
152 print OUT $t,"if ($new) {\n";
154 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
156 elsif (s/^elif\s+//) {
162 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
163 print OUT $t,"}\n${t}elsif ($new) {\n";
165 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
169 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
170 print OUT $t,"}\n${t}else {\n";
172 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
176 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
186 s/^(\s+)// && do {$new .= ' '; next;};
187 s/^(0x[0-9a-fA-F]+)// && do {$new .= $1; next;};
188 s/^(\d+)[LlUu]*// && do {$new .= $1; next;};
189 s/^("(\\"|[^"])*")// && do {$new .= $1; next;};
190 s/^'((\\"|[^"])*)'// && do {
192 $new .= "ord('\$$1')";
199 # replace "sizeof(foo)" with "{foo}"
200 # also, remove * (C dereference operator) to avoid perl syntax
201 # problems. Where the %sizeof array comes from is anyone's
202 # guess (c2ph?), but this at least avoids fatal syntax errors.
203 # Behavior is undefined if sizeof() delimiters are unbalanced.
204 # This code was modified to able to handle constructs like this:
205 # sizeof(*(p)), which appear in the HP-UX 10.01 header files.
206 s/^sizeof\s*\(// && do {
208 my $lvl = 1; # already saw one open paren
209 # tack { on the front, and skip it in the loop
212 # find balanced closing paren
213 while ($index <= length($_) && $lvl > 0) {
214 $lvl++ if substr($_, $index, 1) eq "(";
215 $lvl-- if substr($_, $index, 1) eq ")";
218 # tack } on the end, replacing )
219 substr($_, $index - 1, 1) = "}";
220 # remove pesky * operators within the sizeof argument
221 substr($_, 0, $index - 1) =~ s/\*//g;
224 s/^([_a-zA-Z]\w*)// && do {
226 if ($id eq 'struct') {
231 elsif ($id eq 'unsigned' || $id eq 'long') {
239 elsif ($id eq 'defined') {
243 s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i; # cheat
246 elsif ($isatype{$id}) {
247 if ($new =~ /{\s*$/) {
250 elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
255 $new .= q(').$id.q(');
259 if ($inif && $new !~ /defined\s*\($/) {
260 $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
271 s/^(.)// && do { if ($1 ne '#') { $new .= $1; } next;};
274 ##############################################################################
279 h2ph - convert .h C header files to .ph Perl header files
283 B<h2ph [headerfiles]>
288 converts any C header files specified to the corresponding Perl header file
290 It is most easily run while in /usr/include:
292 cd /usr/include; h2ph * sys/*
294 If run with no arguments, filters standard input to standard output.
298 No environment variables are used.
317 The usual warnings if it can't read or write the files involved.
321 Doesn't construct the %sizeof array for you.
323 It doesn't handle all C constructs, but it does attempt to isolate
324 definitions inside evals so that you can get at the definitions
325 that it can translate.
327 It's only intended as a rough tool.
328 You may need to dicker with the files produced.
334 close OUT or die "Can't close $file: $!";
335 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
336 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';