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 = '$installprivlib';
  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                             $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
  90                             $curargs{$arg} = 1;
  91                         }
  92                         $args =~ s/\b(\w)/\$$1/g;
  93                         $args = "local($args) = \@_;\n$t    ";
  94                     }
  95                     s/^\s+//;
  96                     do expr();
  97                     $new =~ s/(["\\])/\\$1/g;
  98                     if ($t ne '') {
  99                         $new =~ s/(['\\])/\\$1/g;
 100                         print OUT $t,
 101                           "eval 'sub $name {\n$t    ${args}eval \"$new\";\n$t}';\n";
 102                     }
 103                     else {
 104                         print OUT "sub $name {\n    ${args}eval \"$new\";\n}\n";
 105                     }
 106                     %curargs = ();
 107                 }
 108                 else {
 109                     s/^\s+//;
 110                     do expr();
 111                     $new = 1 if $new eq '';
 112                     if ($t ne '') {
 113                         $new =~ s/(['\\])/\\$1/g;
 114                         print OUT $t,"eval 'sub $name {",$new,";}';\n";
 115                     }
 116                     else {
 117                         print OUT $t,"sub $name {",$new,";}\n";
 118                     }
 119                 }
 120             }
 121             elsif (/^include\s+<(.*)>/) {
 122                 ($incl = $1) =~ s/\.h$/.ph/;
 123                 print OUT $t,"require '$incl';\n";
 124             }
 125             elsif (/^ifdef\s+(\w+)/) {
 126                 print OUT $t,"if (defined &$1) {\n";
 127                 $tab += 4;
 128                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 129             }
 130             elsif (/^ifndef\s+(\w+)/) {
 131                 print OUT $t,"if (!defined &$1) {\n";
 132                 $tab += 4;
 133                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 134             }
 135             elsif (s/^if\s+//) {
 136                 $new = '';
 137                 do expr();
 138                 print OUT $t,"if ($new) {\n";
 139                 $tab += 4;
 140                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 141             }
 142             elsif (s/^elif\s+//) {
 143                 $new = '';
 144                 do expr();
 145                 $tab -= 4;
 146                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 147                 print OUT $t,"}\n${t}elsif ($new) {\n";
 148                 $tab += 4;
 149                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 150             }
 151             elsif (/^else/) {
 152                 $tab -= 4;
 153                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 154                 print OUT $t,"}\n${t}else {\n";
 155                 $tab += 4;
 156                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 157             }
 158             elsif (/^endif/) {
 159                 $tab -= 4;
 160                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
 161                 print OUT $t,"}\n";
 162             }
 163         }
 164     }
 165     print OUT "1;\n";
 166 }
 167
 168 sub expr {
 169     while ($_ ne '') {
 170         s/^(\s+)//              && do {$new .= ' '; next;};
 171         s/^(0x[0-9a-fA-F]+)//   && do {$new .= $1; next;};
 172         s/^(\d+)//              && do {$new .= $1; next;};
 173         s/^("(\\"|[^"])*")//    && do {$new .= $1; next;};
 174         s/^'((\\"|[^"])*)'//    && do {
 175             if ($curargs{$1}) {
 176                 $new .= "ord('\$$1')";
 177             }
 178             else {
 179                 $new .= "ord('$1')";
 180             }
 181             next;
 182         };
 183         s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
 184             $new .= '$sizeof';
 185             next;
 186         };
 187         s/^([_a-zA-Z]\w*)//     && do {
 188             $id = $1;
 189             if ($id eq 'struct') {
 190                 s/^\s+(\w+)//;
 191                 $id .= ' ' . $1;
 192                 $isatype{$id} = 1;
 193             }
 194             elsif ($id eq 'unsigned') {
 195                 s/^\s+(\w+)//;
 196                 $id .= ' ' . $1;
 197                 $isatype{$id} = 1;
 198             }
 199             if ($curargs{$id}) {
 200                 $new .= '$' . $id;
 201             }
 202             elsif ($id eq 'defined') {
 203                 $new .= 'defined';
 204             }
 205             elsif (/^\(/) {
 206                 s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;     # cheat
 207                 $new .= " &$id";
 208             }
 209             elsif ($isatype{$id}) {
 210                 if ($new =~ /{\s*$/) {
 211                     $new .= "'$id'";
 212                 }
 213                 elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
 214                     $new =~ s/\(\s*$//;
 215                     s/^[\s*]*\)//;
 216                 }
 217                 else {
 218                     $new .= $id;
 219                 }
 220             }
 221             else {
 222                 $new .= ' &' . $id;
 223             }
 224             next;
 225         };
 226         s/^(.)//                        && do {$new .= $1; next;};
 227     }
 228 }
 229 ##############################################################################
 230
 231         # These next few lines are legal in both Perl and nroff.
 232
 233 .00;                    # finish .ig
 234
 235 'di                     \" finish diversion--previous line must be blank
 236 .nr nl 0-1              \" fake up transition to first page again
 237 .nr % 0                 \" start at page 1
 238 '; __END__ ############# From here on it's a standard manual page ############
 239 .TH H2PH 1 "August 8, 1990"
 240 .AT 3
 241 .SH NAME
 242 h2ph \- convert .h C header files to .ph Perl header files
 243 .SH SYNOPSIS
 244 .B h2ph [headerfiles]
 245 .SH DESCRIPTION
 246 .I h2ph
 247 converts any C header files specified to the corresponding Perl header file
 248 format.
 249 It is most easily run while in /usr/include:
 250 .nf
 251
 252         cd /usr/include; h2ph * sys/*
 253
 254 .fi
 255 If run with no arguments, filters standard input to standard output.
 256 .SH ENVIRONMENT
 257 No environment variables are used.
 258 .SH FILES
 259 /usr/include/*.h
 260 .br
 261 /usr/include/sys/*.h
 262 .br
 263 etc.
 264 .SH AUTHOR
 265 Larry Wall
 266 .SH "SEE ALSO"
 267 perl(1)
 268 .SH DIAGNOSTICS
 269 The usual warnings if it can't read or write the files involved.
 270 .SH BUGS
 271 Doesn't construct the %sizeof array for you.
 272 .PP
 273 It doesn't handle all C constructs, but it does attempt to isolate
 274 definitions inside evals so that you can get at the definitions
 275 that it can translate.
 276 .PP
 277 It's only intended as a rough tool.
 278 You may need to dicker with the files produced.
 279 .ex
 280 !NO!SUBS!
 281 chmod 755 h2ph
 282 $eunicefix h2ph
 283 rm -f h2ph.man
 284 ln h2ph h2ph.man