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)) =~ s/\.PL$//;
19 if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving"
21 open OUT,">$file" or die "Can't create $file: $!";
23 print "Extracting $file (with variable substitutions)\n";
25 # In this section, perl variables will be expanded during extraction.
26 # You can use $Config{...} to use Configure variables.
28 print OUT <<"!GROK!THIS!";
30 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
31 if \$running_under_some_shell;
34 # In the following, perl variables are not expanded during extraction.
36 print OUT <<'!NO!SUBS!';
39 $perlincl = @Config{installsitearch};
41 chdir '/usr/include' || die "Can't cd /usr/include";
43 @isatype = split(' ',<<END);
51 @isatype{@isatype} = (1) x @isatype;
54 @ARGV = ('-') unless @ARGV;
56 foreach $file (@ARGV) {
57 # Recover from header files with unbalanced cpp directives
66 ($outfile = $file) =~ s/\.h$/.ph/ || next;
67 print "$file -> $outfile\n";
68 if ($file =~ m|^(.*)/|) {
70 if (!-d "$perlincl/$dir") {
71 mkdir("$perlincl/$dir",0777);
74 open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
75 open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n";
86 s/\200[^\201]*\201//g; # delete single line comments
87 if (s/\200.*//) { # begin multi-line comment?
94 if (s/^define\s+(\w+)//) {
98 if (s/^\(([\w,\s]*)\)//) {
101 foreach $arg (split(/,\s*/,$args)) {
102 $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
105 $args =~ s/\b(\w)/\$$1/g;
106 $args = "local($args) = \@_;\n$t ";
110 $new =~ s/(["\\])/\\$1/g;
112 $new =~ s/(['\\])/\\$1/g;
114 "eval 'sub $name {\n$t ${args}eval \"$new\";\n$t}';\n";
117 print OUT "sub $name {\n ${args}eval \"$new\";\n}\n";
124 $new = 1 if $new eq '';
126 $new =~ s/(['\\])/\\$1/g;
127 print OUT $t,"eval 'sub $name {",$new,";}';\n";
130 print OUT $t,"sub $name {",$new,";}\n";
134 elsif (/^include\s*<(.*)>/) {
135 ($incl = $1) =~ s/\.h$/.ph/;
136 print OUT $t,"require '$incl';\n";
138 elsif (/^ifdef\s+(\w+)/) {
139 print OUT $t,"if (defined &$1) {\n";
141 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
143 elsif (/^ifndef\s+(\w+)/) {
144 print OUT $t,"if (!defined &$1) {\n";
146 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
153 print OUT $t,"if ($new) {\n";
155 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
157 elsif (s/^elif\s+//) {
163 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
164 print OUT $t,"}\n${t}elsif ($new) {\n";
166 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
170 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
171 print OUT $t,"}\n${t}else {\n";
173 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
177 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
187 s/^(\s+)// && do {$new .= ' '; next;};
188 s/^(0x[0-9a-fA-F]+)// && do {$new .= $1; next;};
189 s/^(\d+)[LlUu]*// && do {$new .= $1; next;};
190 s/^("(\\"|[^"])*")// && do {$new .= $1; next;};
191 s/^'((\\"|[^"])*)'// && do {
193 $new .= "ord('\$$1')";
200 # replace "sizeof(foo)" with "{foo}"
201 # also, remove * (C dereference operator) to avoid perl syntax
202 # problems. Where the %sizeof array comes from is anyone's
203 # guess (c2ph?), but this at least avoids fatal syntax errors.
204 # Behavior is undefined if sizeof() delimiters are unbalanced.
205 # This code was modified to able to handle constructs like this:
206 # sizeof(*(p)), which appear in the HP-UX 10.01 header files.
207 s/^sizeof\s*\(// && do {
209 my $lvl = 1; # already saw one open paren
210 # tack { on the front, and skip it in the loop
213 # find balanced closing paren
214 while ($index <= length($_) && $lvl > 0) {
215 $lvl++ if substr($_, $index, 1) eq "(";
216 $lvl-- if substr($_, $index, 1) eq ")";
219 # tack } on the end, replacing )
220 substr($_, $index - 1, 1) = "}";
221 # remove pesky * operators within the sizeof argument
222 substr($_, 0, $index - 1) =~ s/\*//g;
225 s/^([_a-zA-Z]\w*)// && do {
227 if ($id eq 'struct') {
232 elsif ($id eq 'unsigned') {
240 elsif ($id eq 'defined') {
244 s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i; # cheat
247 elsif ($isatype{$id}) {
248 if ($new =~ /{\s*$/) {
251 elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
256 $new .= q(').$id.q(');
260 if ($inif && $new !~ /defined\s*\($/) {
261 $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
272 s/^(.)// && do { if ($1 ne '#') { $new .= $1; } next;};
275 ##############################################################################
280 h2ph - convert .h C header files to .ph Perl header files
284 B<h2ph [headerfiles]>
289 converts any C header files specified to the corresponding Perl header file
291 It is most easily run while in /usr/include:
293 cd /usr/include; h2ph * sys/*
295 If run with no arguments, filters standard input to standard output.
299 No environment variables are used.
318 The usual warnings if it can't read or write the files involved.
322 Doesn't construct the %sizeof array for you.
324 It doesn't handle all C constructs, but it does attempt to isolate
325 definitions inside evals so that you can get at the definitions
326 that it can translate.
328 It's only intended as a rough tool.
329 You may need to dicker with the files produced.
335 close OUT or die "Can't close $file: $!";
336 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
337 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';