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