h2ph.SH

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