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 use File::Path qw(mkpath);
42 my $Dest_dir = (@ARGV && $ARGV[0] =~ s/^-d//)
44 : $Config{installsitearch};
45 die "Destination directory $Dest_dir doesn't exist or isn't a directory\n"
48 @isatype = split(' ',<<END);
56 @isatype{@isatype} = (1) x @isatype;
59 @ARGV = ('-') unless @ARGV;
61 foreach $file (@ARGV) {
62 # Recover from header files with unbalanced cpp directives
71 ($outfile = $file) =~ s/\.h$/.ph/ || next;
72 print "$file -> $outfile\n";
73 if ($file =~ m|^(.*)/|) {
75 mkpath "$Dest_dir/$dir";
77 open(IN,"$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next);
78 open(OUT,">$Dest_dir/$outfile") || die "Can't create $outfile: $!\n";
89 s/\200[^\201]*\201//g; # delete single line comments
90 if (s/\200.*//) { # begin multi-line comment?
97 if (s/^define\s+(\w+)//) {
101 if (s/^\(([\w,\s]*)\)//) {
106 foreach $arg (split(/,\s*/,$args)) {
107 $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
110 $args =~ s/\b(\w)/\$$1/g;
111 $args = "local($args) = \@_;\n$t ";
115 $new =~ s/(["\\])/\\$1/g;
117 $new =~ s/(['\\])/\\$1/g;
119 "eval 'sub $name $proto\{\n$t ${args}eval \"$new\";\n$t}' unless defined(\&$name);\n";
122 print OUT "unless defined(\&$name) {\nsub $name $proto\{\n ${args}eval \"$new\";\n}\n}\n";
129 $new = 1 if $new eq '';
131 $new =~ s/(['\\])/\\$1/g;
132 print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n";
135 print OUT $t,"unless(defined(\&$name)) {\nsub $name () {",$new,";}\n}\n";
139 elsif (/^include\s*<(.*)>/) {
140 ($incl = $1) =~ s/\.h$/.ph/;
141 print OUT $t,"require '$incl';\n";
143 elsif (/^ifdef\s+(\w+)/) {
144 print OUT $t,"if (defined &$1) {\n";
146 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
148 elsif (/^ifndef\s+(\w+)/) {
149 print OUT $t,"if (!defined &$1) {\n";
151 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
158 print OUT $t,"if ($new) {\n";
160 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
162 elsif (s/^elif\s+//) {
168 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
169 print OUT $t,"}\n${t}elsif ($new) {\n";
171 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
175 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
176 print OUT $t,"}\n${t}else {\n";
178 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
182 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
194 s/^\&//; # hack for things that take the address of
195 s/^(\s+)// && do {$new .= ' '; next;};
196 s/^(0x[0-9a-fA-F]+)// && do {$new .= $1; next;};
197 s/^(\d+)\s*[LlUu]*// && do {$new .= $1; next;};
198 s/^("(\\"|[^"])*")// && do {$new .= $1; next;};
199 s/^'((\\"|[^"])*)'// && do {
201 $new .= "ord('\$$1')";
208 # replace "sizeof(foo)" with "{foo}"
209 # also, remove * (C dereference operator) to avoid perl syntax
210 # problems. Where the %sizeof array comes from is anyone's
211 # guess (c2ph?), but this at least avoids fatal syntax errors.
212 # Behavior is undefined if sizeof() delimiters are unbalanced.
213 # This code was modified to able to handle constructs like this:
214 # sizeof(*(p)), which appear in the HP-UX 10.01 header files.
215 s/^sizeof\s*\(// && do {
217 my $lvl = 1; # already saw one open paren
218 # tack { on the front, and skip it in the loop
221 # find balanced closing paren
222 while ($index <= length($_) && $lvl > 0) {
223 $lvl++ if substr($_, $index, 1) eq "(";
224 $lvl-- if substr($_, $index, 1) eq ")";
227 # tack } on the end, replacing )
228 substr($_, $index - 1, 1) = "}";
229 # remove pesky * operators within the sizeof argument
230 substr($_, 0, $index - 1) =~ s/\*//g;
233 s/^([_a-zA-Z]\w*)// && do {
235 if ($id eq 'struct') {
240 elsif ($id eq 'unsigned' || $id eq 'long') {
248 elsif ($id eq 'defined') {
252 s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i; # cheat
255 elsif ($isatype{$id}) {
256 if ($new =~ /{\s*$/) {
259 elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
264 $new .= q(').$id.q(');
268 if ($inif && $new !~ /defined\s*\($/) {
269 $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
280 s/^(.)// && do { if ($1 ne '#') { $new .= $1; } next;};
283 ##############################################################################
288 h2ph - convert .h C header files to .ph Perl header files
292 B<h2ph [headerfiles]>
297 converts any C header files specified to the corresponding Perl header file
299 It is most easily run while in /usr/include:
301 cd /usr/include; h2ph * sys/*
303 The output files are placed in the hierarchy rooted at Perl's
304 architecture dependent library directory. You can specify a different
305 hierarchy with a B<-d> switch.
307 If run with no arguments, filters standard input to standard output.
311 No environment variables are used.
330 The usual warnings if it can't read or write the files involved.
334 Doesn't construct the %sizeof array for you.
336 It doesn't handle all C constructs, but it does attempt to isolate
337 definitions inside evals so that you can get at the definitions
338 that it can translate.
340 It's only intended as a rough tool.
341 You may need to dicker with the files produced.
347 close OUT or die "Can't close $file: $!";
348 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
349 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';