#!/usr/bin/perl # # Compares two core database files, producing a directory with all of the # changes in the new core. The format of this directory is suitable for # consumption by the corepatch program. # # $Header$ #use strict; use warnings; if (@ARGV != 2) { print STDERR "Usage: $0 new_core.db old_core.db\n"; exit 1; } my $new_db = new MooDatabase(Database => $ARGV[0]); #my $old_db = new MooDatabase(Database => $ARGV[1]); $new_db->Debug(); #$old_db->Debug(); { package MooValue; my @typenames = qw(INT OBJ STR ERR LIST CLEAR NONE CATCH FINALLY FLOAT); sub new { my ($class, %args) = @_; my $self = {}; bless($self, $class); # Initialize all the values we are going to use $self->{Type} = -1; $self->{Value} = ""; $self->{ListSize} = -1; $self->{ListValues} = ""; $self->read_database($args{DbFile}); return $self; } sub read_database { my ($self, $dbfile) = @_; while (<$dbfile>) { chomp; $self->{Type} = $_; # This is how an unassigned property is shown. if ($self->{Type} == 5) { $self->{Value} = 0; return; } # These are INT, OBJ, STR and FLOAT respectively, they have simple # values which are stored on a single line. if (($self->{Type} >= 0 && $self->{Type} <= 3) || $self->{Type} == 9) { $_ = <$dbfile>; chop; $self->{Value} = $_; return; } # Lists are much more complex little buggers if ($self->{Type} == 4) { # The next line is the number of items in the list. $_ = <$dbfile>; chop; $self->{ListSize} = int($_); my @values = (); for (my $i = 0; $i < $self->{ListSize}; $i++) { my $list_item = new MooValue(DbFile => $dbfile); push(@values, $list_item); } $self->{ListValues} = \@values; return; } # These are all elements which should never appear in the database. die("A value with an unsupported type ($self->{Type}) was encountered in the database.\n"); } } sub Debug { my $self = shift; if ($self->{Type} == 4) { print STDERR "Type=4 Size=".$self->{ListSize}." LIST=\n{"; for (my $i = 0; $i < $self->{ListSize}; $i++) { my $item = $self->{ListValues}[$i]; print STDERR "\n"; $item->Debug(); } print STDERR "\n}"; } else { print STDERR "Type=$self->{Type} Value=$self->{Value}"; } } } { package MooVerb; sub new { my ($class, %args) = @_; my $self = {}; bless($self, $class); $self->{Name} = ""; $self->{Owner} = -1; $self->{Flags} = -1; $self->{Source} = ""; $self->read_database($args{DbFile}); return $self; } sub read_database { my ($self, $dbfile) = @_; # Name of the verb chomp($self->{Name} = <$dbfile>); # Verb owner chomp($self->{Owner} = <$dbfile>); # Verb flags chomp($self->{Flags} = <$dbfile>); # Proposition arguments (unused by lily) $_ = <$dbfile>; } sub read_verbcode { my ($self, $dbfile) = @_; my @verbcode; while (<$dbfile>) { chop; last if (/^\.$/); push(@verbcode, $_); } $self->{Source} = \@verbcode; } sub Debug { my $self = shift; print STDERR "VERB: $self->{Name} OWNER=$self->{Owner} FLAGS=$self->{Flags}, LINES=$self->{Source}\n"; } } { package MooProperty; sub new { my ($class, %args) = @_; my $self = {}; bless($self, $class); $self->{Name} = ""; $self->{Owner} = -1; $self->{Flags} = -1; $self->{Value} = ""; $self->read_database($args{DbFile}); return $self; } sub read_database { my ($self, $dbfile) = @_; # Name of the property chomp($self->{Name} = <$dbfile>); } sub read_value { my ($self, $dbfile) = @_; my $value = new MooValue(DbFile => $dbfile); $self->{Value} = $value; } sub read_perms { my ($self, $dbfile) = @_; # Owner of the property chomp($self->{Owner} = <$dbfile>); # Flags associated with this property chomp($self->{Flags} = <$dbfile>); } sub Debug { my $self = shift; print STDERR "PROP: $self->{Name} Owner=$self->{Owner} Flags=$self->{Flags} "; if (defined $self->{Value}) { $self->{Value}->Debug(); } print STDERR "\n"; } } { package MooObject; sub new { my ($class, %args) = @_; my $self = {}; bless($self, $class); $self->{ObjID} = -1; $self->{Name} = ""; $self->{Flags} = -1; $self->{Owner} = -1; $self->{Parent} = -1; $self->{FirstChild} = -1; $self->{SiblingChild} = -1; $self->{VerbCount} = -1; $self->{PropertyCount} = -1; $self->{Verbs} = -1; $self->{Properties} = -1; $self->{Objects} = $args{Objects}; $self->read_database($args{DbFile}); return $self; } sub read_database { my ($self, $dbfile) = @_; # Object number chomp($self->{ObjID} = <$dbfile>); # Object name string chomp($self->{Name} = <$dbfile>); # Ignore this string $_ = <$dbfile>; # Object attribute flags chomp($self->{Flags} = <$dbfile>); # Owning object number chomp($self->{Owner} = <$dbfile>); # The next three should all be -1, since lily does not use location, # contents, or location contents. $_ = <$dbfile>; if (int($_) != -1) { die("Objects cannot have location in lily.\n"); } $_ = <$dbfile>; if (int($_) != -1) { die("Objects cannot have contents in lily.\n"); } $_ = <$dbfile>; if (int($_) != -1) { die("Objects cannot have location contents in lily.\n"); } # Owning object number chomp($self->{Parent} = <$dbfile>); # First in the list of child objects, or -1 for none. chomp($self->{FirstChild} = <$dbfile>); # First in the list of sibling objects, or -1 for none. chomp($self->{SiblingChild} = <$dbfile>); # Number of verbs for this object, programmed or not. chomp($self->{VerbCount} = <$dbfile>); my @verbs = (); # Create verb objects out of the meta data. for (my $i = 0; $i < $self->{VerbCount}; $i++) { my $verb = new MooVerb( DbFile => $dbfile ); push(@verbs, $verb); } $self->{Verbs} = \@verbs; # Number of properties for this object. chomp($self->{PropertyCount} = <$dbfile>); my @props = (); # Create property objects with the names for (my $i = 0; $i < $self->{PropertyCount}; $i++) { my $prop = new MooProperty( DbFile => $dbfile ); push(@props, $prop); } $self->{Properties} = \@props; my $values_count = <$dbfile>; ### ### TODO: Add support for inhereted properties. ### if ($values_count > $self->{PropertyCount}) { print STDERR "WARNING: Difference between properties and objects\n"; # die("Difference betwen values and properties.\n"); } # Load the value and permissions for each property, strangely stored # separately. for (my $i = 0; $i < $values_count; $i++) { if ($i < $self->{PropertyCount}) { my $prop = $self->{Properties}[$i]; $prop->read_value($dbfile); $prop->read_perms($dbfile); } else { my $value = new MooValue(DbFile => $dbfile); chomp($_ = <$dbfile>); chomp($_ = <$dbfile>); } } } sub read_verbcode { my ($self, $verbid, $dbfile) = @_; my $verb = $self->{Verbs}[$verbid]; $verb->read_verbcode($dbfile); } sub Debug { my $self = shift; print STDERR "\n\nOBJECT: ObjId=$self->{ObjID} Name=$self->{Name} Flags=$self->{Flags} Owner=$self->{Owner} Parent=$self->{Parent} Verbs=$self->{VerbCount} Properties=".$self->{PropertyCount}."\n\n"; for (my $i = 0; $i < $self->{VerbCount}; $i++) { $self->{Verbs}[$i]->Debug(); } for (my $i = 0; $i < $self->{PropertyCount}; $i++) { $self->{Properties}[$i]->Debug(); } } } { package MooDatabase; sub new { my ($class, %args) = @_; my $self = {}; bless($self, $class); $self->read_database($args{Database}); return $self; } sub read_database { my ($self, $dbfile) = @_; open($dbfile, "<$dbfile") || die("Unable to open the MOO database for reading ($dbfile): $!\n"); # Version string chomp($self->{DbVersion} = <$dbfile>); # Total number of objects chomp($self->{ObjectCount} = <$dbfile>); # Total number of verbs chomp($self->{VerbCount} = <$dbfile>); # This is a "dummy" value (see db_file.c) $_ = <$dbfile>; # Total number of user objects chomp($self->{PlayerCount} = <$dbfile>); # The list of objects marked as type "player" my @players = (); for (my $i = 0; $i < $self->{PlayerCount}; $i++) { chomp($_ = <$dbfile>); push(@players, $_); } $self->{Players} = \@players; # Read each of the objects my @objects = (); for (my $i = 0; $i < $self->{ObjectCount}; $i++) { my $obj = new MooObject(DbFile => $dbfile, Objects => \@objects); push(@objects, $obj); } $self->{Objects} = \@objects; # Read each of the verbs while (<$dbfile>) { chomp; # The verb tag line is "#n:n". if (/^\#(\d+):(\d+)/) { my $oid = $1; my $vid = $2; my $obj = $objects[$oid]; $obj->read_verbcode($vid, $dbfile); } else { chop; print STDERR "FINI: last line is [$_]\n"; return; } } # Read the suspended tasks list # FINI! close($dbfile); } sub Debug { my $self = shift; print STDERR "DB VERSION: [$self->{DbVersion}]\nOBJECTS: $self->{ObjectCount}\nVERBS: $self->{VerbCount}\nPLAYERS: $self->{PlayerCount}\nPlayers (".join(",", $self->{Players}).")\n\n"; for (my $i = 0; $i < $self->{ObjectCount}; $i++) { $self->{Objects}[$i]->Debug(); } } } # $Log$ #