#!/opt/perl/bin/perl -w
# Module to maintain Intermud information in a DataBase
# $Date: 2003/04/05 07:12:33 $ $Revision: 1.3 $
#
use strict;
package MUD::Intermud::DB;
use DBI;
use File::Spec;
use String::Approx;
use Data::Dumper;

##############################################################################
# Object functions

sub new
{
    # Create new MUD::Intermud::DB
    # Parameter: Class-Name/Reference, Properties
    my $class = shift;
    $class = ref($class) || $class;
    my $self = {};
    bless($self, $class);
    $self->init(@_) or die "Can't initialise database\n";
    return $self;
}

my $databasehandle;
my $databasefile;
my $databasesource;
my $errormsg;
my $intermudtype;

sub init
{
    # Create a new object
    # Parameter: Object, Params
    my ($dbobj, $params) = @_;

    $databasehandle = 'databasehandle';
    $databasefile = 'databasefile';
    $databasesource = 'databasesource';
    $errormsg = 'errormessage';
    $intermudtype = 'intermudtype';

    my $filename = $params->{'dbname'} or die "No database filename supplied.\n";
    $dbobj->{'DEBUG'} = $params->{'DEBUG'} or $dbobj->{'DEBUG'} = 'off';
    $dbobj->{'logpath'} = $params->{'logpath'} or 
	$dbobj->{'logpath'} = '/home/castaway/perl/log';
#    $dbobj->{'intermudtype'} = $params->{'intermudtype'} or 
#	$dbobj->{'intermudtype'} = 'i3';

    print "FN: $filename\n";
    print "DEBUG: " . $dbobj->{'DEBUG'} . "\n";
#    print "intermudtype: " . $dbobj->{'intermudtype'} . "\n";

    $dbobj->{$databasesource} = 'dbi:SQLite:dbname=' . $filename;
    my $dbh = DBI->connect($dbobj->{'databasesource'}, undef, undef,
			   { AutoCommit => 0, PrintError => 0});

    if(!defined($dbh))
    {
	print DBI::errstr;
	return undef;
    }
    $dbobj->{$databasehandle} = $dbh;
    $dbobj->{$databasefile} = $filename;
    return 1;

}

sub createTables
{
    # Create all tables in database, when they don't exist
    # Parameter: Object
    my ($dbobj) = @_;

    my ($vol, $dir, $filename) = File::Spec->splitpath($dbobj->
						       {$databasefile});
    # Get table-filename
    $filename =~ s/\.db$/\.tab/;
    $filename = File::Spec->catfile($dir, $filename);
    print "FN: $filename\n";

    my $res = open(TABLES, "<", $filename);
    if(!defined($res))
    {
	$dbobj->{$errormsg} = "Can't open $filename: $!\n";
	return undef;
    }

    my $dbh = $dbobj->{$databasehandle};
    $dbobj->{$errormsg} = '';
    while(my $table = <TABLES>)
    {
	$dbobj->debug("createTables: $table");
	chomp($table);
	if($table =~ /^create table (\w+)/i)
	{
	    $dbobj->debug("SELECT COUNT(*) FROM $1\n");
	    $res = $dbh->do("SELECT COUNT(*) FROM $1");
	    if(defined($res))
	    {
		$dbobj->debug("DROP TABLE $1\n");
		$res = $dbh->do("DROP TABLE $1");
		if(!$res)
		{
		    print "Can't DROP $1\n";
		}
	    }
	    $dbobj->debug("$table\n");
	    $res = $dbh->do($table);
	    if(!defined($res))
	    {
		$dbobj->{$errormsg} .= "Error creating table: " . $dbh->errstr() . "\n";
	    }
	}
	elsif($table =~ /^insert into (\w+)/i)
	{
	    $dbobj->debug("SELECT COUNT(*) FROM $1\n");
	    $res = $dbh->do("SELECT COUNT(*) FROM $1");
	    if(!defined($res))
	    {
		print "$1 does not exist!\n";
		next;
	    }
	    $dbobj->debug("$table\n");
	    $res = $dbh->do($table);
	    if(!defined($res))
	    {
		$dbobj->{$errormsg} .= "Error creating table: " . $dbh->errstr() . "\n";
		print $dbobj->{$errormsg};
	    }
	}
    }
    
    if(length($dbobj->{$errormsg}))
    {
	return undef;
    }

    return 1;
}

sub recreateDatabase
{
    # Copy old file to 'name.old', create new original and copy data
    # Parameters: Object
    my ($dbobj) = @_;

    my $dbh = $dbobj->{$databasehandle};
    $dbh->commit();
    $dbh->disconnect();

    my ($vol, $dir, $filename) = File::Spec->splitpath($dbobj->
						       {$databasefile});
    my $oldfilename = "$filename.old";
    rename($filename, $oldfilename);
    # Get table-filename
    $filename =~ s/\.db$/\.tab/;
    $filename = File::Spec->catfile($dir, $filename);
    print "FN: $filename\n";

    my $res = open(TABLES, "<", $filename);
    if(!defined($res))
    {
	$dbobj->{$errormsg} = "Can't open $filename: $!\n";
	return undef;
    }

    $dbh = DBI->connect('dbi:SQLite:dbname=' . $filename, undef, undef,
			{ AutoCommit => 0, PrintError => 0});
    $dbobj->{$databasehandle} = $dbh;

    my $dbhold = DBI->connect('dbi:SQLite:dbname=' . $oldfilename, undef, undef,
			      { AutoCommit => 0, PrintError => 0});

    $dbobj->{$databasehandle} = $dbh;
    $dbobj->{$errormsg} = '';
    while(my $table = <TABLES>)
    {
	$dbobj->debug("createTables: $table");
	chomp($table);
	if($table =~ /^create table (\w+)/i)
	{
	    $dbobj->debug("SELECT COUNT(*) FROM $1\n");
	    $res = $dbh->do("SELECT COUNT(*) FROM $1");
	    if(defined($res))
	    {
		$dbobj->debug("DROP TABLE $1\n");
		$res = $dbh->do("DROP TABLE $1");
		if(!$res)
		{
		    print "Can't DROP $1\n";
		}
	    }
	    $dbobj->debug("$table\n");
	    $res = $dbh->do($table);
	    if(!defined($res))
	    {
		$dbobj->{$errormsg} .= "Error creating table: " . $dbh->errstr() . "\n";
	    }
	    my $stm = "SELECT * FROM $1";
	    $stm = $dbh->prepare($stm);
	    $res = '';
	}
	elsif($table =~ /^insert into (\w+)/i)
	{
	    $dbobj->debug("SELECT COUNT(*) FROM $1\n");
	    $res = $dbh->do("SELECT COUNT(*) FROM $1");
	    if(!defined($res))
	    {
		print "$1 does not exist!\n";
		next;
	    }
	    $dbobj->debug("$table\n");
	    $res = $dbh->do($table);
	    if(!defined($res))
	    {
		$dbobj->{$errormsg} .= "Error creating table: " . $dbh->errstr() . "\n";
		print $dbobj->{$errormsg};
	    }
	}
    }
    
    if(length($dbobj->{$errormsg}))
    {
	return undef;
    }

    return 1;

}

