#!/afs/athena/contrib/perl/perl
#
# This script inlines require'd files into scripts.
#
# by bert Dvornik <bert@mit.edu>, Watchmaker Zone Night Patrol
#
# $Header: /mit/bert/project/volmove/RCS/compactify.pl,v 1.2 1996/05/15 14:03:15 bert Exp $

$rcsid = '$Id: compactify.pl,v 1.2 1996/05/15 14:03:15 bert Exp $';
push(@RCSID, $rcsid);

require('ctime.pl');

$prog = $0;  $prog =~ s@^.*/([^/]+)$@\1@;

$divider = '#*#*#*#';
$longdivider = '#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#';

while (@ARGV) {
    &file(shift(@ARGV));
}
&trailer;

### other subroutines

sub header {
  local($shell) = @_;

  print <<"EndOfHeader";
$shell
### This file has been automatically generated by $prog.
push(\@RCSID, '$rcsid [generating script]');
### Do not edit by hand; edit source files instead.
### (List of source files included in this program is appended at the end.)

$divider (top level)     $longdivider

EndOfHeader
  $have_header++;
}

sub trailer {
  print "\n$divider (top level)     $longdivider\n\n### Inlined files:\n";

  for (sort {$file_list{$a} cmp $file_list{$b}} (keys %file_list)) {
      printf "###       %-12s %s\n", $file_list{$_}, $_;
  }

  print "### Generated on " . &ctime(time);
}

sub file {
  local($file) = @_;
  local(*FILE);

  local($short) = $file;
  $short =~ s@^.*/@@g;
  $file_list{$file} = $short;

  open(FILE, $file);
  &header(scalar(<FILE>)) unless $have_header;

LINE:
  while (<FILE>) {
     {
       /\bunshift\s*\(\s*@?INC\s*,\s*'[^']+'\s*\)\s*;/ && (&setval, next LINE);
       /\bunshift\s*\(\s*@?INC\s*,\s*"[^"]+"\s*\)\s*;/ && (&setval, next LINE);
       /\bpush\s*\(\s*@?INC\s*,\s*'[^']+'\s*\)\s*;/    && (&setval, next LINE);
       /\bpush\s*\(\s*@?INC\s*,\s*"[^"]+"\s*\)\s*;/    && (&setval, next LINE);
     }

     {
       /\brequire\s*\(\s*'([^']+)'\s*\)\s*;/   && (&inline($1), next LINE);
       /\brequire\s*\(\s*"([^"]+)"\s*\)\s*;/   && (&inline($1), next LINE);
     }

     {
       /\bINC\b/ && warn "Script modifies INC in an unrecognized way\n" .
         "   (line $. in $file$context)\n   continuing";
       /\brequire\b/ && warn "Script uses require() in an unrecognized way\n" .
         "   (line $. in $file$context)\n   continuing";
     }
     print;
  }
  close(FILE);
}

sub setval {
    local($pre,$set,$post) = ($`,$&,$');

    if ($pre =~ /#/) {
	print "$`\n";
	return;
    }

    print "$pre\n" unless ($pre =~ /^\s*$/);

    print "$divider (disabled by $prog)\n# $set\n$divider\n";
    eval $set || die "Can't evaluate expression\naborting";

    $post =~ s/\n+$//;
    print "$post\n" unless ($post =~ /^\s*$/);
    print "\n";
}

sub inline {
    local($name) = @_;
    local($context) = ", require'd from $file line $." . $context;
    local($lvl) = $lvl + 1;

    local($xname, $path) = $name;
    $xname =~ tr/a-z/A-Z/;
    $xname =~ tr/./_/;

    if ($INLINED{$name}) {
	warn "$name is inlined more than once.\ncontinuing";
	return;
    }

  PATH:
    foreach $path (@INC) {
	if (-f "$path/$name") {
	    print <<"EndOfFileHeader";
$divider include level $lvl $longdivider
\$compactify'result = eval <<'END_OF_$xname';
$divider $name$context
EndOfFileHeader

            &file("$path/$name");

	    print <<"EndOfFileTrailer";
$divider end of $name
END_OF_$xname
die "while evaluating $name: \$@" if \$@;
die "evaluating $name did not return true value" unless \$compactify'result;
$divider end of level $lvl  $longdivider
EndOfFileTrailer

	    $INLINED{$name} = "$path/$name";
	    last PATH;
	}
    }
    die "Can't find $name in \@INC" unless $INLINED{$name};
}
