#!/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";