sub addMuds
{
    # Add/Update muds using a hash from P::RD
    # Parameter: Object, Type, Hash, UpdateId
    my ($dbobj, $type, $mudhash, $update_id, $update_from) = @_;

    if($type eq 'i3')
    {
	my $dbh = $dbobj->{$databasehandle};
	$dbh->commit();
	my @muds = keys %{$mudhash};
	foreach my $mud (@muds)
	{
#	    $dbobj->debug("Looking at: $mud\n");
	    next if $mudhash->{$mud} eq '0';
	    my @values = @{$mudhash->{$mud}};
	    my $libid = $dbobj->addRowToTable($values[5],
					      "Libraries",
					      "Name, Version",
					      2,
					      '(.+?)\s(v?\d+.*)');
#	    $dbobj->debug("Got LibId: $libid" . "\n") if $libid;
	    my $baselibid = $dbobj->addRowToTable($values[6],
						  "Libraries",
						  "Name, Version",
						  2,
						  '(.+?)\s(v?\d+.*)');
#	    $dbobj->debug("Got BaseLibId: $baselibid" . "\n") if $baselibid;
	    my $driverid = $dbobj->addRowToTable($values[7],
						 "Drivers",
						 "Name, Version", 
						 2,
						 '(.+?)\s(v?\d+.*)');
#	    $dbobj->debug("Got DriverId: $driverid" . "\n") if $driverid;
	    my $typeid = $dbobj->addRowToTable($values[8],
					       "Types",
					       "Name",
					       1,
					       '');
#	    $dbobj->debug("Got TypeId: $typeid" . "\n") if $typeid;
	    # Get MudID from Muds table with Name/IP, if it exists
	    my $mudid = $dbobj->getMudID($mud);
	    $dbobj->debug("Got MudId: $mudid\n") if $mudid;
	    if(defined($mudid) && $mudid < 0)
	    {
		$dbobj->debug("Error in getMudID($mud): " . 
			      $dbobj->{$errormsg} . "\n");
		$dbh->rollback();
		next;
	    }
	    my $mudip = $dbobj->getMudIP($mud);
	    if(defined($mudid) && length($mudip) > 0 && $values[1] ne $mudip)
	    {
	      $dbobj->debug("$mud changed IP! " . $dbobj->getMudIP($mud) .
			  "->" . $values[1] . "\n");
	    }
#	    if(!defined($mudid)) { $mudid = 'NULL'; }
		
	    my $res = $dbobj->updateTable("Muds", ["ID"], [$mudid],
					  ["Status", "IP_Address", 
					   "MudPort", "lib_id", "baselib_id", 
					   "type_id", "driver_id", 
					   "AdminEmail", "update_id"],
					  [$values[0], $values[1], 
					   $values[2], $libid, $baselibid, 
					   $driverid, $typeid, $values[10], 
					   $update_id]);
	    if(!$res)
	    {
		$dbobj->debug("No mud id!:" . $dbobj->{$errormsg} . "\n");
		$dbh->rollback();
		next;
	    }
	    $mudid = $res;
#	    $dbobj->debug("MudID: $mudid\n");

	    $res = $dbobj->updateTable("Intermud3", ["mud_id"], [$mudid],
				       ["mud_id", "Name", "LastContact",
					"OOBTcpPort", 
					"OOBUdpPort", "OpenStatus"],
				       [$mudid, $mud, time(),
					$values[3], $values[4], $values[9]]);
	    if(!$res)
	    {
		$dbobj->debug("No IntermudID!?\n" . $dbobj->{$errormsg} . "\n");
		$dbh->rollback();
		next;
	    }
	    my %services = %{$values[11]};
	    foreach my $service (keys %services)
	    {
		my $serviceid = $dbobj->getNameID("ServicesI3", $service);
		if(!$serviceid)
		{
		    $res = $dbobj->updateTable("ServicesI3", ["ID"], undef,
					       ["Name"], [$service]);
		    if(!$res)
		    {
			$dbobj->debug("Can't add i3 service!\n" .
				      $dbobj->{$errormsg} . "\n");
		    }
		    $serviceid = $res;
		}
#		$dbobj->debug("Service: $mudid, $service, $serviceid\n");
		$res = $dbobj->appendTable("MudServicesI3",
					   ["mud_id", "service_id", "Value"],
					   [$mudid, $serviceid, 
					    $services{$service}]);

	    }
	    if(!defined($libid) || !defined($baselibid) || 
		!defined($driverid))
	    {
		$dbobj->debug("Errors adding $mud\n");
		$dbh->rollback();
		next;
	    }		
	    $dbh->commit();
	}
    }
    elsif($type eq 'i2')
    {
	my $dbh = $dbobj->{$databasehandle};
	$dbh->commit();
	my @muds = keys %{$mudhash};
	$dbobj->debug(Dumper($mudhash));
	foreach my $mud (@muds)
	{
	    # values: IP, UDP Port, Mud Port, Status, Inetd, AdminEmail, 
	    # Commands, List, UpdateId .. ?
	    my $now = time();
	    my @values = @{$mudhash->{$mud}};
	    my $inetdid = $dbobj->addRowToTable($values[4],
					      "Inetds",
					      "Name, Version",
					      2,
					      '(.+?)\s(v?\d+.*)');
	    my $mudid = $dbobj->getMudID($mud);
	    if(defined($mudid) && $mudid < 0)
	    {
		$dbobj->debug("Error in getMudID($mud): " .
			      $dbobj->{$errormsg} . "\n");
		$dbh->rollback();
		next;
	    }

	    my $changeid = 'NULL';
	    my @ids = ('NULL', 'NULL', 'NULL', 'NULL');
	    if(defined($mudid))
	    {
		my $ipport = $dbobj->getIPPort('i2', 'UDP', 0, $mud);
		$dbobj->debug(Dumper($ipport));
		if(defined($mudid) && defined($ipport) && 
		   length($ipport->[1]) > 0 && 
		   $values[0] ne $ipport->[1])
		{
		    $dbobj->debug("$mud changed IP! " . $ipport->[1] .
				  "->" . $values[0] . "\n");
		    # Add to IPChanges table
		    my $fromid = $dbobj->getMudID($update_from);
		    if(!defined($fromid))
		    {
			$fromid = 0;
		    }
		    $changeid = $dbobj->appendTable("IPChanges",
		    ["From_id", "Date", "mud_id", "OldIP", "NewIP", "OldPort",
		     "NewPort"],
		    [$fromid, $now, $mudid, $ipport->[0], $values[0],
		     $ipport->[2], $values[1]]);
		    if(!defined($changeid))
		    {
			$dbobj->debug("Can't add to IPChanges! " . 
				      $dbobj->{$errormsg} . "\n");
			$changeid = 'NULL';
		    }
		}

		# If id then get lib_id, etc!
		my $res = $dbobj->getValues('Muds', 'ID', $mudid,
					    'lib_id', 'baselib_id',
					    'type_id', 'driver_id');
		if(defined($res))
		{
		    @ids = @{$res};
		}
	    }
	    my $res = $dbobj->updateTable("Muds", ["ID"], [$mudid],
					  ["Status", "IP_Address", 
					   "MudPort", "lib_id", "baselib_id", 
					   "type_id", "driver_id", 
					   "AdminEmail", "update_id"],
					  [$values[3], $values[0], 
					   $values[2], @ids, 
					   $values[5], $update_id]);
	    if(!$res)
	    {
		$dbobj->debug("No mud id!:" . $dbobj->{$errormsg} . "\n");
		$dbh->rollback();
		next;
	    }
	    $mudid = $res;

	    $res = $dbobj->updateTable("Intermud2", ["mud_id"], [$mudid],
				       ["mud_id", "Name", "LastContact",
					"UDPPort", "inetd_id", "UpdateEmail"], 
				       [$mudid, $mud, $now,
					$values[1], $inetdid, $values[6]]);
	    if(!$res)
	    {
		$dbobj->debug("No IntermudID!?\n" . $dbobj->{$errormsg} . "\n");
		$dbh->rollback();
		next;
	    }

	    # Parse which services the mud supports and add to MudServicesI2
	    if(defined($values[6]))
	    {
		foreach my $serv (split(/:/, $values[6]))
		{
		    my $serviceid = $dbobj->getNameID("ServicesI2", $serv);
		    if(!$serviceid)
		    {
			$res = $dbobj->updateTable("ServicesI2", ["ID"], undef,
						   ["Name"], [$serv]);
			if(!$res)
			{
			    $dbobj->debug("Can't add i2 service!\n" .
					  $dbobj->{$errormsg} . "\n");
			    next;
			}
			$serviceid = $res;
		    }
#   		    $dbobj->debug("Service: $mudid, $service, $serviceid\n");
		    $res = $dbobj->appendTable("MudServicesI2",
		       ["mud_id", "service_id", "Send", "Receive"],
		       [$mudid, $serviceid, 1, 1]);
		    if(!$res)
		    {
			$dbobj->debug("Can't update MudServicesI3: " .
				      $dbobj->{$errormsg} . "\n");
			# Ignore and carry on ;)
		    }
		    
		}
	    }
			

	    # Add to MudUpdate table
	    $res = $dbobj->appendTable('MudUpdate', 
				       ['ID', 'DateTime', 'IPChange_id'],
				       [$update_id, $now, $changeid]);
	    if(!$res)
	    {
		$dbobj->debug("Can't update MudUpdate" . 
			      $dbobj->{$errormsg} . "\n");
#		$dbh->rollback();
#		next;
	    }
	    
	    $dbh->commit();
	}
    }
    else
    {
	$dbobj->{$errormsg} = "No such type: $type";
	return undef;
    }
}

