#!/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$
#