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