sub updateMudContact
{
    # Quick update for the 'LastContact' field
    # Parameter: Object, Type, MudName, IP, Port
    my ($dbobj, $type, $mudname, $ip, $port) = @_;

    my $table = ($type eq 'i3' ? 'Intermud3' : 
		 ($type eq 'i2' ? 'Intermud2' : undef ));
    return 0 if(!defined($table));

#    $dbobj->debug("updateMudContact: Got: $type, $mudname, $ip, $port\n");

    my $stm = "UPDATE $table SET LastContact='" . time() . "' ";
    $stm .= "WHERE Name = ? ";
    $stm .= "AND UDPPort = '$port' " if($type eq 'i2');
    $stm .= "AND mud_id IN (SELECT ID FROM Muds WHERE IP_Address='$ip' ";
    $stm .= "AND MudPort = '$port'"      if($type eq 'i3');
    $stm .= ")";
    $dbobj->debug("$stm\n");
    my $res = $dbobj->{$databasehandle}->do($stm, undef, $mudname);
    if(!defined($res))
    {
	$dbobj->{$errormsg} = "Can't update Contact: " . 
	    $dbobj->{$databasehandle}->errstr();
	return undef;
    }

    $dbobj->{$databasehandle}->commit();
    return $res;
}

sub updateMudStatus
{
    # Quick update for the 'LastContact' field
    # Parameter: Object, Type, MudName, Status
    my ($dbobj, $mudnames, $status) = @_;

#    $dbobj->debug("updateMudContact: Got: $type, $mudname, $ip, $port\n");

    my @ids = ();
    foreach my $m (@{$mudnames})
    {
	$ids[scalar(@ids)] = $dbobj->getMudID($m);
    }
    if(!@ids)
    {
	return 0;
    }
    if($status !~ /-?(\d+)/)
    {
	return 0;
    }

    my $stm = "UPDATE Muds SET Status='$status' ";
    $stm .= "WHERE ID IN (" . '?,' x @ids . ")";
    $dbobj->debug("$stm :: @ids\n");
    my $res = $dbobj->{$databasehandle}->do($stm, undef, @ids);
    if(!defined($res))
    {
	$dbobj->{$errormsg} = "Can't update Status: " . 
	    $dbobj->{$databasehandle}->errstr();
    }
    $dbobj->{$databasehandle}->commit();

    return $res;
}

sub addChannels
{
    # Add/Update channel list from a hash
    # Parameter: Object, Type, Hash, UpdateId
    my ($dbobj, $type, $chanhash, $update_id) = @_;

    $dbobj->{$databasehandle}->commit();

    if($type eq 'i3')
    {
	my $dbh = $dbobj->{$databasehandle};
	my @chans = keys %{$chanhash};
	foreach my $chan (@chans)
	{
	    $dbobj->debug("Looking at: $chan\n");
	    next if $chanhash->{$chan} eq '0';
	    my @values = @{$chanhash->{$chan}};
	    my $mudid = $dbobj->getMudID($values[0]);
	    my $chanid = $dbobj->getNameID('Channels', $chan);
	    if(!defined($chanid))
	    {
		my $res = $dbobj->updateTable('Channels', ['Name'], lc($chan),
					      ['Name', 'Type', 'Listen'],
					      [$chan, $values[1], 0]);
		if(!$res)
		{
		    $dbobj->debug("Can't add i3 channel!\n" .
				  $dbobj->{$errormsg} . "\n");
		    $dbh->rollback();
		    next;
		}
		$chanid = $res;
	    }
#	  $dbobj->debug("Mud, Channel: $mudid, $chanid\n");
	    if(!defined($chanid) || !defined($mudid) || $mudid < 0)
	    {
		$dbobj->{$errormsg} = "Oops, an undef";
		$dbh->rollback();
		next;
	    }
	    my $res = $dbobj->appendTable("MudChannels",
					  ["mud_id", "channel_id"],
					  [$mudid, $chanid]);
	    if(!$res)
	    {
#		$dbobj->debug($dbobj->{$errormsg} . "\n");
		$dbh->rollback();
		next;
	    }
	    $dbh->commit();
	}
    }
    elsif($type eq 'i2')
    {
	my $dbh = $dbobj->{$databasehandle};
	my @chans = keys %{$chanhash};
	foreach my $chan (@chans)
	{
	    $dbobj->debug("Looking at: $chan\n");
	    next if $chanhash->{$chan} eq '0';
	    my @values = @{$chanhash->{$chan}};
	    my $mudid = $dbobj->getMudID($values[0]);
	    my $chanid = $dbobj->getNameID('Channels', $chan);
	    if(!defined($chanid))
	    {
		my $res = $dbobj->updateTable('Channels', ['ID'], undef,
					      ['Name', 'Type', 'Listen'],
					      [$chan, $values[1], 0]);
		if(!$res)
		{
		    $dbobj->debug("Can't add i2 channel!\n" .
				  $dbobj->{$errormsg} . "\n");
		    $dbh->rollback();
		    next;
		}
		$chanid = $res;
	    }
#	  $dbobj->debug("Mud, Channel: $mudid, $chanid\n");
	    if(!defined($chanid) || !defined($mudid) || $mudid < 0)
	    {
		$dbobj->{$errormsg} = "Oops, an undef";
		$dbh->rollback();
		next;
	    }
	    my $res = $dbobj->appendTable("MudChannels",
					  ["mud_id", "channel_id"],
					  [$mudid, $chanid]);
	    if(!$res)
	    {
#		$dbobj->debug($dbobj->{$errormsg} . "\n");
		$dbh->rollback();
		next;
	    }
	    $dbh->commit();
	}
    }

}    

sub updateChannelStatus
{
    # Set if a channel is listened to or not.
    # Parameter: Object, Channel, Status
    my ($dbobj, $channel, $status) = @_;

    my $chanid = $dbobj->getNameID('Channels', $channel);
    my $res = $dbobj->updateTable('Channels', ['ID'], [$chanid],
				  ['Listen'], [$status]);
    if(!$res)
    {
	$dbobj->debug("Can't add i3 service!\n" .
		      $dbobj->{$errormsg} . "\n");
    }
    $dbobj->{$databasehandle}->commit();
}

sub getChannelMuds
{
    # Return a list of muds which listen to this channel (i2!)
    # Parameter: Object, Channel
    my ($dbobj, $channel) = @_;

    my $chanid = $dbobj->getNameID('Channels', $channel);
    if(!$chanid)
    {
	return ();
    }

    my $dbh = $dbobj->{$databasehandle};
    my $stm = "SELECT Intermud2.Name from Intermud2, MudChannels ";
    $stm .= "WHERE Intermud2.mud_id = MudChannels.mud_id ";
    $stm .= "AND MudChannels.channel_id = $chanid";
    $dbobj->debug("$stm\n");

    $stm = $dbh->prepare($stm);
    my $results = $dbh->selectcol_arrayref($stm);
    if(!$results)
    {
	$dbobj->{$errormsg} = "Error getting muds for $channel: " .
	    $dbh->errstr();
	return undef;
    }
    return $results;
    
}

sub getListenedChannels
{
    # Return a list of channels which are listened to
    # Parameter: Object
    my ($dbobj) = @_;

    my $dbh = $dbobj->{$databasehandle};

    my $stm = "SELECT Name FROM Channels WHERE Listen = '1'";
    $stm = $dbh->prepare($stm);
    my $results = $dbh->selectcol_arrayref($stm);
    if(!$results)
    {
	$dbobj->{$errormsg} = "Error getting listened to channels: " .
	    $dbh->errstr();
	return undef;
    }
    
    $dbobj->debug("getListenedChannels: " . Dumper($results));
    return $results;
}

sub isChannel
{
    # Look to see if a Channel exists, return channel-name
    # Parameter: Object, Name
    my ($dbobj, $name) = @_;

    my $chanid = $dbobj->getNameID('Channels', $name);

    if(!$chanid || $chanid < 0)
    {
	return undef;
    }

    my $stm = "SELECT Name FROM Channels WHERE ID = '$chanid'";
    $stm = $dbobj->{$databasehandle}->prepare($stm);
    my $res = $stm->execute();
    if(!$res)
    {
	$dbobj->{$errormsg} = "Can't get Channel name: " . 
	    $dbobj->{$databasehandle}->errstr();
	return undef;
    }
    my $answer = $stm->fetchall_arrayref();

    if(@{$answer} > 1)
    {
	$dbobj->{$errormsg} = "Too many channels: $name";
	return undef;
    }
    return $answer->[0]->[0];
}

sub addServices
{
    # Update the services of a mud
    # Parameter: Object, Type, Send/Receive, Services
    my ($dbobj, $type, $mudname, $sr, $services) = @_;

    my $mudid = $dbobj->getMudID($mudname);
    if(defined($mudid) && $mudid < 0)
    {
	return undef;
    }
    if($sr !~ /Send|Receive/i)
    {
	$dbobj->{$errormsg} = "$sr is not Send or Receive";
	return undef;
    }

    if($type eq 'i2')
    {
	foreach my $serv (@{$services})
	{
	    my $servid = $dbobj->addRowToTable($serv,
					      "ServicesI2",
					      "Name",
					      1,
					      '');
	    my $stm = "SELECT mud_id, service_id FROM MudServicesI2 ";
	    $stm .= "WHERE mud_id = '$mudid' AND service_id = '$servid'";
	    $stm = $dbobj->{$databasehandle}->prepare($stm);
	    my $res = $stm->execute();
	    if(!defined($res))
	    {
		$dbobj->{$errormsg} = "Can't get info from MudServicesI2";
		return undef;
	    }
	    my $ms = $stm->fetchall_arrayref();
	    if(@{$ms} == 1)
	    {
		$stm =  "UPDATE MudServicesI2 SET ($sr = '1') WHERE ";
		$stm .= "mud_id = '$mudid' AND service_id = '$servid'";
	    }
	    else
	    {
		$stm =  "INSERT INTO MudServices (mud_id, service_id, $sr) ";
		$stm .= "VALUES('$mudid', '$servid', '1')";
	    }
	    $res = $dbobj->{$databasehandle}->do($stm);
	    if(!defined($res))
	    {
		$dbobj->{$errormsg} = "Can't get update/insert MudServicesI2";
		return undef;
	    }
	    $dbobj->{$databasehandle}->commit();
	}
    }
    return 1;
		
}

sub listMuds
{
    # Return a list of muds according to the given parameters.
    # List Services?
    # Parameter: Object, Params
    my ($dbobj, @params) = @_;

    if(!@params)
    {
	@params = ('Name', 'IP', 'MudPort', 'UDPPort', 'Status', 
		   'LastContact');
    }

    my $stm = "SELECT ";
    my $orderby = '';
#    my @fields = ();
    foreach my $p (@params)
    {
#	$fields[@fields] = $p;
	$stm .= 'Intermud2.Name AS Name2, Intermud3.Name AS Name3, ' 
	    if(lc($p) eq 'name');
	$stm .= 'Muds.IP_Address AS IP, ' if(lc($p) eq 'ip');
	$stm .= 'Muds.MudPort AS MudPort, ' if(lc($p) eq 'mudport');
	$stm .= 'Muds.Status AS Status, ' if(lc($p) eq 'status');
	$stm .= 'Intermud2.LastContact AS LC2, Intermud3.LastContact AS LC3, '
	    if(lc($p) eq 'lastcontact');
	$stm .= '\'NULL\' AS OS2, Intermud3.OpenStatus AS OS3, '
	    if(lc($p) eq 'openstatus');
	$stm .= 'Intermud2.UDPPort AS UDP2, \'NULL\' AS UDP3, '
	    if(lc($p) eq 'udpport');
	$stm .= 'Libraries.Name AS lib, ' if(lc($p) eq 'lib');
	$stm .= 'Drivers.Name AS Driver, ' if(lc($p) eq 'driver');
	$stm .= 'Types.Name AS Type, '    if(lc($p) eq 'type');
	$stm .= 'Muds.AdminEmail AS Admin, ' if(lc($p) eq 'email');
	if(lc($p) eq 'name')
	{
	    $orderby = 'Name2, Name3';
	}
    }
    substr($stm, -2, 2) = '';
    $stm .= " FROM Muds ";
    $stm .= "LEFT OUTER JOIN Intermud2 ON (Muds.ID = Intermud2.mud_id) ";
    $stm .= "LEFT OUTER JOIN Intermud3 ON (Muds.ID = Intermud3.mud_id) ";
    $stm .= "LEFT OUTER JOIN Libraries ON (Muds.lib_id = Libraries.ID) ";
    $stm .= "LEFT OUTER JOIN Drivers ON (Muds.driver_id = Drivers.ID) ";
    $stm .= "LEFT OUTER JOIN Types ON (Muds.type_id = Types.ID) ";
    $stm .= "ORDER BY $orderby " if(length($orderby));
    $dbobj->debug("listMuds: $stm\n");
  
    $stm = $dbobj->{$databasehandle}->prepare($stm);
    my $res = $stm->execute();
    if(!defined($res))
    {
	$dbobj->{$errormsg} = "Select for listMuds failed: " . 
	    $dbobj->{$databasehandle}->errstr();
	return undef;
    }

    my @answer = ();
    my $rowind = 0;
    my $names = $stm->{NAME_lc};
    my @actnames = ();
    my $rows = $stm->fetchall_arrayref();
    foreach my $row (@{$rows})
    {
	my $type = '';
	$rowind = scalar(@answer);
	$answer[$rowind] = [];
	foreach my $index (0 .. @{$row} - 1)
	{
	    if($names->[$index] eq 'name2' && $row->[$index])
	    {
		if($rowind == 0)
		{
		    $actnames[scalar(@actnames)] = 'name';
		}
#		$dbobj->debug($names->[$index]. " ".$row->[$index] ."\n");
		$type .= ' i2';
		$answer[$rowind]->[scalar(@{$answer[$rowind]})] = 
		    $row->[$index];
		next;
	    }
	    elsif($names->[$index] eq 'name3' && $row->[$index])
	    {
#		$dbobj->debug($names->[$index]. " ".$row->[$index] ."\n");
		if(!length($type))
		{
		    if($rowind == 0)
		    {
			$actnames[scalar(@actnames)] = 'name';
		    }
		    $answer[$rowind]->[scalar(@{$answer[$rowind]})] = 
			$row->[$index];
		}
		$type .=' i3 ';
		next;
	    }
	    elsif($names->[$index] eq 'lc2' && $row->[$index])
	    {
		if($rowind == 0)
		{
		    $actnames[scalar(@actnames)] = 'last contact';
		}
#		$dbobj->debug($names->[$index]. " ".$row->[$index] ."\n");
		if($type =~ /i2/)
		{
		    $answer[$rowind]->[scalar(@{$answer[$rowind]})] = 
			$row->[$index];
		}
		next;
	    }
	    elsif($names->[$index] eq 'lc3' && $row->[$index])
	    {
#		$dbobj->debug($names->[$index]. " ".$row->[$index] ."\n");
		if($type !~ /i2/ && $type =~ /i3/)
		{
		    if($rowind == 0)
		    {
			$actnames[scalar(@actnames)] = 'last contact';
		    }
		    $answer[$rowind]->[scalar(@{$answer[$rowind]})] = 
			$row->[$index];
		}
		next;
	    }
	    elsif($names->[$index] eq 'udp2' && $row->[$index])
	    {
		if($rowind == 0)
		{
		    $actnames[scalar(@actnames)] = 'udpport';
		}
#		$dbobj->debug($names->[$index]. " ".$row->[$index] ."\n");
		if($type =~ /i2/)
		{
		    $answer[$rowind]->[scalar(@{$answer[$rowind]})] = 
			$row->[$index];
		}
		next;
	    }
	    elsif($names->[$index] eq 'udp3' && $row->[$index])
	    {
#		$dbobj->debug($names->[$index]. " ".$row->[$index] ."\n");
		if($type !~ /i2/ && $type =~ /i3/)
		{
		    if($rowind == 0)
		    {
			$actnames[scalar(@actnames)] = 'udpport';
		    }
		    $answer[$rowind]->[scalar(@{$answer[$rowind]})] = 
			$row->[$index];
		}
		next;
	    }
	    elsif($names->[$index] eq 'os2' && $row->[$index])
	    {
		if($rowind == 0)
		{
		    $actnames[scalar(@actnames)] = 'open status';
		}
#		$dbobj->debug($names->[$index]. " ".$row->[$index] ."\n");
		if($type =~ /i2/)
		{
		    $answer[$rowind]->[scalar(@{$answer[$rowind]})] = 
			$row->[$index];
		}
		next;
	    }
	    elsif($names->[$index] eq 'os3' && $row->[$index])
	    {
#		$dbobj->debug($names->[$index]. " ".$row->[$index] ."\n");
		if($type !~ /i2/ && $type =~ /i3/)
		{
		    if($rowind == 0)
		    {
			$actnames[scalar(@actnames)] = 'open status';
		    }
		    $answer[$rowind]->[scalar(@{$answer[$rowind]})] = 
			$row->[$index];
		}
		next;
	    }
	    if(!defined($row->[$index]))
	    {
		next;
	    }
	    if($rowind == 0)
	    {
		$actnames[scalar(@actnames)] = $names->[$index];
	    }
	    $answer[$rowind]->[scalar(@{$answer[$rowind]})] = 
		$row->[$index];
	}
	$answer[$rowind]->[scalar(@{$answer[$rowind]})] = 
	    $type if(length($type));
	if($rowind == 0 && length($type))
	{
	    $actnames[scalar(@actnames)] = 'I2/I3';
	}
    }
    

#    $dbobj->debug(Dumper(\@answer));

    return [\@actnames, \@answer];
}

