#!/usr/bin/perl
#
# initial script by Zachary
#
# additions by Colin

$debug=0;
$conservative=0; # won't touch vars with quotes in 'em
$|=1;

# check we're being called properly
$USAGE = "Usage: $0 <textdump> <name-to-pointer file>\n";
($textdump = $ARGV[0]) || die " $USAGE No textdump specified.\n";
($numfile = $ARGV[1]) || die " $USAGE No namefile specified.\n";

# define the save-an-object subroutine
sub saveanobj { 
      chop($num);
      $debug && print "**************** SAVING OBJECT $num FOUND **************\n";
      print NAMES "name $name{$num} ${num}\n";
      open(OUT,">>$name{$num}.coldc") || die "Current directory unwriteable.";
      print OUT @parents;
      print OUT @buffer; 
      close(OUT);
      undef @buffer;
      undef @parents;
      undef $num;
}

# start the processing
open(IN,$textdump) || die "Invalid or unreadable textdump \"$textdump\"";
open(NAMES,">>$numfile") || die "Current directory unwriteable.";

print "Name Pass... ";
while (<IN>) {
    if (/^name (.+) ([0-9]+)$/) {
	$name{$2}=$1;
    }
}
close(IN);

print "\nWorking... ";
open(IN,$textdump) || die "Invalid or unreadable textdump \"$textdump\"";
while (<IN>) {
  if (!$debug) {
    # show a cute whriling counter thing to show that it's working...
    (!($. % 500)) && print "\b. ";
    $foo = ("-","\\","|","/")[$. % 4]; print "\b$foo";
  }
  # do actual work 
  $debug && print ">";
  if (/^name (.+) ([0-9]+)$/) {
    $debug && print "******************* NAME FOUND ********************\n";
  } elsif (/^parent \#([0-9]+)/) {
    $debug && print "**** FOUND PARENT ***";
    if ($num) {
      &saveanobj;
    }
    @parents=(@parents,"parent \$$name{$1}\n");
  } elsif (/^object \#([0-9]+)/) {
    $debug && print "*********** FOUND OBJECT # $1 ****************\n";
    $num="${1}X";
    @buffer = ("object \$$name{$1}\n");
  } elsif ($conservative && /^var (.*)\"/) {
    $debug && print "*********** FOUND LITERAL VAR ****************\n";
    @buffer = (@buffer, $_);
  } elsif (/^var ([0-9]+)/) {
    $debug && print "*********** FOUND VAR ****************\n";
    $_ = "var \$$name{$1}$'";
    while (/^(.+)\#([0-9]+)/) {
	$_ = "$1\$$name{$2}$'";
    }
    @buffer = (@buffer, $_);
  } else {
    @buffer = (@buffer, $_);   
  }
  $debug && print "$_";
}
close(IN);
if ($num) {
  &saveanobj;
}
close(NAMES);
print "\bDone.\n";