🚀 go-pugleaf

I wrote the following perl script to fix include files on a MIPS
RISCos 5.0 system, since, as described in my last message, the include
hierarchy is too complicated for the existing script.

#!/usr/local/bin/perl

$myname = 'fixincludes.riscos';

die("Usage is: $myname destdir default\n") if $#ARGV != 1;
$dest = $ARGV[0];
$default = $ARGV[1];

@inctrees = ('/usr/bsd43/usr/include',
	     '/usr/svr4/usr/include',
	     '/usr/svr3/usr/include',
	     '/usr/RISCwindows4.1/include');
$new{'/usr/bsd43/usr/include'} = 'bsd43.include';
$new{'/usr/svr4/usr/include'}  = 'svr4.include';
$new{'/usr/svr3/usr/include'}  = 'svr3.include';
$new{'/usr/RISCwindows4.1/include'} = 'RISCwindows4.1.include';

sub path {
  local($linkfromdir, $linktodir) = @_;
  local($linktopwd, @t, @f, $i);
  chdir($linkfromdir)
      || die("$myname: $!, chdir $linkfromdir\n");
  chdir($linktodir)
      || die("$myname: $!, chdir $linktodir\n");
  $linktopwd = `pwd`;
  chop($linktopwd);
  if ($linktopwd eq $linkfromdir) {
    return '.';
  }
  elsif ($linktopwd eq $inctree) {
    # to the head of the tree we're copying now
    @f = split(m=/=, substr($linkfromdir, length($inctree)+1));
    return '../' x $#f;
  }
  elsif ($linktopwd =~ m=^$inctree/=) {
    # within the tree we're copying now
    @t = split(m=/=, $');
    @f = split(m=/=, substr($linkfromdir, length($inctree)+1));
    for ($i = 0; $i <= $#t && $i <= $#f && $t[$i] eq $f[$i]; $i += 1) {
    }
    return ('../' x ($#f - $i + 1)) . join('/', @t[$i..$#t]);
  }
  else {
    foreach $i (@inctrees) {
      if ($linktopwd eq $i) {
	# to a different include tree
	@f = split(m=/=, substr($linkfromdir, length($inctree)+1));
	return ('../' x ($#f + 2)) . $new{$i};
      }
      elsif ($linktopwd =~ m=^$i/=) {
	# within a different include tree
	@f = split(m=/=, substr($linkfromdir, length($inctree)+1));
	return ('../' x ($#f + 2)) . $new{$i} . '/' . $';
      }
    }
    print STDERR "$myname: link to outside standard include trees:\n  $linkfromdir -> $linktodir\n";
    $linktopwd;
  }
};

sub fixlink {
  local($srcdir, $dstdir, $name) = @_;
  local($l, @l, $new);
  if (-d "$srcdir/$name") {
    $new = &path($srcdir, "$srcdir/$name");
  }
  else {
    $l = readlink("$srcdir/$name");
    @l = split(m=/=, $l);
    $new = $#l == 0
	? $l
	: &path($srcdir, join('/', @l[0..$#l-1])) . '/' . $l[$#l];
  }
  $new = substr($new, 2) if substr($new, 0, 2) eq './';
  symlink($new, "$dstdir/$name")
      || die("$myname: $!, symlink $new $dstdir/$name\n");
};

sub fixfile {
  local($src, $dst) = @_;
  open (I, "<$src")
      || die("$myname: $!, opening $src for input\n");
  open (O, ">$dst")
      || die("$myname: $!, opening $dst for output\n");
  $s = 0;
  while (<I>) {
    chop;
    while (/\\$/) {
      $_ .= "\n";
      $_ .= <I>;
      chop;
    }
    if (/[ \t]_IO[A-Z]*[ \t]*\(/) {
      $s += s/\((.),/('$1',/;
    }
    if (/[ \t]BSD43__IO[A-Z]*[ \t]*\(/) {
      $s += s/\((.),/('$1',/;
    }
    if (/#define._IO/) {
      $s += s/'x'/x/g;
    }
    if (/#define.BSD43__IO/) {
      $s += s/'x'/x/g;
    }
    if (/[^A-Z]CTRL[ \t]*\(/) {
      $s += s/([^'])\)/'$1')/;
    }
    if (/#define.CTRL/) {
      $s += s/'c'/c/g;
    }
    if (/#define._CTRL/) {
      $s += s/'c'/c/g;
    }
    if (/#define.BSD43_CTRL/) {
      $s += s/'c'/c/g;
    }
    if (/#[a-z]*if.*[\t \(]m68k/) {
      $s += s/([^_])m68k/$1__m68k__/g;
    }
    if (/#[a-z]*if.*[\t \(]__i386/) {
      $s += s/__i386/__i386__/g;
    }
    if (/#[a-z]*if.*[\t \(]i386/) {
      $s += s/([^_])i386/$1__i386__/g;
    }
    if (/#[a-z]*if.*[\t \(]sparc/) {
      $s += s/([^_])sparc/$1__sparc__/g;
    }
    if (/#[a-z]*if.*[\t \(]mc68000/) {
      $s += s/([^_])mc68000/$1__mc68000__/g;
    }
    if (/#[a-z]*if.*[\t \(]vax/) {
      $s += s/([^_])vax/$1__vax__/g;
    }
    if (/#[a-z]*if.*[\t \(]sun/) {
      $s += s/([^_])(sun[a-z0-9]*)([^a-z0-9_])/$1__$2__$3/g;
    }
    if (/#[a-z]*if.*[\t \(]sun/) {
      $s += s/([^_])(sun[a-z0-9]*)$/$1__$2__/g;
    }
    if (/#[a-z]*if.*[\t \(]ns32000/) {
      $s += s/([^_])ns32000/$1__ns32000__/g;
    }
    if (/#[a-z]*if.*[\t \(]pyr/) {
      $s += s/([^_])pyr/$1__pyr__/g;
    }
    if (/#[a-z]*if.*[\t \(]is68k/) {
      $s += s/([^_])is68k/$1__is68k__/g;
    }
    if (/^#define.NULL[ \t]/) {
      $_ .= "\n#undef NULL";
      $s += 1;
    }
    print O $_,"\n";
  }
  close (I);
  close (O);
  unlink ($dst) if $s == 0;
};

sub fixdir {
  local($src, $dst) = @_;
  local(@d, $d);
  opendir (D, $src)
      || die("$myname: $!, opening $src\n");
  @d = readdir(D);
  closedir (D);
  mkdir($dst,0777)
      || die("$myname: $!, mkdir $dst\n");
  foreach $d (@d) {
    if ($d eq '.' || $d eq '..') {
      # ignore
    }
    elsif (-l "$src/$d") {
      &fixlink($src, $dst, $d);
    }
    elsif (-f "$src/$d") {
      &fixfile("$src/$d", "$dst/$d");
    }
    elsif (-d "$src/$d") {
      &fixdir("$src/$d", "$dst/$d");
    }
  }
};

sub clean {
  local($dir) = @_;
  local(@d, $d, $n, $e);
  chdir($dir)
      || die("$myname: $!, chdir $dir\n");
  $dir = `pwd`;
  chop($dir);
  return $clean{$dir} if defined($clean{$dir});
  opendir (D, '.')
      || die("$myname: $!, opening $dir\n");
  @d = readdir(D);
  closedir (D);
  $clean{$dir} = $#d;
  $n = 0;
  foreach $d (@d) {
    $e = "$dir/$d";
    if ($d eq '.' || $d eq '..') {
      # ignore
    }
    elsif (-d $e) {
      if (&clean($e) != 0) {
	$n += 1;
      }
      elsif (-l $e) {
	unlink($e)
	    || die("$myname: $!, unlink $e\n");
      }
      else {
	rmdir($e)
	    || die("$myname: $!, rmdir $e\n");
      }
    }
    elsif (-e $e) {
      $n += 1;
    }
    else {
      unlink($e)
	  || die("$myname: $!, unlink $e\n");
    }
  }
  $clean{$dir} = $n;
  $n;
};

foreach $inctree (@inctrees) {
  &fixdir($inctree, "$dest/$new{$inctree}");
}

foreach $inctree (@inctrees) {
  &clean("$dest/$new{$inctree}");
}

opendir(D, "$dest/$default")
    || die("$myname: $!, opening $dest/$default\n");
@d = readdir(D);
closedir(D);
chdir("$dest/include")
    || die("$myname: $!, chdir $dest/include\n");
foreach $d (@d) {
  if (! -e $d) {
    symlink("../$default/$d", $d)
	|| die("$myname: $!, symlink ../$default/$d $d\n");
  }
}

# 
# Local Variables:
# mode:perl
# perl-indent-level:2
# End: