[497] in Coldmud discussion meeting

root meeting help first first in chain previous in chain previous next next in chain last in chain last

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";