xref: /openbsd-src/gnu/usr.bin/perl/utils/h2ph.PL (revision b2ea75c1b17e1a9a339660e7ed45cd24946b230e) 
1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(basename dirname);
5use Cwd;
6
7# List explicitly here the variables you want Configure to
8# generate.  Metaconfig only looks for shell variables, so you
9# have to mention them as if they were shell variables, not
10# %Config entries.  Thus you write
11#  $startperl
12# to ensure Configure will look for $Config{startperl}.
13# Wanted:  $archlibexp
14
15# This forces PL files to create target in same directory as PL file.
16# This is so that make depend always knows where to find PL derivatives.
17$origdir = cwd;
18chdir dirname($0);
19$file = basename($0, '.PL');
20$file .= '.com' if $^O eq 'VMS';
21
22open OUT,">$file" or die "Can't create $file: $!";
23
24print "Extracting $file (with variable substitutions)\n";
25
26# In this section, perl variables will be expanded during extraction.
27# You can use $Config{...} to use Configure variables.
28
29print OUT <<"!GROK!THIS!";
30$Config{startperl}
31    eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
32	if \$running_under_some_shell;
33!GROK!THIS!
34
35# In the following, perl variables are not expanded during extraction.
36
37print OUT <<'!NO!SUBS!';
38
39use strict;
40
41use Config;
42use File::Path qw(mkpath);
43use Getopt::Std;
44
45getopts('Dd:rlhaQ');
46use vars qw($opt_D $opt_d $opt_r $opt_l $opt_h $opt_a $opt_Q);
47die "-r and -a options are mutually exclusive\n" if ($opt_r and $opt_a);
48my @inc_dirs = inc_dirs() if $opt_a;
49
50my $Exit = 0;
51
52my $Dest_dir = $opt_d || $Config{installsitearch};
53die "Destination directory $Dest_dir doesn't exist or isn't a directory\n"
54    unless -d $Dest_dir;
55
56my @isatype = split(' ',<<END);
57	char	uchar	u_char
58	short	ushort	u_short
59	int	uint	u_int
60	long	ulong	u_long
61	FILE	key_t	caddr_t
62END
63
64my %isatype;
65@isatype{@isatype} = (1) x @isatype;
66my $inif = 0;
67my %Is_converted;
68
69@ARGV = ('-') unless @ARGV;
70
71build_preamble_if_necessary();
72
73my ($t, $tab, %curargs, $new, $eval_index, $dir, $name, $args, $outfile);
74my ($incl, $next);
75while (defined (my $file = next_file())) {
76    if (-l $file and -d $file) {
77        link_if_possible($file) if ($opt_l);
78        next;
79    }
80
81    # Recover from header files with unbalanced cpp directives
82    $t = '';
83    $tab = 0;
84
85    # $eval_index goes into ``#line'' directives, to help locate syntax errors:
86    $eval_index = 1;
87
88    if ($file eq '-') {
89	open(IN, "-");
90	open(OUT, ">-");
91    } else {
92	($outfile = $file) =~ s/\.h$/.ph/ || next;
93	print "$file -> $outfile\n" unless $opt_Q;
94	if ($file =~ m|^(.*)/|) {
95	    $dir = $1;
96	    mkpath "$Dest_dir/$dir";
97	}
98
99	if ($opt_a) { # automagic mode:  locate header file in @inc_dirs
100	    foreach (@inc_dirs) {
101		chdir $_;
102		last if -f $file;
103	    }
104	}
105
106	open(IN,"$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next);
107	open(OUT,">$Dest_dir/$outfile") || die "Can't create $outfile: $!\n";
108    }
109
110    print OUT "require '_h2ph_pre.ph';\n\n";
111    while (<IN>) {
112	chop;
113	while (/\\$/) {
114	    chop;
115	    $_ .= <IN>;
116	    chop;
117	}
118	print OUT "# $_\n" if $opt_D;
119
120	if (s:/\*:\200:g) {
121	    s:\*/:\201:g;
122	    s/\200[^\201]*\201//g;	# delete single line comments
123	    if (s/\200.*//) {		# begin multi-line comment?
124		$_ .= '/*';
125		$_ .= <IN>;
126		redo;
127	    }
128	}
129	if (s/^\s*\#\s*//) {
130	    if (s/^define\s+(\w+)//) {
131		$name = $1;
132		$new = '';
133		s/\s+$//;
134		if (s/^\(([\w,\s]*)\)//) {
135		    $args = $1;
136    	    	    my $proto = '() ';
137		    if ($args ne '') {
138    	    	    	$proto = '';
139			foreach my $arg (split(/,\s*/,$args)) {
140			    $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
141			    $curargs{$arg} = 1;
142			}
143			$args =~ s/\b(\w)/\$$1/g;
144			$args = "local($args) = \@_;\n$t    ";
145		    }
146		    s/^\s+//;
147		    expr();
148		    $new =~ s/(["\\])/\\$1/g;       #"]);
149		    $new = reindent($new);
150		    $args = reindent($args);
151		    if ($t ne '') {
152			$new =~ s/(['\\])/\\$1/g;   #']);
153			if ($opt_h) {
154			    print OUT $t,
155                            "eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name $proto\{\n$t    ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
156                            $eval_index++;
157			} else {
158			    print OUT $t,
159                            "eval 'sub $name $proto\{\n$t    ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
160			}
161		    } else {
162                      print OUT "unless(defined(\&$name)) {\n    sub $name $proto\{\n\t${args}eval q($new);\n    }\n}\n";
163		    }
164		    %curargs = ();
165		} else {
166		    s/^\s+//;
167		    expr();
168		    $new = 1 if $new eq '';
169		    $new = reindent($new);
170		    $args = reindent($args);
171		    if ($t ne '') {
172			$new =~ s/(['\\])/\\$1/g;        #']);
173
174			if ($opt_h) {
175			    print OUT $t,"eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name () {",$new,";}' unless defined(\&$name);\n";
176			    $eval_index++;
177			} else {
178			    print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n";
179			}
180		    } else {
181		    	# Shunt around such directives as `#define FOO FOO':
182		    	next if " \&$name" eq $new;
183
184                      print OUT $t,"unless(defined(\&$name)) {\n    sub $name () {\t",$new,";}\n}\n";
185		    }
186		}
187	    } elsif (/^(include|import)\s*[<"](.*)[>"]/) {
188		($incl = $2) =~ s/\.h$/.ph/;
189		print OUT $t,"require '$incl';\n";
190	    } elsif(/^include_next\s*[<"](.*)[>"]/) {
191		($incl = $1) =~ s/\.h$/.ph/;
192		print OUT ($t,
193			   "eval {\n");
194                $tab += 4;
195                $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
196		print OUT ($t,
197			   "my(\%INCD) = map { \$INC{\$_} => 1 } ",
198			   "(grep { \$_ eq \"$incl\" } keys(\%INC));\n");
199		print OUT ($t,
200			   "my(\@REM) = map { \"\$_/$incl\" } ",
201			   "(grep { not exists(\$INCD{\"\$_/$incl\"})",
202			   "and -f \"\$_/$incl\" } \@INC);\n");
203		print OUT ($t,
204			   "require \"\$REM[0]\" if \@REM;\n");
205                $tab -= 4;
206                $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
207                print OUT ($t,
208			   "};\n");
209		print OUT ($t,
210			   "warn(\$\@) if \$\@;\n");
211	    } elsif (/^ifdef\s+(\w+)/) {
212		print OUT $t,"if(defined(&$1)) {\n";
213		$tab += 4;
214		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
215	    } elsif (/^ifndef\s+(\w+)/) {
216		print OUT $t,"unless(defined(&$1)) {\n";
217		$tab += 4;
218		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
219	    } elsif (s/^if\s+//) {
220		$new = '';
221		$inif = 1;
222		expr();
223		$inif = 0;
224		print OUT $t,"if($new) {\n";
225		$tab += 4;
226		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
227	    } elsif (s/^elif\s+//) {
228		$new = '';
229		$inif = 1;
230		expr();
231		$inif = 0;
232		$tab -= 4;
233		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
234		print OUT $t,"}\n elsif($new) {\n";
235		$tab += 4;
236		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
237	    } elsif (/^else/) {
238		$tab -= 4;
239		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
240		print OUT $t,"} else {\n";
241		$tab += 4;
242		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
243	    } elsif (/^endif/) {
244		$tab -= 4;
245		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
246		print OUT $t,"}\n";
247	    } elsif(/^undef\s+(\w+)/) {
248		print OUT $t, "undef(&$1) if defined(&$1);\n";
249	    } elsif(/^error\s+(".*")/) {
250		print OUT $t, "die($1);\n";
251	    } elsif(/^error\s+(.*)/) {
252		print OUT $t, "die(\"", quotemeta($1), "\");\n";
253	    } elsif(/^warning\s+(.*)/) {
254		print OUT $t, "warn(\"", quotemeta($1), "\");\n";
255	    } elsif(/^ident\s+(.*)/) {
256		print OUT $t, "# $1\n";
257	    }
258 	} elsif(/^\s*(typedef\s*)?enum\s*(\s+[a-zA-Z_]\w*\s*)?\{/) {
259	    until(/\}.*?;/) {
260		chomp($next = <IN>);
261		$_ .= $next;
262		print OUT "# $next\n" if $opt_D;
263	    }
264	    s@/\*.*?\*/@@g;
265	    s/\s+/ /g;
266	    /^\s?(typedef\s?)?enum\s?([a-zA-Z_]\w*)?\s?\{(.*)\}\s?([a-zA-Z_]\w*)?\s?;/;
267	    (my $enum_subs = $3) =~ s/\s//g;
268	    my @enum_subs = split(/,/, $enum_subs);
269	    my $enum_val = -1;
270	    foreach my $enum (@enum_subs) {
271		my ($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/;
272		$enum_value =~ s/^=//;
273		$enum_val = (length($enum_value) ? $enum_value : $enum_val + 1);
274		if ($opt_h) {
275		    print OUT ($t,
276			       "eval(\"\\n#line $eval_index $outfile\\n",
277			       "sub $enum_name () \{ $enum_val; \}\") ",
278			       "unless defined(\&$enum_name);\n");
279		    ++ $eval_index;
280		} else {
281		    print OUT ($t,
282			       "eval(\"sub $enum_name () \{ $enum_val; \}\") ",
283			       "unless defined(\&$enum_name);\n");
284		}
285	    }
286	}
287    }
288    print OUT "1;\n";
289
290    $Is_converted{$file} = 1;
291    queue_includes_from($file) if ($opt_a);
292}
293
294exit $Exit;
295
296
297sub reindent($) {
298    my($text) = shift;
299    $text =~ s/\n/\n    /g;
300    $text =~ s/        /\t/g;
301    $text;
302}
303
304
305sub expr {
306    my $joined_args;
307    if(keys(%curargs)) {
308	$joined_args = join('|', keys(%curargs));
309    }
310    while ($_ ne '') {
311	s/^\&\&// && do { $new .= " &&"; next;}; # handle && operator
312	s/^\&([\(a-z\)]+)/$1/i;	# hack for things that take the address of
313	s/^(\s+)//		&& do {$new .= ' '; next;};
314	s/^(0X[0-9A-F]+)[UL]*//i	&& do {$new .= lc($1); next;};
315	s/^(-?\d+\.\d+E[-+]\d+)F?//i	&& do {$new .= $1; next;};
316	s/^(\d+)\s*[LU]*//i	&& do {$new .= $1; next;};
317	s/^("(\\"|[^"])*")//	&& do {$new .= $1; next;};
318	s/^'((\\"|[^"])*)'//	&& do {
319	    if ($curargs{$1}) {
320		$new .= "ord('\$$1')";
321	    } else {
322		$new .= "ord('$1')";
323	    }
324	    next;
325	};
326        # replace "sizeof(foo)" with "{foo}"
327        # also, remove * (C dereference operator) to avoid perl syntax
328        # problems.  Where the %sizeof array comes from is anyone's
329        # guess (c2ph?), but this at least avoids fatal syntax errors.
330        # Behavior is undefined if sizeof() delimiters are unbalanced.
331        # This code was modified to able to handle constructs like this:
332        #   sizeof(*(p)), which appear in the HP-UX 10.01 header files.
333        s/^sizeof\s*\(// && do {
334            $new .= '$sizeof';
335            my $lvl = 1;  # already saw one open paren
336            # tack { on the front, and skip it in the loop
337            $_ = "{" . "$_";
338            my $index = 1;
339            # find balanced closing paren
340            while ($index <= length($_) && $lvl > 0) {
341                $lvl++ if substr($_, $index, 1) eq "(";
342                $lvl-- if substr($_, $index, 1) eq ")";
343                $index++;
344            }
345            # tack } on the end, replacing )
346            substr($_, $index - 1, 1) = "}";
347            # remove pesky * operators within the sizeof argument
348            substr($_, 0, $index - 1) =~ s/\*//g;
349            next;
350        };
351	# Eliminate typedefs
352	/\(([\w\s]+)[\*\s]*\)\s*[\w\(]/ && do {
353	    foreach (split /\s+/, $1) {  # Make sure all the words are types,
354		last unless ($isatype{$_} or $_ eq 'struct');
355	    }
356	    s/\([\w\s]+[\*\s]*\)// && next;      # then eliminate them.
357	};
358	# struct/union member, including arrays:
359	s/^([_A-Z]\w*(\[[^\]]+\])?((\.|->)[_A-Z]\w*(\[[^\]]+\])?)+)//i && do {
360	    my $id = $1;
361	    $id =~ s/(\.|(->))([^\.\-]*)/->\{$3\}/g;
362	    $id =~ s/\b([^\$])($joined_args)/$1\$$2/g if length($joined_args);
363	    while($id =~ /\[\s*([^\$\&\d\]]+)\]/) {
364		my($index) = $1;
365		$index =~ s/\s//g;
366		if(exists($curargs{$index})) {
367		    $index = "\$$index";
368		} else {
369		    $index = "&$index";
370		}
371		$id =~ s/\[\s*([^\$\&\d\]]+)\]/[$index]/;
372	    }
373	    $new .= " (\$$id)";
374	};
375	s/^([_a-zA-Z]\w*)//	&& do {
376	    my $id = $1;
377	    if ($id eq 'struct') {
378		s/^\s+(\w+)//;
379		$id .= ' ' . $1;
380		$isatype{$id} = 1;
381	    } elsif ($id =~ /^((un)?signed)|(long)|(short)$/) {
382		while (s/^\s+(\w+)//) { $id .= ' ' . $1; }
383		$isatype{$id} = 1;
384	    }
385	    if ($curargs{$id}) {
386		$new .= "\$$id";
387		$new .= '->' if /^[\[\{]/;
388	    } elsif ($id eq 'defined') {
389		$new .= 'defined';
390	    } elsif (/^\(/) {
391		s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;	# cheat
392		$new .= " &$id";
393	    } elsif ($isatype{$id}) {
394		if ($new =~ /{\s*$/) {
395		    $new .= "'$id'";
396		} elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
397		    $new =~ s/\(\s*$//;
398		    s/^[\s*]*\)//;
399		} else {
400		    $new .= q(').$id.q(');
401		}
402	    } else {
403		if ($inif && $new !~ /defined\s*\($/) {
404		    $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
405		} elsif (/^\[/) {
406		    $new .= " \$$id";
407		} else {
408		    $new .= ' &' . $id;
409		}
410	    }
411	    next;
412	};
413	s/^(.)// && do { if ($1 ne '#') { $new .= $1; } next;};
414    }
415}
416
417
418# Handle recursive subdirectories without getting a grotesquely big stack.
419# Could this be implemented using File::Find?
420sub next_file
421{
422    my $file;
423
424    while (@ARGV) {
425        $file = shift @ARGV;
426
427        if ($file eq '-' or -f $file or -l $file) {
428            return $file;
429        } elsif (-d $file) {
430            if ($opt_r) {
431                expand_glob($file);
432            } else {
433                print STDERR "Skipping directory `$file'\n";
434            }
435        } elsif ($opt_a) {
436            return $file;
437        } else {
438            print STDERR "Skipping `$file':  not a file or directory\n";
439        }
440    }
441
442    return undef;
443}
444
445
446# Put all the files in $directory into @ARGV for processing.
447sub expand_glob
448{
449    my ($directory)  = @_;
450
451    $directory =~ s:/$::;
452
453    opendir DIR, $directory;
454        foreach (readdir DIR) {
455            next if ($_ eq '.' or $_ eq '..');
456
457            # expand_glob() is going to be called until $ARGV[0] isn't a
458            # directory; so push directories, and unshift everything else.
459            if (-d "$directory/$_") { push    @ARGV, "$directory/$_" }
460            else                    { unshift @ARGV, "$directory/$_" }
461        }
462    closedir DIR;
463}
464
465
466# Given $file, a symbolic link to a directory in the C include directory,
467# make an equivalent symbolic link in $Dest_dir, if we can figure out how.
468# Otherwise, just duplicate the file or directory.
469sub link_if_possible
470{
471    my ($dirlink)  = @_;
472    my $target  = eval 'readlink($dirlink)';
473
474    if ($target =~ m:^\.\./: or $target =~ m:^/:) {
475        # The target of a parent or absolute link could leave the $Dest_dir
476        # hierarchy, so let's put all of the contents of $dirlink (actually,
477        # the contents of $target) into @ARGV; as a side effect down the
478        # line, $dirlink will get created as an _actual_ directory.
479        expand_glob($dirlink);
480    } else {
481        if (-l "$Dest_dir/$dirlink") {
482            unlink "$Dest_dir/$dirlink" or
483                print STDERR "Could not remove link $Dest_dir/$dirlink:  $!\n";
484        }
485
486        if (eval 'symlink($target, "$Dest_dir/$dirlink")') {
487            print "Linking $target -> $Dest_dir/$dirlink\n";
488
489            # Make sure that the link _links_ to something:
490            if (! -e "$Dest_dir/$target") {
491                mkpath("$Dest_dir/$target", 0755) or
492                    print STDERR "Could not create $Dest_dir/$target/\n";
493            }
494        } else {
495            print STDERR "Could not symlink $target -> $Dest_dir/$dirlink:  $!\n";
496        }
497    }
498}
499
500
501# Push all #included files in $file onto our stack, except for STDIN
502# and files we've already processed.
503sub queue_includes_from
504{
505    my ($file)    = @_;
506    my $line;
507
508    return if ($file eq "-");
509
510    open HEADER, $file or return;
511        while (defined($line = <HEADER>)) {
512            while (/\\$/) { # Handle continuation lines
513                chop $line;
514                $line .= <HEADER>;
515            }
516
517            if ($line =~ /^#\s*include\s+<(.*?)>/) {
518                push(@ARGV, $1) unless $Is_converted{$1};
519            }
520        }
521    close HEADER;
522}
523
524
525# Determine include directories; $Config{usrinc} should be enough for (all
526# non-GCC?) C compilers, but gcc uses an additional include directory.
527sub inc_dirs
528{
529    my $from_gcc    = `$Config{cc} -v 2>&1`;
530    $from_gcc       =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s;
531
532    length($from_gcc) ? ($from_gcc, $Config{usrinc}) : ($Config{usrinc});
533}
534
535
536# Create "_h2ph_pre.ph", if it doesn't exist or was built by a different
537# version of h2ph.
538sub build_preamble_if_necessary
539{
540    # Increment $VERSION every time this function is modified:
541    my $VERSION     = 2;
542    my $preamble    = "$Dest_dir/_h2ph_pre.ph";
543
544    # Can we skip building the preamble file?
545    if (-r $preamble) {
546        # Extract version number from first line of preamble:
547        open  PREAMBLE, $preamble or die "Cannot open $preamble:  $!";
548            my $line = <PREAMBLE>;
549            $line =~ /(\b\d+\b)/;
550        close PREAMBLE            or die "Cannot close $preamble:  $!";
551
552        # Don't build preamble if a compatible preamble exists:
553        return if $1 == $VERSION;
554    }
555
556    my (%define) = _extract_cc_defines();
557
558    open  PREAMBLE, ">$preamble" or die "Cannot open $preamble:  $!";
559        print PREAMBLE "# This file was created by h2ph version $VERSION\n";
560
561        foreach (sort keys %define) {
562            if ($opt_D) {
563                print PREAMBLE "# $_=$define{$_}\n";
564            }
565
566            if ($define{$_} =~ /^\d+$/) {
567                print PREAMBLE
568                    "unless (defined &$_) { sub $_() { $define{$_} } }\n\n";
569            } elsif ($define{$_} =~ /^\w+$/) {
570                print PREAMBLE
571                    "unless (defined &$_) { sub $_() { &$define{$_} } }\n\n";
572            } else {
573                print PREAMBLE
574                    "unless (defined &$_) { sub $_() { \"",
575                    quotemeta($define{$_}), "\" } }\n\n";
576            }
577        }
578    close PREAMBLE               or die "Cannot close $preamble:  $!";
579}
580
581
582# %Config contains information on macros that are pre-defined by the
583# system's compiler.  We need this information to make the .ph files
584# function with perl as the .h files do with cc.
585sub _extract_cc_defines
586{
587    my %define;
588    my $allsymbols  = join " ",
589        @Config{'ccsymbols', 'cppsymbols', 'cppccsymbols'};
590
591    # Split compiler pre-definitions into `key=value' pairs:
592    foreach (split /\s+/, $allsymbols) {
593        /(.+?)=(.+)/ and $define{$1} = $2;
594
595        if ($opt_D) {
596            print STDERR "$_:  $1 -> $2\n";
597        }
598    }
599
600    return %define;
601}
602
603
6041;
605
606##############################################################################
607__END__
608
609=head1 NAME
610
611h2ph - convert .h C header files to .ph Perl header files
612
613=head1 SYNOPSIS
614
615B<h2ph [-d destination directory] [-r | -a] [-l] [headerfiles]>
616
617=head1 DESCRIPTION
618
619I<h2ph>
620converts any C header files specified to the corresponding Perl header file
621format.
622It is most easily run while in /usr/include:
623
624	cd /usr/include; h2ph * sys/*
625
626or
627
628	cd /usr/include; h2ph -r -l .
629
630The output files are placed in the hierarchy rooted at Perl's
631architecture dependent library directory.  You can specify a different
632hierarchy with a B<-d> switch.
633
634If run with no arguments, filters standard input to standard output.
635
636=head1 OPTIONS
637
638=over 4
639
640=item -d destination_dir
641
642Put the resulting B<.ph> files beneath B<destination_dir>, instead of
643beneath the default Perl library location (C<$Config{'installsitsearch'}>).
644
645=item -r
646
647Run recursively; if any of B<headerfiles> are directories, then run I<h2ph>
648on all files in those directories (and their subdirectories, etc.).  B<-r>
649and B<-a> are mutually exclusive.
650
651=item -a
652
653Run automagically; convert B<headerfiles>, as well as any B<.h> files
654which they include.  This option will search for B<.h> files in all
655directories which your C compiler ordinarily uses.  B<-a> and B<-r> are
656mutually exclusive.
657
658=item -l
659
660Symbolic links will be replicated in the destination directory.  If B<-l>
661is not specified, then links are skipped over.
662
663=item -h
664
665Put ``hints'' in the .ph files which will help in locating problems with
666I<h2ph>.  In those cases when you B<require> a B<.ph> file containing syntax
667errors, instead of the cryptic
668
669	[ some error condition ] at (eval mmm) line nnn
670
671you will see the slightly more helpful
672
673	[ some error condition ] at filename.ph line nnn
674
675However, the B<.ph> files almost double in size when built using B<-h>.
676
677=item -D
678
679Include the code from the B<.h> file as a comment in the B<.ph> file.
680This is primarily used for debugging I<h2ph>.
681
682=item -Q
683
684``Quiet'' mode; don't print out the names of the files being converted.
685
686=back
687
688=head1 ENVIRONMENT
689
690No environment variables are used.
691
692=head1 FILES
693
694 /usr/include/*.h
695 /usr/include/sys/*.h
696
697etc.
698
699=head1 AUTHOR
700
701Larry Wall
702
703=head1 SEE ALSO
704
705perl(1)
706
707=head1 DIAGNOSTICS
708
709The usual warnings if it can't read or write the files involved.
710
711=head1 BUGS
712
713Doesn't construct the %sizeof array for you.
714
715It doesn't handle all C constructs, but it does attempt to isolate
716definitions inside evals so that you can get at the definitions
717that it can translate.
718
719It's only intended as a rough tool.
720You may need to dicker with the files produced.
721
722You have to run this program by hand; it's not run as part of the Perl
723installation.
724
725Doesn't handle complicated expressions built piecemeal, a la:
726
727    enum {
728        FIRST_VALUE,
729        SECOND_VALUE,
730    #ifdef ABC
731        THIRD_VALUE
732    #endif
733    };
734
735Doesn't necessarily locate all of your C compiler's internally-defined
736symbols.
737
738=cut
739
740!NO!SUBS!
741
742close OUT or die "Can't close $file: $!";
743chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
744exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
745chdir $origdir;
746