sub getIPPort
{
    # Get IP and given Port of one or more muds.
    # Parameter: Object, Type, PortType, Active yes/no Name(s)
    my ($dbobj, $type, $porttype, $active, $names) = @_;
    
    $dbobj->debug("IPPort $type, $porttype, $names\n");
    my $port = '';
    my $table = '';
    $table = 'Intermud2' if($type eq 'i2');
    $table = 'Intermud3' if($type eq 'i3');
    $dbobj->debug("IPPort - Table: $table\n");
    if(!length($table))
    {
	return undef;
    }
    $port = 'UDPPort' if($porttype eq 'UDP' && $type eq 'i2');
    $dbobj->debug("IPPort - Port: $port\n");
    if(!length($port))
    {
	return undef;
    }

    my $stm = "SELECT $table.Name, Muds.IP_Address as IP, $table.$port FROM ";
    $stm .= "Muds, $table WHERE Muds.ID = $table.mud_id";
    $stm .= " AND Muds.Status = '-1'" if($active);
    if($names ne 'all')
    {
	my @names = split(/,\s?/, $names);
	$stm .= " AND $table.Name IN ('" . join("', '",  @names) . "')";
    }

    $dbobj->debug($stm . "\n");
    my $result = $dbobj->{$databasehandle}->selectcol_arrayref($stm,
						       {Columns => [1,2,3]});
    if(!defined($result))
    {
	$dbobj->{$errormsg} = "Can't get IP and Port: " . 
	    $dbobj->{$databasehandle}->errstr();
	return undef;
    }
    $dbobj->debug("getIPPort: " . Dumper($result));
    return $result;
}

