h2ph

   1 #!/usr/local/bin/perl
   2 'di';
   3 'ig00';
   4
   5 $perlincl = '/usr/local/lib/perl';
   6
   7 chdir '/usr/include' || die "Can't cd /usr/include";
   8
   9 @isatype = split(' ',<<END);
  10         char    uchar   u_char
  11         short   ushort  u_short
  12         int     uint    u_int
  13         long    ulong   u_long
  14         FILE
  15 END
  16
  17 @isatype{@isatype} = (1) x @isatype;
  18
  19 @ARGV = ('-') unless @ARGV;
  20
  21 foreach $file (@ARGV) {
  22     if ($file eq '-') {
  23         open(IN, "-");
  24         open(OUT, ">-");
  25     }
  26     else {
  27         ($outfile = $file) =~ s/\.h$/.ph/ || next;
  28         print "$file -> $outfile\n";
  29         if ($file =~ m|^(.*)/|) {
  30             $dir = $1;
  31             if (!-d "$perlincl/$dir") {
  32                 mkdir("$perlincl/$dir",0777);
  33             }
  34         }
  35         open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
  36         open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n";
  37     }
  38     while (<IN>) {
  39         chop;
  40         while (/\\$/) {
  41             chop;
  42             $_ .= <IN>;
  43             chop;
  44         }
  45         if (s:/\*:\200:g) {
  46             s:\*/:\201:g;
  47             s/\200[^\201]*\201//g;      # delete single line comments
  48             if (s/\200.*//) {           # begin multi-line comment?
  49                 $_ .= '/*';
  50                 $_ .= <IN>;
  51                 redo;
  52             }
  53         }
  54         if (s/^#\s*//) {
  55             if (s/^define\s+(\w+)//) {
  56                 $name = $1;
  57                 $new = '';
  58                 s/\s+$//;
  59                 if (s/^\(([\w,\s]*)\)//) {
  60                     $args = $1;
  61                     if ($args ne '') {
  62                         foreach $arg (split(/,\s*/,$args)) {
  63                             $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
  64                             $curargs{$arg} = 1;
  65                         }
  66                         $args =~ s/\b(\w)/\$$1/g;
  67                         $args = "local($args) = \@_;\n$t    ";
  68                     }
  69                     s/^\s+//;
  70                     do expr();
  71                     $new =~ s/(["\\])/\\$1/g;
  72                     if ($t ne '') {
  73                         $new =~ s/(['\\])/\\$1/g;
  74                         print OUT $t,
  75                           "eval 'sub $name {\n$t    ${args}eval \"$new\";\n$t}';\n";
  76                     }
  77                     else {
  78                         print OUT "sub $name {\n    ${args}eval \"$new\";\n}\n";
  79                     }
  80                     %curargs = ();
  81                 }
  82                 else {
  83                     s/^\s+//;
  84                     do expr();
  85                     $new = 1 if $new eq '';
  86                     if ($t ne '') {
  87                         $new =~ s/(['\\])/\\$1/g;
  88                         print OUT $t,"eval 'sub $name {",$new,";}';\n";
  89                     }
  90                     else {
  91                         print OUT $t,"sub $name {",$new,";}\n";
  92                     }
  93                 }
  94             }
  95             elsif (/^include\s+<(.*)>/) {
  96                 ($incl = $1) =~ s/\.h$/.ph/;
  97                 print OUT $t,"require '$incl';\n";
  98             }
  99             elsif (/^ifdef\s+(\w+)/) {
 100                 print OUT $t,"if (defined &$1) {\n";
 101                 $tab += 4;
 102                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 103             }
 104             elsif (/^ifndef\s+(\w+)/) {
 105                 print OUT $t,"if (!defined &$1) {\n";
 106                 $tab += 4;
 107                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 108             }
 109             elsif (s/^if\s+//) {
 110                 $new = '';
 111                 do expr();
 112                 print OUT $t,"if ($new) {\n";
 113                 $tab += 4;
 114                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 115             }
 116             elsif (s/^elif\s+//) {
 117                 $new = '';
 118                 do expr();
 119                 $tab -= 4;
 120                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 121                 print OUT $t,"}\n${t}elsif ($new) {\n";
 122                 $tab += 4;
 123                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 124             }
 125             elsif (/^else/) {
 126                 $tab -= 4;
 127                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 128                 print OUT $t,"}\n${t}else {\n";
 129                 $tab += 4;
 130                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 131             }
 132             elsif (/^endif/) {
 133                 $tab -= 4;
 134                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 135                 print OUT $t,"}\n";
 136             }
 137         }
 138     }
 139     print OUT "1;\n";
 140 }
 141
 142 sub expr {
 143     while ($_ ne '') {
 144         s/^(\s+)//              && do {$new .= ' '; next;};
 145         s/^(0x[0-9a-fA-F]+)[lL]?//  && do {$new .= $1; next;};
 146         s/^(\d+)[lL]?//         && do {$new .= $1; next;};
 147         s/^("(\\"|[^"])*")//    && do {$new .= $1; next;};
 148         s/^'((\\"|[^"])*)'//    && do {
 149             if ($curargs{$1}) {
 150                 $new .= "ord('\$$1')";
 151             }
 152             else {
 153                 $new .= "ord('$1')";
 154             }
 155             next;
 156         };
 157         s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
 158             $new .= '$sizeof';
 159             next;
 160         };
 161         s/^([_a-zA-Z]\w*)//     && do {
 162             $id = $1;
 163             if ($id eq 'struct') {
 164                 s/^\s+(\w+)//;
 165                 $id .= ' ' . $1;
 166                 $isatype{$id} = 1;
 167             }
 168             elsif ($id eq 'unsigned') {
 169                 s/^\s+(\w+)//;
 170                 $id .= ' ' . $1;
 171                 $isatype{$id} = 1;
 172             }
 173             if ($curargs{$id}) {
 174                 $new .= '$' . $id;
 175             }
 176             elsif ($id eq 'defined') {
 177                 $new .= 'defined';
 178             }
 179             elsif (/^\(/) {
 180                 s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;     # cheat
 181                 $new .= " &$id";
 182             }
 183             elsif ($isatype{$id}) {
 184                 if ($new =~ /{\s*$/) {
 185                     $new .= "'$id'";
 186                 }
 187                 elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
 188                     $new =~ s/\(\s*$//;
 189                     s/^[\s*]*\)//;
 190                 }
 191                 else {
 192                     $new .= $id;
 193                 }
 194             }
 195             else {
 196                 $new .= ' &' . $id;
 197             }
 198             next;
 199         };
 200         s/^(.)//                        && do {$new .= $1; next;};
 201     }
 202 }
 203 ##############################################################################
 204
 205         # These next few lines are legal in both Perl and nroff.
 206
 207 .00;                    # finish .ig
 208
 209 'di                     \" finish diversion--previous line must be blank
 210 .nr nl 0-1              \" fake up transition to first page again
 211 .nr % 0                 \" start at page 1
 212 '; __END__ ############# From here on it's a standard manual page ############
 213 .TH H2PH 1 "August 8, 1990"
 214 .AT 3
 215 .SH NAME
 216 h2ph \- convert .h C header files to .ph Perl header files
 217 .SH SYNOPSIS
 218 .B h2ph [headerfiles]
 219 .SH DESCRIPTION
 220 .I h2ph
 221 converts any C header files specified to the corresponding Perl header file
 222 format.
 223 It is most easily run while in /usr/include:
 224 .nf
 225
 226         cd /usr/include; h2ph * sys/*
 227
 228 .fi
 229 If run with no arguments, filters standard input to standard output.
 230 .SH ENVIRONMENT
 231 No environment variables are used.
 232 .SH FILES
 233 /usr/include/*.h
 234 .br
 235 /usr/include/sys/*.h
 236 .br
 237 etc.
 238 .SH AUTHOR
 239 Larry Wall
 240 .SH "SEE ALSO"
 241 perl(1)
 242 .SH DIAGNOSTICS
 243 The usual warnings if it can't read or write the files involved.
 244 .SH BUGS
 245 Doesn't construct the %sizeof array for you.
 246 .PP
 247 It doesn't handle all C constructs, but it does attempt to isolate
 248 definitions inside evals so that you can get at the definitions
 249 that it can translate.
 250 .PP
 251 It's only intended as a rough tool.
 252 You may need to dicker with the files produced.
 253 .ex