[497] in Coldmud discussion meeting
Re: driver database dumping
daemon@ATHENA.MIT.EDU (Mon Oct 31 19:40:44 1994
)
To: rayn@crossaccess.com
Date: Tue, 1 Nov 1994 05:34:18 -0500 (EST)
Cc: coldstuff@MIT.EDU
In-Reply-To: <9411010002.AA12115@q.crossaccess.com> from "rayn@crossaccess.com" at Oct 31, 94 04:02:28 pm
From: colinm@ozemail.com.au (Colin McCormack)
Reply-To: colinm@ozemail.com.au
> re: dumping objects with dbref instead of obnum.
>
> This would be nice, especially if it allowed renumbering.
I hacked Zach's (?) dumpsplit to produce symbolic stuff.
It's not 100% but it's about 99.9% (there are degenerate cases)
Enjoy.
Colin.
#!/usr/bin/perl
$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}.c--") || 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";