sub addRowToTable
{
    # Check if the given string holds a known/similar value, add if unknown
    # Returns the id of the found/added row
    # Parameter: Object, String
    my ($dbobj, $string, $table, $fields, $values, $splitpattern) = @_;

    my $statementS = "SELECT ID, $fields FROM $table";

    my $dbh = $dbobj->{$databasehandle};
    $statementS = $dbh->prepare($statementS);
    my $res = $statementS->execute();
    if(!$res) 
    {
	$dbobj->debug("Can't select from $table: " . $dbh->errstr() . "\n");
    }
    my $list = $statementS->fetchall_arrayref();

    my @vals;
    $string =~ s/,//g;
    @vals = ($string, ('') x ($values - 1));
    
    if(($values > 1) && (my @matches = $string =~ $splitpattern))
    {
 	@vals = @matches;
    }

    if(@{$list})
    {
	ROW: foreach my $row (@{$list})
	{
	    for my $i (0 .. $#vals) 
	    {
		unless (($vals[$i] && $row->[$i+1] &&
		      String::Approx::amatch($row->[$i+1],
					     $vals[$i]) || 
			 $vals[$i] eq $row->[$i+1])) 
		{
		    next ROW;
		}
	    }
	    # All succesful!
	    return $row->[0];
	}
    }

    my $statementI = "INSERT INTO $table VALUES (NULL";
    $statementI .= ', ?' x ($values);
    $statementI .= ')';
    $statementI = $dbh->prepare($statementI);

    $res = $statementI->execute(@vals);
    if(!defined($res))
    {
	$dbobj->{$errormsg} = "Insert failed: " . $dbh->errstr() . "\n";
	return undef;
    }

    my $rowid = $dbh->func('last_insert_rowid');
    if($rowid)
    {
	return $rowid;
    }
    return undef;
}

sub getMudID
{
    # Return a Mud id from either Intermud3 or Intermud2 table, if it exists.
    # Using the given name as the key
    # Parameter: Object, MudName
    my ($dbobj, $mudname) = @_;

    my $dbh = $dbobj->{$databasehandle};
    $dbobj->{$errormsg} = '';
    
    my $stmS = "SELECT ID FROM Muds ";
    $stmS .= "LEFT OUTER JOIN Intermud2 ON (Muds.ID = Intermud2.mud_id) ";
    $stmS .= "LEFT OUTER JOIN Intermud3 ON (Muds.ID = Intermud3.mud_id) ";
    $stmS .= "WHERE (Intermud2.Name like ? ";
    $stmS .= "OR Intermud3.Name like ?) order by length(Intermud2.Name)";

    $dbobj->debug("getMudID: $stmS :: $mudname\n");
    $stmS = $dbh->prepare($stmS);
    my $res = $stmS->execute($mudname, $mudname);
    if(!defined($res))
    {
	$dbobj->{$errormsg} = "Can't select from Muds: " . 
	$dbh->errstr() . "\n";
	return undef;
    }
    my $ids = $stmS->fetchall_arrayref();
    if(!$ids || !@{$ids})
    {
	$dbobj->{$errormsg} = "No MudID matching $mudname: ";
	$dbobj->{$errormsg} .=  $dbh->errstr() . "\n" if($dbh->err());
	return undef;
    }

    $dbobj->debug(Dumper($ids));
    if(@{$ids} > 1 && lc($ids->[0]->[0]) ne lc($mudname))
    {
	$dbobj->{$errormsg} = "Too many matches in getMudID.";
	return -1;
    }
    return $ids->[0]->[0];
}

sub getMudIP
{
    # Return the IP of a mud using its name
    # Parameter: Object, MudName
    my ($dbobj, $mudname) = @_;

    my $mudid = $dbobj->getMudID($mudname);
    if(!defined($mudid) || $mudid < 0)
    {
	return '';
    }
    
    my $stm = "SELECT IP_Address FROM Muds WHERE ID = '$mudid'";
  $dbobj->debug("getMudID: $stm\n");
    $stm = $dbobj->{$databasehandle}->prepare($stm);
    my $res = $stm->execute();
    if(!defined($res))
    {
	$dbobj->{$errormsg} = "Can't select from Muds: " . 
	    $dbobj->{$databasehandle}->errstr() . "\n";
	return undef;
    }
    my $ids = $stm->fetchall_arrayref();
    if(!$ids)
    {
	$dbobj->{$errormsg} = "No IP for $mudname";
	return '';
    }
    if(@{$ids} > 1)
    {
	$dbobj->{$errormsg} = "Too many IDs: $mudid";
	return undef;
    }
    return $ids->[0]->[0];
}

sub getNameID
{
    # Return an ID from the any table, looking up the value in the Name field
    # The table must contain both an 'ID' field and a 'Name' field
    # Parameter: Object, Table, Name
    my ($dbobj, $table, $name) = @_;

    my $dbh = $dbobj->{$databasehandle};
    $dbobj->{$errormsg} = '';
    
    my $stmS = "SELECT ID FROM $table WHERE Name like ?";
    $dbobj->debug("getNameID: $stmS\n");

    $stmS = $dbh->prepare($stmS);
    my $res = $stmS->execute($name);
    if(!$res)
    {
	$dbobj->{$errormsg} ="Can't select from $table: " . 
	    $dbh->errstr() . "\n";
	return undef;
    }
    my $ids = $stmS->fetchall_arrayref();
    if(!$ids)
    {
	$dbobj->{$errormsg} = "No ID matching name: " . $dbh->errstr()  . "\n";
	return undef;
    }
    if(@{$ids} > 1)
    {
	$dbobj->{$errormsg} = "Too many matches in getNameID.";
	return -1;
    }
    return $ids->[0]->[0];

    # Unknown type
    $dbobj->{$errormsg} = "Unknown type in getMudID.";
    return -2;
}

sub getMudName
{
    # Get a name or all names matching or abbreviated by given name
    # Parameter: Object, Name
    my ($dbobj, $type, $name) = @_;

    my $dbh = $dbobj->{$databasehandle};
    $dbobj->{$errormsg} = '';

    my $table;
    if($type eq 'i3')
    {
	$table = 'Intermud3';
    }
    elsif($type eq 'i2')
    {
	$table = 'Intermud2';
    }
    else
    {
	$dbobj->{$errormsg} = "Oops, invalid type: $type\n";
	return undef;
    }

# Wierd version: select Name from intermud2 where Name = 'Timewarp' or (0=(select count(*) from intermud2 where Name='Timewarp') and Name like 'Timewarp%')

    my $stmS = "SELECT Name FROM $table WHERE Name like ? order by ";
    $stmS .= "length(Name)";
    $dbobj->debug("getMudName: $stmS :: $name\n");

    $stmS = $dbh->prepare($stmS);
#    my $res = $stmS->execute($name . '%');
#    if(!$res)
#    {
#	$dbobj->{$errormsg} ="Can't select from $table: " . 
#	    $dbh->errstr() . "\n";
#	return undef;
#    }
    my $ids = $dbh->selectcol_arrayref($stmS, undef, "$name%");
    $dbobj->debug(Dumper($ids));
    if(!$ids)
    {
	$dbobj->{$errormsg} = "No Name matching name: $name. ";
	$dbobj->{$errormsg} .=  $dbh->errstr() . "\n" if($dbh->err());
	return undef;
    }
    if(lc($ids->[0]) eq lc($name))
    {
	return [$ids->[0]];
    }
    return $ids;
}

sub getMudProtocol
{
    # List which protocols this mud implements
    # Parameter: Object, MudName
    my ($dbobj, $mudname) = @_;

    return undef if(!$mudname);

    my $dbh = $dbobj->{$databasehandle};
    my $stm = "SELECT Muds.ID, Intermud2.Name as N2, Intermud3.Name as N3 ";
    $stm .= "FROM Muds ";
    $stm .= "LEFT OUTER JOIN Intermud2 ON (Muds.ID = Intermud2.mud_id) ";
    $stm .= "LEFT OUTER JOIN Intermud3 ON (Muds.ID = Intermud3.mud_id) ";
    $stm .= "WHERE (N2 like ? OR N3 like ?) order by length(N2)";
    $dbobj->debug("getMudProtocol: $stm :: $mudname\n");

    $stm = $dbh->prepare($stm);
    my $res = $stm->execute("$mudname%", "$mudname%");

    if(!defined($res))
    {
	$dbobj->{$errormsg} = "Can't select from Muds: " . 
	$dbh->errstr() . "\n";
	return undef;
    }
    my $names = $stm->fetchall_arrayref();
    if(!$names || !@{$names})
    {
	$dbobj->{$errormsg} = "No MudID matching $mudname: "; 
	$dbobj->{$errormsg} .=  $dbh->errstr() . "\n" if($dbh->err());
	return undef;
    }
    $dbobj->debug("names: " . Dumper($names));
#    if(@{$names} > 1 && lc($names->[0]->[0]) ne lc($mudname))
#    {
#	$dbobj->{$errormsg} = "Too many matches in getMudProtocol.\n";
##	$dbobj->{$errormsg} .= join(', ', grep {$->[0]} @{$names})
#	return undef;
#    }
    my $answer;
    foreach my $rows (@{$names})
    {
	$dbobj->debug("rows: " . Dumper($rows));
	my $name = '';

	if($rows->[1] && !$rows->[2])
	{
	    $answer->{$rows->[1]} = ['i2'];
	    $name = $rows->[1];
	}
	elsif($rows->[1] && $rows->[2])
	{
	    $answer->{$rows->[1]} = ['i2', 'i3'];
	    $name = $rows->[1];
	}
	else
	{
	    $answer->{$rows->[2]} = ['i3'];
	    $name = $rows->[2];
	}
	if(length($name) == length($mudname))
	{
	    $dbobj->debug("Found exact mudname: $mudname\n");
	    last;
	}
    }

    $dbobj->debug("answer: " . Dumper($answer));
    return $answer;
}

sub getMudServices
{
    # Return a list of services that a given mud supports
    # Parameter: Object, Type, MudName
    my ($dbobj, $type, $mudname) = @_;

    my $mudid = $dbobj->getMudID($mudname);
    return [] if(!$mudid);

    return [] if(lc($type) ne 'i2' && lc($type) ne 'i3');

    my $table = $type eq 'i2' ? 'I2' : 'I3';
    my $dbh = $dbobj->{$databasehandle};
    my $stm = "SELECT Services$table.Name FROM Services$table, ";
    $stm .= "MudServices$table ";
    $stm .= "WHERE Services$table.ID = MudServices$table.service_id AND ";
    $stm .= "MudServices$table.mud_id = $mudid";
    $dbobj->debug("$stm\n");
    
    $stm = $dbh->prepare($stm);
    my $result = $dbh->selectcol_arrayref($stm);

    if(!$result)
    {
	$dbobj->{$errormsg} = "Can't select MudServicesI2: " . 
	    $dbh->errstr() . "\n";
	return undef;
    }
    $dbobj->debug(Dumper($result));
    return $result;
}

sub getTableVals
{
    # Return these fields from an entire table
    # Parameter: Object, Table, Fields
    my ($dbobj, $table, @fields) = @_;

    my $dbh = $dbobj->{$databasehandle};
    if(!@fields)
    {
	my $result = ();
	return $result;
    }

    my $stm = "SELECT " . join(',', @fields) . " FROM $table";
    $dbobj->debug($stm . "\n");
    $stm = $dbh->prepare($stm);
    my $res = $stm->execute();
    if(!$res)
    {
	$dbobj->{$errormsg} ="Can't select from $table: " . 
	    $dbh->errstr() . "\n";
	return undef;
    }
    my $result = $stm->fetchall_arrayref();
    if(!$result)
    {
	$dbobj->{$errormsg} = "Can't select from $table: " . 
	    $dbh->errstr() . "\n";
	return undef;
    }
    return $result;
    
}

sub getValues
{
    # Return an array of values from a table, using the given ID field
    # Parameter: Object, Table, IDField, IDValue, Fields
    my ($dbobj, $table, $idfield, $idvalue, @fields) = @_;

    my $dbh = $dbobj->{$databasehandle};
    if(!@fields)
    {
	my $result = ();
	return $result;
    }

    my $stm = "SELECT " . join(',', @fields) . " FROM $table WHERE $idfield ";
    $stm .= " like '$idvalue'";
    $dbobj->debug($stm . "\n");
    $stm = $dbh->prepare($stm);

    my $result = $dbh->selectcol_arrayref($stm, {Columns => [1..@fields]});
    if(!$result)
    {
	$dbobj->{$errormsg} = "Can't select from $table: " . 
	    $dbh->errstr() . "\n";
	return undef;
    }
#    $dbobj->debug(Dumper($result));
    return $result;
    
}

sub updateTable
{
    # Update a table row when an exact match is found for the idfield,
    # else create a new row. Return the ID.
    # Parameter: Object, TableName, ID-Field, ID-Value, Fieldsref, Valuesref
    my ($dbobj, $table, $idfields, $ids, $fieldsref, $valuesref) = @_;

    my $dbh = $dbobj->{$databasehandle};

    if(@{$fieldsref} != @{$valuesref})
    {
	$dbobj->{$errormsg} = "updateTable: Fields and values are not equal!";
	return undef;
    }

    my $rows;
    if($ids && @{$idfields} == @{$ids})
    {
	my $stm = "SELECT * FROM $table WHERE ";
	foreach my $f (0..@{$idfields} - 1)
	{
	    $stm .= $idfields->[$f] . "='" . ($ids->[$f] || '') . "' AND ";
	}
	substr($stm, -4, 4, '');
	$dbobj->debug($stm . "\n");
	$rows = $dbh->do($stm);
    }
#   my $rows = $dbh->do("SELECT * FROM $table WHERE $idfield = '$id'") if $id;

    my $stm;
    my $vals = "?, " x @{$valuesref};
    substr($vals, -2, 2, '');
    if(!$ids || ($rows && $rows eq "0E0"))
    {
	$stm = "INSERT INTO $table ('" . join("', '", @{$fieldsref}) .
	    "') VALUES($vals)";
    }
    else
    {
	$stm = "UPDATE $table SET ";
	for my $i (0 .. (@{$fieldsref} - 1))
	{
	    $stm .= $fieldsref->[$i] . " = ?, ";
	}
	substr($stm, -2, 2) = '';

	$stm .= " WHERE ";
	foreach my $f (0..@{$idfields} - 1)
	{
	    $stm .= $idfields->[$f] . "='" . $ids->[$f]. "' AND ";
	}
	substr($stm, -4, 4, '');
#	$stm .= " WHERE $idfield = '$id'";
    }
    $dbobj->debug("$stm :: @{$valuesref}\n");
    $stm = $dbh->prepare($stm);
#    my $res = $stm->execute();
    my $res = $stm->execute(@{$valuesref});
    if(!$res)
    {
	$dbobj->{$errormsg} = "Can't update/insert values into $table: " . 
	    $dbh->errstr() . "\n";
	return undef;
    }

#    if($id)
#    {
#	return $id;
#    }
    return $dbh->func('last_insert_rowid');
}

sub deleteFromTable
{
    # Delete a row from a table when an exact match is found for the idfield.
    # Parameter: Object, TableName, ID-Fields, ID-Values
    my ($dbobj, $table, $idfields, $ids) = @_;

    my $dbh = $dbobj->{$databasehandle};

    my $rows;
    if($ids && @{$idfields} == @{$ids})
    {
	my $stm = "DELETE FROM $table WHERE ";
	foreach my $f (0..@{$idfields} - 1)
	{
	    $stm .= $idfields->[$f] . "='" . $ids->[$f]. "' AND ";
	}
	substr($stm, -4, 4, '');
	$dbobj->debug($stm . "\n");
	$rows = $dbh->do($stm);
	if(!$rows)
	{
	    $dbobj->{$errormsg} = "Can't delete from $table: " . 
		$dbh->errstr() . "\n";
	}
	return $rows;	    
    }

    return undef;
}

sub appendTable
{
    # Add another row to a table, whatever the contents 
    # (tables with no (or automatic) primary key )
    # Parameter: Object, Table, fieldsref, valuesref
    my ($dbobj, $table, $fieldsref, $valuesref) = @_;

    my $dbh = $dbobj->{$databasehandle};

    if(@{$fieldsref} != @{$valuesref})
    {
	$dbobj->{$errormsg} = "Fields and values are not equal!";
	return undef;
    }

    my $stm;
    my $vals = "?, " x @{$valuesref};
    substr($vals, -2, 2, '');
    $stm = "INSERT INTO $table ('" . join("', '", @{$fieldsref}) .
	"') VALUES($vals)";

    $dbobj->debug($stm . "\n");
    $stm = $dbh->prepare($stm);
    my $res = $stm->execute(@{$valuesref});
    if(!$res)
    {
	$dbobj->{$errormsg} = "Can't insert values into $table: " . 
	    $dbh->errstr() . "\n";
	return undef;
    }

    return $dbh->func('last_insert_rowid');
#    return '0E0'; # True but no rowid!
}

sub listTables
{
    # List all tables in database
    # Parameter: Object
    my ($dbobj) = @_;

    my $dbh = $dbobj->{$databasehandle};
    $dbobj->debug("listTables\n");
    my $stm = $dbh->table_info('%', '%', '%', 'TABLE');

    my $result = $stm->fetchall_arrayref();

    if(!$result)
    {
	$dbobj->debug("No result for table_info!\n");
	$dbobj->debug($dbh->errstr() . "\n");
	return 0;
    }

    $dbobj->debug(Dumper($result)); 
    return map {$_->[2]} @$result;
}

sub isDatabase
{
    # Check if tables already exist
    # Parameter: Object
    my ($obj) = @_;

    my $dbh = $obj->{$databasehandle};
    $obj->debug("isDatabase\n");
#    my $res = $obj->{$databasehandle}->do("SELECT * FROM Muds");
#    my $res = $dbh->do("SELECT * FROM Muds");

    if(!grep(/muds/i, $obj->listTables()))
#    if(!$res)
    {
	$obj->debug("Nope.\n");
#	$obj->debug($dbh->errstr() . "\n");
	return 0;
    }
    return 1;
}

sub getParameter
{
    # Get the value of a special parameter.
    # Parameter: Object, Param
    my ($dbobj, $type, $param) = @_;

    my $table;
    if($type eq 'i3')
    {
	$table = 'ParametersI3';
    }
    elsif($type eq 'i2')
    {
	$table = 'ParametersI2';
    }
    else
    {
	$dbobj->{$errormsg} = "No such type: " . $type;
	return undef;
    }

    my $stm = "SELECT Value FROM $table WHERE Name = ?";
#  $dbobj->debug("$stm\n");
    $stm = $dbobj->{$databasehandle}->prepare($stm);
    my $res = $stm->execute($param);
    if(!$res)
    {
	$dbobj->{$errormsg} = "Can't get $param parameter: " . 
	    $dbobj->{$databasehandle}->errstr();
	return undef;
    }
    my $result = $stm->fetchall_arrayref();
    if($result)
    {
	return $result->[0]->[0];
    }
    return undef;
}

sub setParameter
{
    # Set the value of a special parameter.
    # Parameter: Object, Type, Param
    my ($dbobj, $type, $param, $value) = @_;

    my $table;
    if($type eq 'i3')
    {
	$table = 'ParametersI3';
    }
    elsif($type eq 'i2')
    {
	$table = 'ParametersI2';
    }
    else
    {
	$dbobj->{$errormsg} = "No such type: " . $type;
	return undef;
    }
    my $testvalue = $dbobj->getParameter($type, $param);
    my $stm;
    if($testvalue)
    {
	$stm = "UPDATE $table SET Value = '$value' WHERE Name = '$param'";
    }
    else
    {
	$stm = "INSERT INTO $table VALUES ('$param', '$value')";
    }

  $dbobj->debug("$stm\n");
    my $res = $dbobj->{$databasehandle}->do($stm);
    if(!$res)
    {
	$dbobj->{$errormsg} = "Can't set $param parameter: " . 
	    $dbobj->{$databasehandle}->errstr();
	return undef;
    }
    return 1;
}

sub createAlias
{
    # Create an alias for a command
    # Parameter: Object, Alias, Command
    my ($dbobj, $alias, $command) = @_;

    my $aliasid = $dbobj->updateTable('Aliases', ['Name'], [$alias],
				      ['Name', 'Command'],
				      [$alias, $command]);

    if(!defined($aliasid))
    {
	$dbobj->debug("Can't create Alias: " . $dbobj->{$errormsg} . "\n");
	return undef;
    }
    return 1;
}

sub getAliases
{
    # Return an array of arrays of all aliases
    # Parameter: Object, ID
    my ($dbobj, $id) = @_;

    my $vals = $dbobj->getValues('Aliases', 'user_id', $id, 'Name', 'Command');
    $dbobj->debug("Aliases: " . Dumper($vals) . "\n");
    if(!defined($vals))
    {
	return [];
    }
    my $res = [];
    my $ind = 0;
    while ($ind < @{$vals})
    {
	$res->[scalar(@{$res})] = [$vals->[$ind], $vals->[$ind+1]];
	$ind += 2;
    }
    return $res;
}

sub isUser
{
    # Return true if the given name is in the user list
    # Parameters: Object, Name
    my ($dbobj, $name) = @_;

    my $vals = $dbobj->getValues('Users', 'Name', $name, 'Name');
    return $vals ? 1 : 0;
}

sub getUsers
{
    # Return an array of arrays of all users
    # Parameter: Object
    my ($dbobj) = @_;

    return $dbobj->getTableVals('Users', 'ID', 'Name', 'Password', 'Title',
				'Desc', 'Level', 'Location', 'Room', 'Login', 
				'Logout');
}

sub closedb
{
    # Parameter: Object
    my ($obj) = @_;

    my $dbh = $obj->{$databasehandle};
    $dbh->commit();
    $dbh->disconnect;
}

sub getError
{
    # Return last error code
    # Parameter: Object
    my ($dbobj) = @_;

    return $dbobj->{$errormsg};
}

sub debug
{
    # Debugging sub. Check $DEBUG member
    # Parameter: Object, Message
    my ($dbobj, $mesg) = @_;

    if ($dbobj->{'DEBUG'} eq 'on')
    {
	print STDOUT "$mesg";
    } elsif ($dbobj->{'DEBUG'} eq 'log')
    {
	# Append text to debug log
	my $filename = $dbobj->{'logpath'} . '/debug_intermud_db.log';
	
	open(DEBUGFILE, ">>", $filename) or die "Can't open $filename: $!\n";
	print DEBUGFILE "$mesg";
        close(DEBUGFILE);
#      main::debug($mesg);
    }
}

1;

package main;
#use Data::Dumper;

sub testIntermudDB
{
    my $idb = MUD::Intermud::DB->new(
		       {dbname => '/home/castaway/perl/data/intermud2.db',
			DEBUG => 'on',
		        intermudtype => 'i3'});
    if(!$idb->isDatabase())
    {
	print "No Database - create\n";
	my $res = $idb->createTables();
	if(!defined($res))
	{
	    print "Error: " . $idb->getError();
	}
    }

    my $testmud = {
	'Flaming Coast DEV' => [
				'-1',
				'62.65.206.7',
				'5000',
				'5005',
				'0',
				'Skylib 1.6',
				'Discworld',
				'MudOS v22.2b13-DSv7',
				'LP',
				'Mudlib Development',
				'samne@kolumbus.fi',
				{
				    'channel' => '1',
				    'tell' => '1',
				    'emoteto' => '1',
				    'locate' => '1',
				    'http' => '5003',
				    'ftp' => '5002',
				    'finger' => '1',
				    'who' => '1'
				    },
				{}
				],
	'ArcadiaF' => [
		       '0',
		       '4.47.5.166',
		       '8000',
		       '8002',
		       '8003',
		       'GurbaLib v0.32',
		       'GurbaLib',
		       'DGD 1.1.42',
		       'LPMud',
		       'Private',
		       'darrin@darrins.org',
		       {
			   'channel' => '1',
			   'tell' => '1',
			   'locate' => '1',
			   'ftp' => '8001',
			   'who' => '1'
			   },
		       {}
		       ],
	'Desolation' => [
			 '-1',
			 '209.221.176.88',
			 '7878',
			 '7879',
			 '0',
			 'Lima 1.0a8',
			 'Lima',
			 'MudOS v22.2b4',
			 'LP',
			 'urban renewal',
			 'jhvh@squid.org^M^M       [ http://desolation.org/
 ]^M    Post apocalyptic mayhem based on the^M  timeless RPG, Wasteland!^M',
			 {
			     'channel' => '1',
			     'tell' => '1',
			     'auth' => '1',
			     'emoteto' => '1',
			     'locate' => '1',
			     'mail' => '1',
			     'http' => '80',
			     'ucache' => '1',
			     'ftp' => '21',
			     'finger' => '1',
			     'file' => '1',
			     'who' => '1',
			 },
			 '0',
			 ],
	'Enchanted Electrons' => [
				  '0',
				  '66.120.161.238',
				  '4200',
				  '4201',
				  '0',
				  'Lima 1.0b2',
				  'Lima',
				  'MudOS v22.2b11',
				  'LP',
				  'game development',
				  'gwythinn@cris.com',
				  {
				      'channel' => '1',
				      'tell' => '1',
				      'auth' => '1',
				      'emoteto' => '1',
				      'locate' => '1',
				      'mail' => '1',
				      'http' => '80',
				      'ucache' => '1',
				      'ftp' => '21',
				      'finger' => '1',
				      'file' => '1',
				      'who' => '1',
				  },
				  '0',
				  ],
	'My Mud' => [
		     '0',
		     '80.225.204.6',
		     '7878',
		     '7879',
		     '0',
		     'Lima 1.0b2',
		     'Lima',
		     'MudOS v22.2b11',
		     'LP',
		     'game development',
		     'jeremyl@localhost',
		     {
			 'channel' => '1',
			 'tell' => '1',
			 'auth' => '1',
			 'emoteto' => '1',
			 'locate' => '1',
			 'mail' => '1',
			 'http' => '80',
			 'ucache' => '1',
			 'ftp' => '21',
			 'finger' => '1',
			 'file' => '1',
			 'who' => '1',
		     },
		     '0',
		     ],
	
    };

    my $channels = {
	'mrchat' => ['Flaming Coast DEV', 0],
	'imud_chat' => ['Desolation', 1] };

    
    $idb->addMuds('i3', $testmud, 1);
    $idb->addChannels('i3', $channels, 1);
    $idb->updateChannelStatus('mrchat', 1);
    my $testlist = $idb->getListenedChannels();
    print Dumper($testlist);
    $idb->closedb();
}

#testIntermudDB();

# Mudlist:
# mudlist_id ? (Storable?)
# (["Figment":({0,"202.59.100.34",7300,7305,0,"Skylib 1.6","Discworld","MudOS v22.2b13-DSv8","LP","Mudlib Development","shaydz@shaydz.mine.nu",(["emoteto":1,"who":1,"ftp":7302,"http":7303,"locate":1,"finger":1,"tell":1,"channel":1,]),([]),})
# Chanlist:
# (["mud2mud_admin":({"Alsherok",1,}),"iomtest":({"IOMdev",1,}),"mrimm":({"moonshae.isles",0,}) .. ])
# Ucache:
# ({"ucache-update",5,"DevilsLament",0,0,0,"Rayvyn","Rayvyn",0,})
#
#
# getMudName takes no 'type' parameter, but a 'preferred' parameter (i2, i3)
# and returns a hash of matching muds and their protocols?
# $result->{'Wunderland'}->['i2', 'i3'] .. ?