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 perl -S \$0 "\$@"'
37 \$perlincl = "$Config{archlibexp}"; # or {sitearchexp}
41 # In the following, perl variables are not expanded during extraction.
43 print OUT <<'!NO!SUBS!';
45 chdir '/usr/include' || die "Can't cd /usr/include";
47 @isatype = split(' ',<<END);
55 @isatype{@isatype} = (1) x @isatype;
58 @ARGV = ('-') unless @ARGV;
60 foreach $file (@ARGV) {
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 s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
204 s/^([_a-zA-Z]\w*)// && do {
206 if ($id eq 'struct') {
211 elsif ($id eq 'unsigned') {
219 elsif ($id eq 'defined') {
223 s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i; # cheat
226 elsif ($isatype{$id}) {
227 if ($new =~ /{\s*$/) {
230 elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
235 $new .= q(').$id.q(');
239 if ($inif && $new !~ /defined\s*\($/) {
240 $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
251 s/^(.)// && do { if ($1 ne '#') { $new .= $1; } next;};
254 ##############################################################################
256 # These next few lines are legal in both Perl and nroff.
260 'di \" finish diversion--previous line must be blank
261 .nr nl 0-1 \" fake up transition to first page again
262 .nr % 0 \" start at page 1
263 '; __END__ ############# From here on it's a standard manual page ############
264 .TH H2PH 1 "August 8, 1990"
267 h2ph \- convert .h C header files to .ph Perl header files
269 .B h2ph [headerfiles]
272 converts any C header files specified to the corresponding Perl header file
274 It is most easily run while in /usr/include:
277 cd /usr/include; h2ph * sys/*
280 If run with no arguments, filters standard input to standard output.
282 No environment variables are used.
294 The usual warnings if it can't read or write the files involved.
296 Doesn't construct the %sizeof array for you.
298 It doesn't handle all C constructs, but it does attempt to isolate
299 definitions inside evals so that you can get at the definitions
300 that it can translate.
302 It's only intended as a rough tool.
303 You may need to dicker with the files produced.
307 close OUT or die "Can't close $file: $!";
308 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
309 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';