#!/opt/perl/bin/perl -w
# Communicate using intermud2 (Zebedee) with other muds. 
# Communication is done over a udp-connection
# $Date: 2003/04/05 07:11:49 $ $Revision: 1.2 $

package MUD::Intermud::v2;
use IO::Socket;
use Storable;
use Text::FormatTable;
use Text::Template;
#use Term::ReadKey;
use Data::Dumper;

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

sub new
{
    # Create new MUD::Internet::v2
    # Parameter: Class-Name/Reference, Properties
    my $class = shift;
    $class = ref($class) || $class;
    my $self = {};
    bless($self, $class);
    my $res = $self->init(@_);
    return $res ? $self : undef;
}

my $errormsg;

sub init
{
    # Setup default values.
    # Parameter: Object
    my ($me, $paramref) = @_;

    $errormsg = 'errormessage';
    $me->{$errormsg} = '';
    $me->{'mudname'} = $paramref->{'mudname'} || 'PerlMud';
    $me->{'data'}->{'hostfilename'} = $paramref->{'histfilename'} || 
	'etc/INETD_HOSTS';
    $me->{'data'}->{'types'} = ['error', 'error:timeout', 'error:mudname', 
				'query:commands', 'query:email', 'query:hosts',
				'query:inetd', 'query:list', 'query:info',
				'query:mud_port', 'query:time', 'query:users',
				'query:version', 'query:www', 
				'cmd:who', 'cmd:ping', 'cmd:tell', 'cmd:emote',
				'cmd:finger', 'cmd:man', 'cmd:locate',
				'cmd:mail',
				'cmd:reply:tell', 'cmd:reply:who', 
				'cmd:reply:ping', 'cmd:reply:emote', 
				'cmd:reply:finger', 'cmd:reply:man',
				'cmd:reply:locate_yes', 'cmd:reply:locate_no',
				'channel:cmd:list', 'channel:cmd:history',
				'channel:d-chat', 'channel:d-code',
				'channel:intermud', 'channel:intercode',
				'channel:d-news', 'channel:d-tv',
				'channel:d-tv-alles',
				'reply'];
    $me->{'DEBUG'} = $paramref->{'DEBUG'} || 'off';
    $me->{'data'}->{'muds'} = ();
    $me->{'PacketId'} = 0;
    $me->{'MessageId'} = 0;
    $me->{'IDs'} = ();
    $me->{'updates'} = ();
    $me->{'data'}->{'UpdateId'} = 0;
    $me->{'data'}->{'timeout'} = 20;

    # Callbacks:
    $me->{'callbacks'}->{'wholist'} = $paramref->{'wholist'} || \&getWhoList;
    $me->{'callbacks'}->{'fingerinfo'} = $paramref->{'fingerinfo'} || \&getFingerInfo;
    $me->{'callbacks'}->{'channelhist'} = $paramref->{'channelhist'} || \&getChannelHistory;
    $me->{'callbacks'}->{'channellist'} = $paramref->{'channellist'} || \&getChannelListener;
    $me->{'callbacks'}->{'isuser'} = $paramref->{'isuser'} || \&isUser;

    if($paramref->{'savefile'})
    {
	$me->{'savefile'} = $paramref->{'savefile'};
	$me->{'savetype'} = 'savefile';
	$me->{'data'} = retrieve($me->{'savefile'}) or
	    $me->debug("Can't retrieve " . $me->{'savefile'} . "\n");
    }

    if($paramref->{'database'})
    {
	$me->{'database'} = $paramref->{'database'};
	$me->{'savetype'} = 'database';
	$me->{'PacketId'} = 
	    $me->{'database'}->getParameter('i2', 'packetid') || 0;
	$me->{'MessageId'} = 
	    $me->{'database'}->getParameter('i2', 'messageid') || 0;
	$me->{'data'}->{'UpdateId'} = 
	    $me->{'database'}->getParameter('i2', 'updateid') || 0;
	$me->{'data'}->{'localport'} = 
	    $me->{'database'}->getParameter('i2', 'localport') || 4248;
	$me->{'data'}->{'commands'} = 
	    $me->{'database'}->getParameter('i2', 'commands') || 
		"ping:who:tell:channel:finger:locate:man";
	$me->{'data'}->{'email'} = 
	    $me->{'database'}->getParameter('i2', 'email') ||
	    "castaway\@desert-island.dynodns.net";
	$me->{'data'}->{'version'} = 
	    $me->{'database'}->getParameter('i2', 'version') ||
	    "PerlMud (Intermud-only) v2";
	$me->{'data'}->{'inetd'} = 
	    $me->{'database'}->getParameter('i2', 'inetd') ||
	    "PerlMud v2";
	$me->{'data'}->{'mud_port'} = 
	    $me->{'database'}->getParameter('i2', 'mud_port') || 0;
	$me->{'data'}->{'list'} = 
	    $me->{'database'}->getParameter('i2', 'list') ||
	    "commands:email:inetd:mud_port:version:time";
	$me->{'data'}->{'hostfilename'} = 
	    $me->{'database'}->getParameter('i2', 'hostfilename') ||
	    'etc/INETD_HOSTS';
	$me->{'data'}->{'timeout'} = 
	    $me->{'database'}->getParameter('i2', 'timeout') || 20;
    }

    if(!$paramref->{'database'} && !$paramref->{'savefile'})
    {
	return 0;
    }

    $me->{'i2socket'} = $me->opensocket($me->{'data'}->{'localport'});
    my $hostname = inet_ntoa(scalar gethostbyname('desert-island.dynodns.net'));
    $me->debug("Hostname: $hostname\n");
#    $me->addMud('PerlMud', $hostname, $me->{'data'}->{'localport'}, 'local');
#    $me->addMud('PerlMud', '192.168.1.1', $me->{'data'}->{'localport'}, 
#		++$me->{'data'}->{'UpdateId'}, 'local');
#    $me->send('perlmud', 'all', 'ping');
    return 1;
}

sub opensocket
{
    # Start server-udp socket.
    # Parameter: Object, Port
    my ($me, $port) = @_;

    my $sock = new IO::Socket::INET( LocalAddr => '192.168.1.1',
				     LocalPort => $port,
				     Proto     => 'udp',
				     Type      => SOCK_DGRAM,
				     Reuse     => 1);
    die "Can't start Server on port $port ($!)" unless $sock;

    return $sock;
}

sub closei2
{
    # Send shutdown, close socket, save data
    # Parameter: Object
    my ($me) = @_;
#    $me->{'data'}->{'PacketId'} = 
    if($me->{'database'})
    {
	$me->{'database'}->setParameter('i2', 'updateid',
					$me->{'data'}->{'UpdateId'});
	$me->{'database'}->setParameter('i2', 'timeout',
					$me->{'data'}->{'timeout'});
    }
    if($me->{'savefile'})
    {
	store $me->{'data'}, $me->{'savefile'};
    }

    my $sock = $me->{'i2socket'};
    if($sock && $sock->connected())
    {
	$sock->close();
    }
}

sub getSocket
{
    # Return our socket
    # Parameter: Object
    my ($me) = @_;

    return $me->{'i2socket'};
}

sub getEvents
{
    # Which types do we know?
    # Parameter: Object
    my ($me) = @_;

    return @{$me->{'data'}->{'types'}};
}

sub getAway
{
    # Change 'away' status
    # Parameter: Object, Value
    my ($me, $user) = @_;

    if($me->{'database'})
    {
	my $vals = $me->{'database'}->getValues('Users', 'Name', $user, 'away');
	$me->debug(Dumper($vals));
	if(!$vals)
	{
	    return '';
	}
	return $vals->[0];
    }
    return '';
}

sub send
{
    # Send a message to one or more muds.
    # Parameters: Object, User, Destination, Request, Parameters.
    my ($me, $user, $dest, $request, @params) = @_;

    my $message = '';
    $message .= 'NAME:' . $me->{'mudname'} . '|';
    $message .= 'UDP:' . $me->{'data'}->{'localport'} . '|';

    my $testmud = $dest;
    $me->debug("SendTo: $dest\n");
    if($dest ne 'all' && !defined($testmud = $me->getMudName($dest)))
    {
	my $result = {};
	$result->{'output'} = "Unknown mud: $dest\n" . 
	    $me->{$errormsg} . "\n";
	$result->{'type'} = 'error:mudname';
	$result->{'to'} = $user;
	$result->{'mud'} = $dest;
#	$me->debug(Dumper($result));
	return $result;
    }
    $dest = $testmud if($dest ne 'all');

    my $cds = 0;
    $cds = $me->canDoService($dest, $request) if($dest ne 'all');
    if($dest ne 'all' && !$cds)
    {
	my $result = {};
	$result->{'output'} = "$dest doesn't know service: $request\n" . 
	    $me->{$errormsg} . "\n";
	$result->{'type'} = 'error:service';
	$result->{'to'} = $user;
	$result->{'mud'} = $dest;
	$me->debug(Dumper($result));
#	return $result;
    }	
#    if($cds eq '-1')
#    {
#	$me->queryMud($dest);
#    }

    my $method = 'send' . $request;
    $me->debug("Method: $method\n");

    if($me->can($method))
    {
# lowercase!
	my $ans = $me->$method($user, ($dest eq 'all' ? '' : $dest), 
			       @params);
	if(!defined($ans))
	{
	    $me->debug("Method $method returned no Message: " . $me->{$errormsg} . "\n");
	    return 0;
	}
	$message .= $ans;
	$me->debug("Result: $message\n");
    }
    else
    {
	$me->debug("$request not implemented.\n");
	return 0;
    }

    $me->debug("SendTo: $dest\n");
    my $muds = $me->getAddressList($dest, 
				   $request eq 'channel' ? $params[0] : '',
				   $request eq 'channel' ? 1 : 0);
    if(!defined($muds) || !@{$muds})
    {
	$me->debug("No Muds\n");
	return 0;
    }

    if($dest ne 'all' && $cds eq '-1')
    {
	$me->queryMud($dest, $muds->[1], $muds->[2]);
    }

    my $i = 0;
    my $newid;
    # Always returns 'channel:cmd:list' by channels!
    my $requesttype = (grep /$request/, @{$me->{'data'}->{'types'}})[0];
    $me->debug("Requesttype: $requesttype\n");
    while ($i < @{$muds})
    {
	my $mud = [$muds->[$i], $muds->[$i + 1], $muds->[$i + 2]];
	$i += 3;
	$me->debug("MUD: " . $mud->[0] . "\n");
#	$me->debug("Message: $message\n");
	if($dest eq 'all' && $message =~ /ID:\d+\|.*?DATA:/)
	{
	    # Add a unique ID to each packet
	    $newid = $me->getNewID("$requesttype");
	    $message =~ s/ID:\d+\|(.*?DATA:.*)/ID:$newid\|$1/;
	    $me->addIDMesg($newid, $mud->[0], $message); #!!!
	    $me->debug("Message: $message\n");
	}
	my $pkts = $me->getPackets($message);
    
	$me->sendPackets($mud, @{$pkts});
    }
#    $me->debug("PktIDs:" . Dumper($me->{'IDs'}));
    return 0;
}

sub getPackets
{
    # Convert a message to packet(s)
    # Packethead: 'PKT:PerlMud:00000:Num/Num|'
    # Parameter: Object, Message
    my ($me, $mesg) = @_;

    my @packets = ();

    if(!defined($mesg))
    {
	return ();
    }
    if(length($mesg) <= 1024)
    {
	$packets[0] = $mesg;
	return \@packets;
    }

    my $numpackets = int(length($mesg) / (1024-24));
    $numpackets = $numpackets * (1024-24) < length($mesg) ?
	$numpackets + 1 : $numpackets;
    $me->{'PacketId'}++;
    my $packetid = '0' x (5-length($me->{'PacketId'})) . 
	$me->{'PacketId'};
    for my $i (1..$numpackets)
    {
	my $pkttext = "PKT:PerlMud:$packetid:";
	$pkttext .= '0' x (3-length($i)) . $i . "/";
	$pkttext .= '0' x (3-length($numpackets)) . $numpackets . "|";
	$pkttext .= substr($mesg, 0, (1024-24), '');
	$packets[$i-1] = $pkttext;
#	$packets[scalar(@packets)] = $pkttext;
    }
#    $me->debug('Packets:' . Dumper(\@packets));

    return \@packets;
}

sub changeStatus
{
    # Change UP/DOWN status
    # Parameter: Object, Mudname(s), Status
    my ($me, $status, @mudnames) = @_;

    if(!$mudname || !defined($status))
    {
	return 0;
    }
    if($status ne 'UP' && $status ne 'DOWN')
    {
	return 0;
    }

    if($me->{'savefile'} && @mudnames)
    {
	foreach my $m (@mudnames)
	{
	    $me->{'data'}->{'muds'}->{lc($m)}->{'Status'} = $status;
	}
    }

    $status = $status eq 'UP' ? '-1' : '0';
    if($me->{'database'} && @mudnames)
    {
	$me->{'database'}->updateMudStatus(\@mudnames, $status);
    }
    return 1;
}

sub updateMud
{
    # Update or add a mud to our database
    # Parameter: Object, MudName, IP, UDPPort
    my ($me, $from, $mudname, $ip, $port) = @_;

    # If MudName doesnt exist/cant be found, assume that its new:
    $me->debug("updateMud: MudName: $mudname\n");
    return if($mudname eq $me->{'mudname'});

    if(!defined($me->getMudName($mudname)))
    {
	$me->debug("updateMud: call addMud: $mudname\n");
	return $me->addMud($mudname, $ip, $port, $from);
    }

    my ($cname, $cip, $cport) = @{$me->getAddressList($mudname, '', 0)};
    if(!$cname || !$cip || !$cport)
    {
	$me->debug("updateMud: Oops, no cname, cip or cport\n");
	return 0;
    }
    if($cname eq $mudname && $cip eq $ip && $cport eq $port)
    {
	$me->debug("updateMud: Same Name, IP, Port\n");
	return 1;
    }

    # Ping IP/Port and see if anyone is there
    my $mesgid = $me->getNewID('ping');
    my $mesg = "NAME:" . $me->{'mudname'} . 
	"|UDP:" . $me->{'data'}->{'localport'} . "|" .
	    "REQ:ping|ID:$mesgid|DATA:";
    $me->addIDMesg($mesgid, $mudname, $mesg);

    $me->sendPackets([$mudname, $ip, $port], $mesg);

    $me->{'updates'}->{lc($mudname)}->{$mesgid} = 
    {'IP' => $ip,
     'Port' => $port,
     'From' => $from };

    $me->debug("ChangedIP: $cip->$ip, $cport->$port. Pinged: $mesgid\n");
}

sub queryMud
{
    # Query all 'query' values of a mud
    # Parameter: Object, Mudname
    my ($me, $mudname, $ip, $port) = @_;

    $me->debug("queryMud: $mudname, $ip, $port\n");

    $me->{'data'}->{'muds'}->{lc($mudname)}->{'IP'} = $ip;
    $me->{'data'}->{'muds'}->{lc($mudname)}->{'UDP'} = $port;
    $me->{'data'}->{'muds'}->{lc($mudname)}->{'Status'} = 'UP';
    $me->{'data'}->{'muds'}->{lc($mudname)}->{'Time'} = time();

    $me->send('perlmud', $mudname, 'query', 'inetd');
    $me->send('perlmud', $mudname, 'query', 'email');
    $me->send('perlmud', $mudname, 'query', 'mud_port');
    $me->send('perlmud', $mudname, 'query', 'commands');
    $me->send('perlmud', $mudname, 'query', 'list');

}

sub addMud
{
    # Add or update a mud to our list.
    # Parameter: Object, MudName, IP, UDPPort
    my ($me, $mudname, $ip, $port) = @_;

    my $res;
    my $ismud = $me->getMudName($mudname);
    if(defined($ismud))
#$me->{'data'}->{'muds'}->{lc($mudname)})
    {
	$res = $me->{'database'}->updateMudContact('i2', $mudname, $ip, $port);
    }
    if($res)
    {
	return $res;
    }

    if(!defined($ismud))
    {
#    my ($me, $user, $dest, $request, @params) = @_;
	$me->queryMud($mudname, $ip, $port);
    }

    if($me->{'database'})
    {
	my $mudn = $mudname;
#	$mudn =~ s/'/\\'/;
#	$mudn =~ s/"/\\"/;
	$me->{'database'}->addMuds('i2', {$mudn => 
      [$me->{'data'}->{'muds'}->{lc($mudname)}->{'IP'},
       $me->{'data'}->{'muds'}->{lc($mudname)}->{'UDP'},
       '',
       $me->{'data'}->{'muds'}->{lc($mudname)}->{'Status'} eq 'UP' ? -1 : 0,
       '',
       '',
       '']}, $me->{'data'}->{'UpdateId'}++);
    }

}

sub addNewMudInfo
{
    # Get/Set information for a new mud
    # Parameter: Object, Mudname, Type, Value
    my ($me, $mudname, $info, $value) = @_;

    $me->debug("addNewMudInfo: Got: $mudname, $info, $value\n");

    if($info eq 'inetd')
    {
	$me->{'data'}->{'muds'}->{lc($mudname)}->{'inetd'} = $value;
    }
    elsif($info eq 'email')
    {
	$me->{'data'}->{'muds'}->{lc($mudname)}->{'adminemail'} = $value;
    }
    elsif($info eq 'mud_port')
    {
	$me->{'data'}->{'muds'}->{lc($mudname)}->{'mud_port'} = $value;
    }
    elsif($info eq 'commands')
    {
	$me->{'data'}->{'muds'}->{lc($mudname)}->{'commands'} = $value;
    }
    elsif($info eq 'list')
    {
	$me->{'data'}->{'muds'}->{lc($mudname)}->{'list'} = $value;
    }
    else
    {
	$me->debug("addNewMudInfo: Invalid Type! $info, $value\n");
    }

    if(
       defined($me->{'data'}->{'muds'}->{lc($mudname)}->{'IP'}) &&
       defined($me->{'data'}->{'muds'}->{lc($mudname)}->{'UDP'}) &&
       defined($me->{'data'}->{'muds'}->{lc($mudname)}->{'inetd'}) &&
       defined($me->{'data'}->{'muds'}->{lc($mudname)}->{'adminemail'}) &&
       defined($me->{'data'}->{'muds'}->{lc($mudname)}->{'mud_port'}) &&
       defined($me->{'data'}->{'muds'}->{lc($mudname)}->{'commands'}) &&
       $me->{'database'})
    {
	$me->{'database'}->addMuds('i2', {$mudname => 
      [$me->{'data'}->{'muds'}->{lc($mudname)}->{'IP'},
       $me->{'data'}->{'muds'}->{lc($mudname)}->{'UDP'},
       $me->{'data'}->{'muds'}->{lc($mudname)}->{'mud_port'},
       $me->{'data'}->{'muds'}->{lc($mudname)}->{'Status'} eq 'UP' ? -1 : 0,
       $me->{'data'}->{'muds'}->{lc($mudname)}->{'inetd'} || '',
       $me->{'data'}->{'muds'}->{lc($mudname)}->{'adminemail'} || '',
       $me->{'data'}->{'muds'}->{lc($mudname)}->{'commands'} || '',
       $me->{'data'}->{'muds'}->{lc($mudname)}->{'list'} || '']},
       $me->{'data'}->{'UpdateId'}++);
    }
}

sub getAddressList
{
    # Get a list of Names, IPs and Ports according to the parameter
    # Parameter: Object, Muds, Channel, Active Yes/No
    my ($me, $muds, $channel, $active) = @_;

#    $me->debug("getAddressList Muds: $muds, Active: $active\n");
#    my @caller = caller(1);
#    $me->debug(Dumper(\@caller));

    if($muds eq 'all' && $channel)
    {
	if($me->{'database'})
	{
	    my $channels = $me->{'database'}->getListenedChannels();
	    if(grep(/$channel/, @{$channels}))
	    {
		# Reset muds to the ones that are listening..
		my $chanmuds = $me->{'database'}->getChannelMuds($channel);
		if(defined($chanmuds))
		{
		    $muds = join(', ', @{$chanmuds});
		    $me->debug("Muds: $muds\n");
		}
	    }
	}
    }

    if($me->{'database'})
    {
	# space separated $muds ?
	my $ans = $me->{'database'}->getIPPort('i2', 'UDP', $active, $muds);
	if(!defined($ans))
	{
	    $me->debug($me->{'database'}->getError() . "\n");
	    return undef;
	}
	$me->debug("Got IPPort: " . Dumper($ans));
	return $ans;
    }

    if($me->{'savefile'})
    {
	my $result = ();
	foreach my $mud (keys %{$me->{'data'}->{'muds'}})
	{
#	    if(lc($muds) eq 'all' || lc($muds) eq $mud)
	    if(lc($muds) eq 'all' || grep(/$mud/, split(/,\s?/, lc($muds))))
	    {
		next if($active && $mud->{'Status'} eq 'UP');
		$result->[scalar @{$result}] = [$muds,
						$mud->{'IP'}, 
						$mud->{'UDP'}];
	    }
	}
	return $result;
    }
    return 0;
}

sub sendPackets
{
    # Send an array of packets to a given IP and Port
    # Parameter: Object, Name/IP/Port array, Packets array
    my ($me, $mud, @pkts) = @_;

    $me->debug(Dumper($mud));
    return if(!defined($mud) || ref($mud) ne 'ARRAY' || @{$mud} != 3||
	      !$mud->[2] || !$mud->[0] || 
	      $mud->[2] !~ /\d+/ || $mud->[2] < 1024);

#    $me->debug(Dumper($mud));
    my $sockout = new IO::Socket::INET( PeerAddr => $mud->[1],
					PeerPort => $mud->[2],
					Proto    => 'udp',
					Type     => SOCK_DGRAM,
					Timeout  => 20 );
    $me->{$errormsg} = "Can't connect to: " . $mud->[1] . ":" . $mud->[2] .
	" ($!)", return 0 unless $sockout;
    foreach my $m (@pkts)
    {
	$me->debug("Mesg an " . $mud->[0] . ", " . 
		   $mud->[1] . ", " . $mud->[2] . ": $m\n");
	print $sockout $m;
    }
    $sockout->close();
    
    return 1;
}

sub getNewID
{
    # Get the next available ID
    # Parameter: Object, Type
    my ($me, $type) = @_;
    
    $me->{'MessageId'}++;
    $me->debug("MessageID: " . $me->{'MessageId'} . "\n");
#    my @caller = caller(1);
#    $me->debug(Dumper(\@caller));

    $me->{'IDs'}->{$me->{'MessageId'}} = 
	{'type'    => $type,
	 'timer'   => getNewTimer(),
	 'timeout' => $me->{'data'}->{'timeout'},
	 'counter' => 1,
	 'mud'     => '',
	 'message' => ''};

    return $me->{'MessageId'};
}

sub addIDMesg
{
    # Add the actual message sent to our IDs list
    # Parameter: Object, ID, Mud, Message
    my ($me, $id, $mud, $mesg) = @_;

    if(!$me->{'IDs'}->{$id})
    {
	return 0;
    }
    my $IPPort;
    my $mname = $mud;
    if(ref($mud) eq 'ARRAY')
    {
	$IPPort = [$mud->[0], $mud->[1], $mud->[2]];
	$mname = $IPPort->[0];
    }
#    $me->debug(Dumper($IPPort));

    if(!length($mname))
    {
	$me->removeID($id, $me->{'IDs'}->{$id}->{'type'});
	return 0;
    }
    $me->{'IDs'}->{$id}->{'message'} = $mesg;
    $me->{'IDs'}->{$id}->{'mud'} = $mname;
    $me->{'IDs'}->{$id}->{'ipport'} = $IPPort if($IPPort);
}

sub checkTimeouts
{
    # Check all timeout times to see if any have runout.
    # Parameter: Object, ?
    my ($me) = @_;

#    $me->debug("checkTimeout\n");
    my @timeouts = grep
			{
#			    $me->debug("Timeout: $_: " . 
#				       $me->{'IDs'}->{$_}->{'timer'}->() . "\n"
#				       ); 
			    $me->{'IDs'}->{$_}->{'timer'}->() >= 
				$me->{'IDs'}->{$_}->{'timeout'}; 
			}
    keys %{$me->{'IDs'}}
    ;

    return '0' if(!@timeouts);
#    $me->debug("PktIDs:" . Dumper($me->{'IDs'}));
#    $me->debug(Dumper(\@timeouts));

    my $counter = 1;
    my @pkts = ();
    my $result = {};
    my @statuschangesd = ();
    my $addrlist = '';
    $result->{'type'} = 'error:timeout';
    $result->{'output'} = '';

#    $me->debug("Timeouts: " . @timeouts . "\n");
    foreach my $id (@timeouts)
    {
	if($me->{'IDs'}->{$id}->{'counter'} >= 3)
	{
	    my $mud = $me->{'IDs'}->{$id}->{'mud'};
#	    $me->debug("$id:" . 
#		       $me->{'IDs'}->{$id}->{'message'} .
#		       " timed out completely!\n");
	    $result->{'output'} .= 
		"Timeout talking to " . $mud . "\n";
	    if(defined($me->{'updates'}->{lc($mud)}->{$id}))
	    {
		# This was an update attempt..
		$me->failUpdate($mud,
				$me->{'updates'}->{lc($mud)}->{$id});
		delete $me->{'updates'}->{lc($mud)}->{$id};
		if(!$me->{'updates'}->{lc($mud)})
		{
		    delete $me->{'updates'}->{lc($mud)};
		}
	    }
	    else
	    {
		# does 200 updates to set status.. collect and do
		# just one with 'where name in ( .. ) ?
		$statuschangesd[scalar(@statuschangesd)] = 
		    $me->{'IDs'}->{$id}->{'mud'};
#		$me->changeStatus('DOWN', $me->{'IDs'}->{$id}->{'mud'});
	    }

	    delete $me->{'IDs'}->{$id};
	}
	else
	{

	    my $p = $me->getPackets($me->{'IDs'}->{$id}->{'message'});

	    $addrlist .= $me->{'IDs'}->{$id}->{'mud'} . ",";

	
	    $me->{'IDs'}->{$id}->{'timer'} = getNewTimer();
	    $me->{'IDs'}->{$id}->{'counter'}++;

	    $pkts[scalar(@pkts)] = $p;
	}
    }
    $me->debug("stcd: @statuschangesd\n");
    if(@statuschangesd)
    {
	$me->changeStatus('DOWN', @statuschangesd, 'DOWN');
    }

    $me->debug("Timeout count: " . scalar @timeouts . "\n") if(@timeouts);

    if(@pkts)
    {
	my $muds = $me->getAddressList($addrlist, '', 0) if(length($addrlist));
	my $i = 0;
#	foreach my $p (0 .. @pkts - 1)
#!! $muds is not the same length as @pkts?? maybe some muds are in there
# twice?
	foreach my $p (0 .. (@$muds / 3) - 1)
	{
	    my $mud = [$muds->[$i], $muds->[$i+1], $muds->[$i+2]];
# !!
#	    next if(!$mud->[0]);
	    $me->sendPackets($mud, @{$pkts[$p]});
#	    $me->sendPackets($p->[0], @{$p->[1]});
	    $i += 3;
	}
    }
    $me->debug("Timeout count: " . scalar @timeouts . "\n") if(@timeouts);
    return $result if(length($result->{'output'}));

    return '0';
}

sub removeID
{
    # Delete an ID from the list, if it exists
    # Parameter: Object, ID, Type
    my ($me, $id, $type) = @_;

    $me->debug("Removing: $id, $type\n");

    if(!$id || !$type)
    {
	return 0;
    }

    if(defined($me->{'IDs'}->{$id} && 
		$me->{'IDs'}->{$id}->{'type'} eq $type))
    {
	delete $me->{'IDs'}->{$id};
    }
}

sub isID
{
    # Return true if ID exists and has the given type
    # Parameter: Object, ID, Type
    my ($me, $id, $type) = @_;

    $me->debug("isID: $id, $type\n");
    if(defined($me->{'IDs'}->{$id}) && 
		$me->{'IDs'}->{$id}->{'type'} eq $type)
    {
	return 1;
    }
    return 0;
}

sub isUser
{
    # Is this a local user? ;)
    # Parameter: Object, Name
    my ($me, $name) = @_;

    if($me->{'database'})
    {
	return $me->{'database'}->isUser($name);
    }
    return 1 if(lc($name) eq 'castaway');
    return 0;
}

sub getWhoList
{
    # Create a wholist as a who reply
    # Parameter: Object
    my ($me) = @_;

    my $answer = '';
    $answer .= '-' x 79 . "\n";
    $answer .= ' ' x 35 . "PerlMud\n";
    $answer .= "[Admin] Lady Castaway bastelt rum.\n";
    $answer .= '-' x 79 . "\n";
	
    return $answer;
}

sub getFingerInfo
{
    # Default finger information
    # Parameter: Object, Name
    my ($me, $request) = @_;

    my $answer = '';
    if($me->isUser($request{'data'}))
    {
	$answer .= "DATA:" . ucfirst($request{'data'}) . " is here.";
    }
    else
    {
	$answer .= "DATA:" .  $me->{'mudname'} . 
	    "I don't know " . ucfirst($request{'data'});
    }

    return $answer;
}

sub parseHostList
{
    # Parse the host list of another mud
    # Parameter: Object, HostList
    my ($me, $from, $hostlist) = @_;

    my @lines = split(/\n/, $hostlist);
    foreach my $l (@lines)
    {
	$me->debug("Line: $l\n");
	$l =~ /^(.+):(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}):(.+?):([^:]*):([^:]*)/;
	next if($3 eq '-1');
	my $port = ($3 eq '-1' ? 0 : $3);
	$me->debug("Name: $1, IP: $2, Port: $3\n");

	$me->updateMud($from, $1, $2, $port); 
    }
}

sub failUpdate
{
    # Report a failed update attempt?
    # Parameter: Object, MudName, {IP, Port, From}
    my ($me, $mudname, $info) = @_;

    $me->debug($info->{'From'} . " thinks the IP:Port of $mudname changed to ".
	       $info->{'IP'} . ":" . $info->{'Port'} . ", but it didn't!\n");
}

sub getHostList
{
    # Prepare our host list for another mud
    # Parameter: Object
    my ($me) = @_;

    if($me->{'database'})
    {
	my $mudlist = $me->{'database'}->listMuds(('Name', 'IP', 'udpport',
						   'commands', 'list'));
	if(!defined($mudlist))
	{
	    $me->{$errormsg} = "Error getting hostlist: " . 
		$me->{'database'}->getError();
	    return undef;
	}
	my $hostlist = '';
	foreach my $line (@{$mudlist->[1]})
	{
	    foreach my $item (@{$line}[0..$#$line - 1])
	    {
		$hostlist .= "$item:";
	    }
	    $hostlist .= "*:*\n";
#	    $hostlist =~ s/:$/\n/;
	}
	$me->debug("HOSTLIST" . Dumper($hostlist));
	return $hostlist;
    }
    if($me->{'savefile'})
    {
	my @muds = keys(%{$me->{'data'}->{'muds'}});
	my $hostlist = '';
	foreach my $m (@muds)
	{
	    my $mud = $me->{'data'}->{'muds'}->{$m};
	    $hostlist .= lcfirst($m) . ":" . $mud->{'UDP'} . ":" . 
		$mud->{'commands'} . ":" . $mud->{'list'} . "\n";
	}
	return $hostlist;
    }
    return undef;
}

sub listMuds
{
    # Get mudlist from database 
    # Parameter: Object, Columns
    my ($me, @cols) = @_;

    my $result;
    $result->{'type'} = 'info';
    $result->{'output'} = '';
    if($me->{'database'})
    {
	my $mudlist = $me->{'database'}->listMuds(@cols);
	if(!$mudlist)
	{
	    $me->debug("Error getting mudlist: " . 
		       $me->{'database'}->getError() . "\n");
	    return '0';
	}
	
	my $names = $mudlist->[0];
	my $muds = $mudlist->[1];
	my $rowlen = @{$muds->[0]};
	my @lcind = grep {$names->[$_] eq 'last contact'} 0..(@{$names}-1);
	my @statusind = grep {$names->[$_] eq 'status'} 0..(@{$names}-1);
#	$me->debug(Dumper($names));
#	$me->debug(Dumper($mudlist));

	my $table = Text::FormatTable->new('l' x $rowlen);

	$table->head(map {ucfirst} (@{$names}));
	foreach my $row (@{$muds})
	{
	    if(@lcind && $row->[$lcind[0]] =~ /^\d+$/)
	    {
		my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
		    localtime($row->[$lcind[0]]);
		$row->[$lcind[0]] = sprintf("%02d.%02d.%02d %02d:%02d:%02d ", 
					    $mday,$mon + 1,$year % 100,
					    $hour,$min,$sec);
	    }
	    if(@statusind)
	    {
		$row->[$statusind[0]] = $row->[$statusind[0]] eq '-1' ? 
		    'UP' : 'DOWN';
	    }
	    if(@{$row} == $rowlen)
	    {
		$table->row(@{$row});
	    }
	}
	$result->{'output'} = $table->render(79);
    }
    elsif($me->{'savefile'})
    {
	my $mudlist = '';
	my $table = Text::FormatTable->new('llll');
	my @muds = sort(keys(%{$me->{'data'}->{'muds'}}));
	foreach my $m (@muds)
	{
	    my $mud = $me->{'data'}->{'muds'}->{lc($m)};
	    $table->row(ucfirst($m), $mud->{'IP'}, $row->{'UDP'}, 
			$row->{'Status'});
	}
	$result->{'output'} = $table->render(79);
    }	
    return $result;
}

sub getChannelHistory
{
    # Return a history of the given channel
    # Parameter: Object, Channel
    my ($me, $channel) = @_;

    return '';
}

sub getChannelListener
{
    # Return a list of listeners of this channel
    # Parameter: Object, Channel
    my ($me, $channel) = @_;

    return '';
}

sub getMudName
{
    # Correct the case of a mud name, if it exists in the database.
    # Parameter: Object, Name
    my ($me, $name) = @_;
    
    my $testname = lc($name);
    my $mudname;
    
    $me->{$errormsg} = '';

    my @matches;
    if($me->{'database'})
    {
	my $vals = $me->{'database'}->getMudName('i2', $testname);
#	$me->debug(Dumper($vals));
	if(!defined($vals))
	{
	    print "Oops: " . $me->{'database'}->getError();
	    return undef;
	}
	@matches = @{$vals};
	if(@matches == 1)
	{
	    return $matches[0];
	}
    }
    elsif($me->{'savefile'})
    {
	@matches = grep(/^$testname/, keys(%{$me->{'data'}->{'muds'}}));
	if(@matches == 1)
	{
	    $testname = $matches[0];
	    return ( keys %{$me->{'data'}->{'muds'}->{$testname}} )[0];
	}
    }

    if(@matches > 1)
    {
	$me->{$errormsg} = "Too many matches: " . join(", ", @matches);
	return undef;
    }
    else
    {
	$me->{$errormsg} = "No match found: " . $name;
	return undef;
    }

    return undef;
    
}

sub canDoService
{
    # Return true if the given mud accepts a given service (commands list)
    # Parameter: Object, Mud, Service
    my ($me, $mud, $service) = @_;

    $service = lc($service);

    return 1 if($service eq 'query' || $service eq 'reply');

    if($me->{'database'})
    {
	my $services = $me->{'database'}->getMudServices('i2', $mud);
	$me->debug("Services: " . Dumper($services));
	if(!@{$services})
	{
	    # Error getting service(s)
	    $me->debug("Can't get services for $mud\n");
	    return -1;
	}
	return 1 if(grep(/$service/, @{$services}));
	return 0;
    }
    elsif($me->{'savefile'})
    {
	my $commands = $me->{'data'}->{'muds'}->{lc($mud)}->{'commands'};
	if(!@{$commands})
	{
	    # No commands known!
	    $me->debug("Don't know any commands for $mud\n");
	    return -1;
	}
	return 1 if(grep(/$service/, split(/,/, $commands)));
	return 0;
    }
    return 0;
    
}

sub getNewTimer
{
    # Start a new timer and return a pointer to it
    # Parameter: Object
    my ($me) = @_;

    my $timer = time();
    return sub { return time() - $timer; }
}

sub convertTemplate
{
    # Retrieve a template and parse it with a request
    # Parameter: Object, Template, Request hashref
    my ($me, $ttype, $request) = @_;

    if($me->{'database'})
    {
	my $temp = $me->{'database'}->getValues('Templates', 'Name', $ttype,
						'Value');
	if(!$temp || !@{$temp})
	{
	    $me->debug("Error retrieving template: $ttype. " . 
		  $me->{'database'}->getError() . "\n");
	    return '';
	}
	$me->debug("Template:" . Dumper($temp));

	my $template = Text::Template->new(TYPE => STRING,
					   SOURCE => $temp->[0]);

	my $result = $template->fill_in(HASH => $request);
	$me->debug("Template:" . Dumper($result));

	return $result;
    }
    return '';
}

##############################################################################
# Send methods

sub sendping
{
    # Prepare a 'ping' packet to see if a mud replies.
    # Parameter: Object, Mud
    my ($me, $user, $mud) = @_;

    my $pingid = $me->getNewID('cmd:ping');
    if(!defined($pingid))
    {
	return undef;
    }
    
    my $result = "ID:$pingid|REQ:ping|DATA:";
    $me->addIDMesg($pingid, $mud, $result);

    return $result;
}

sub sendquery
{
    # Prepare a query packet
    # Parameter: Object, QueryType
    my ($me, $user, $mud, $qtype) = @_;

    my @types = ('commands', 'email', 'hosts', 'inetd', 'list', 'info', 
		 'mud_port', 'time', 'users', 'version', 'www');
    my @grep;
    if(!(@grep = grep {$_ eq $qtype} @types))
    {
	$me->{$errormsg} = "No such query type: $qtype";
	return undef;
    }
    
    my $queryid = $me->getNewID('query:' . $grep[0]);
    if(!defined($queryid))
    {
	return undef;
    }

    my $mesg = "REQ:query|ID:$queryid|SND:$user|DATA:$qtype";
    $me->addIDMesg($queryid, $mud, $mesg);

    return $mesg;
}

sub sendreply
{
    # Send an answer to a remote request
    # Parameter: Object, Answer
    my ($me, $user, $mud, $answer) = @_;

    $answer = '$' . $answer if(substr($answer, 0, 1) eq '$');
    return 'REQ:reply|' . $answer;
}

sub sendwho
{
    # Send a who-request
    # Parameter: Object, Mudname
    my ($me, $user, $mud, $switches) = @_;

    my $whoid = $me->getNewID('cmd:who');
    if(!defined($whoid))
    {
	return undef;
    }

    my $mesg = "REQ:who|ID:$whoid|SND:$user|DATA:" . 
	($switches ? $switches : '');
    $me->addIDMesg($whoid, $mud, $mesg);

    return $mesg;
}

sub sendtell
{
    # Send a tell-message
    # Parameter: Object, Name, Message
    my ($me, $user, $mud, $name, $message) = @_;

    my $tellid = $me->getNewID('cmd:tell');
    if(!defined($tellid))
    {
	return undef;
    }

    $message = '$' . $message if(substr($message, 0, 1) eq '$');
    my $mesg = "REQ:tell|ID:$tellid|SND:$user|RCPNT:$name|DATA:$message";
    $me->addIDMesg($tellid, $mud, $mesg);

    return $mesg;
}

sub sendemote
{
    # Send an emote
    # Parameter: Object, Name, Emote
    my ($me, $user, $mud, $name, $emote) = @_;

    my $emoteid = $me->getNewID('cmd:emote');
    if(!defined($emoteid))
    {
	return undef;
    }

    $emote = '$' . $emote if(substr($emote, 0, 1) eq '$');
    my $mesg = "REQ:tell|ID:$emoteid|METHOD:emote|SND:$user|" . 
      "RCPNT:$name|DATA:*$emote* ";
    $me->addIDMesg($emoteid, $mud, $mesg);

    return $mesg;    
}

sub sendfinger
{
    # Get information about a player
    # Parameter: Object, Name
    my ($me, $user, $mud, $name) = @_;

    my $fingerid = $me->getNewID('cmd:finger');
    if(!defined($fingerid))
    {
	return undef;
    }

    my $mesg = "REQ:finger|ID:$fingerid|SND:$user|DATA:$name";
    $me->addIDMesg($fingerid, $mud, $mesg);

    return $mesg;
}

sub sendchannel
{
    # Send a channel message
    # Parameter: Object, Channel, Command
    my ($me, $user, $mud, $channel, $command, $text) = @_;

#@args = ('all', 'channel', $1, '', $2);

    $me->debug("sendchannel: Channel: $channel, Command: $command, Mesg: $text\n");
    my @ccommands = ('list', 'history', 'emote', 'gemote', '');
    my @coms = grep {$_ eq $command} @ccommands;
    if(!@coms && length($command))
    {
	$me->{$errormsg} = "Unknown channel command: $command";
	return undef;
    }

    my $mesg = '';
    if($command eq 'list' || $command eq 'history')
    {
	my $chanid = $me->getNewID("channel:cmd:$command");
	$mesg .= "ID:$chanid|CMD:$command|";
    }
    if($command eq 'emote')
    {
	$mesg .= "EMOTE:1|CMD:emote|";
    }
    if($command eq 'gemote')
    {
	$mesg .= "EMOTE:2|CMD:emote|";
    }

    $text = '$' . $text if(substr($text, 0, 1) eq '$');
    $text = '$' . $text if($text =~ /^\d+$/);                  #'
    $mesg .= "REQ:channel|CHANNEL:$channel|SND:$user|DATA:$text";
    return $mesg;
}

sub sendman
{
    # Request a manpage from another mud
    # Parameter: Object, Manpage
    my ($me, $user, $mud, $page) = @_;

    my $manid = $me->getNewID('cmd:man');
    if(!defined($manid))
    {
	return undef;
    }

    my $mesg = "REQ:man|ID:$manid|SND:$user|DATA:$page";
    $me->addIDMesg($manid, $mud, $mesg);

    return $mesg;
}

sub sendlocate
{
    # Try to locate another player somewhere
    # Parameter: Object, Player, Type
    my ($me, $user, $mud, $player, $type) = @_;

    my $locateid = $me->getNewID('cmd:locate');
    if(!defined($locateid))
    {
	return undef;
    }
    if($type !~ /1|2/)
    {
	$me->{$errormsg} = "Unknown Locate type: $type";
	return undef;
    }

    my $mesg = "REQ:locate|ID:$locateid|SND:$user|user:$user|" . 
      "vbs:$type|DATA:$player";
    $me->addIDMesg($locateid, $mud, $mesg);

    return $mesg;    
}

sub sendmail
{
    # Send a mail to a user on another mud
    # Parameter: Object, User, Mud, To, Subject, Data
    my ($me, $user, $mud, $to, $subject, $mail) = @_;

    $me->debug(Dumper(\@_[1..$#_]));

    my $mailid = $me->getNewID('cmd:mail');
    my $mesg = "REQ:mail|ID:$mailid|SND:perlmud|udpm_writer:$user";
    $mesg .= "|udpm_spool_name:$mailid|udpm_subject:$subject";
    $mesg .= "|RCPNT:$to|DATA:$mail";

    return $mesg;
}

##############################################################################
# Parse Mud reply

sub readData
{
    # Read Data from the socket, parse, and call function to Output/Reply
    # Parameter: Object
    my ($me) = @_;

    my $sock = $me->{'i2socket'};

    my $buffer;
    my $remoteaddress;
    my $addr = recv($sock, $buffer, 1024, 0);
    if($addr)
    {
	my ($xport, $iaddr) = unpack_sockaddr_in($addr);
	$remoteaddress = inet_ntoa($iaddr);
	$me->{'remoteaddress'} = $remoteaddress;
	$me->debug("Remoteaddress: $remoteaddress:$xport\n");
    }
    
    # Filter special chars!
#    $buffer =~ s/[^ -~]//sg;

    # Collect packet pieces
    # Data comes in packets, denoted by 'PKT:<mudname>:<packetindex>:<packetteilnum>/<countteile>|'
    
    if($buffer =~ /PKT:(.+?):(\d+):(\d+)\/(\d+)\|(.*)/s)
    {
	my ($mudname, $pindex, $ppart, $pcount, $data) = ($1, int($2), 
							  int($3), int($4),
							  $5);
	$me->debug("Packet received: $buffer\n");
	$me->{'packets'}->{$mudname}->{$pindex}->{'data'}->{$ppart} = $data;
	my $pkts = scalar(keys(%{$me->{'packets'}->{$mudname}->
				 {$pindex}->{'data'}}));
	if($pkts == $pcount)
	{
	    # Got all packets
	    $buffer = '';
	    
	    for my $item (1..$pkts)
	    {
		$me->debug("Packetpart: " . $me->{'packets'}->{$mudname}->
			   {$pindex}->{'data'}->{$item} . "\n");
		$buffer .= $me->{'packets'}->{$mudname}->
		           {$pindex}->{'data'}->{$item};
	    }
	    $me->debug("Packet decoded: $buffer\n");
	    delete $me->{'packets'}->{$mudname}->{$pindex};
	    return $me->parseData($buffer);
	}
    }
    else
    {
	return $me->parseData($buffer);
    }
    return '0E0' # Not finished yet
}

sub parseData
{
    # Parse a complete request
    # Parameter: Object, Data
    my ($me, $data) = @_;

    my %request;
    my $isdata = 0;
	
    $me->debug("Request is: $data\n");

    my @commands = split(/\|/, $data);
    if(@commands)
    {
	foreach my $com (@commands)
	{
	    if($isdata)
	    {
		$request{'data'} .= "|$com";
		next;
	    }
	    
	    $com =~ /^(\w+):(.+)/s;
	    if (!defined($1))
	    {
		# Broken command?
		$me->debug("Ignoring empty command: $com\n");
		next;
	    }
	    my $field = lc($1);
	    $request{$field} = $2;
	    
	    $isdata = 1 if ($field eq 'data');
	}
    }
    if(!keys(%request))
    {
	# Oops, no data found!
	$me->debug("Received bogus request!\n");
	return '0E0';
    }

    # Update Mudlist
    if($request{'req'} && $request{'req'} eq 'reply' && $me->{'database'})
    {
	$me->debug("Updating $request{'name'}\n");
	my $res = $me->{'database'}->updateMudContact('i2', $request{'name'},
						      $me->{'remoteaddress'},
						      $request{'udp'});
	if(!$res)
	{
	    $me->debug("Oops: " . $me->{'database'}->getError());
	}
    }
    else
    {
	# Update mud state !?
	$me->addMud($request{'name'}, $me->{'remoteaddress'}, $request{'udp'},
		    $request{'name'});
    }

    my $req = $request{'req'};
    if($me->{'data'}->{'commands'} !~ /$req/ && $req ne 'reply' && 
       $req ne 'query')
    {
	# We don't support this command
	$me->send('perlmud', $request{'name'}, 'reply', 
						"ID:" . ($request{'id'} || 0) .
						"|RCPNT:$request{'snd'}|DATA:" .
						"Unknown request: $req");
	return '0E0';
    }
    chomp($request{'data'}) if($request{'data'});
    $request{'data'} = '' if(!$request{'data'});
    $request{'id'} = '0' if(!$request{'id'});
    $request{'data'} =~ s/^\$//;
    $request{'data'} =~ s/^\n//;
    

    $me->debug("Request: $req\n");
    $me->debug("Request: " . Dumper(\%request) . "\n");
    $me->{$errormsg} = '';
    my $result = $me->$req(%request) if($me->can($req));
    if(!defined($result))
    {
	$me->{$errormsg} = "Parse: $req: " . $me->{$errormsg} . "\n";
	$me->debug($me->{$errormsg} . "\n");
	return '0E0';
    }
    if(defined($result->{'answer'}))
    {
	$me->send('perlmud', $result->{'mud'}, @{$result->{'answer'}});
	delete $result->{'answer'};
    }
    
    return $result;

    # $result - hashref? 
    # $result->{'output'}, $result->{'types'}, $result->{'mud'} ?
    # $result->{'answer'}
    # $result->{'to'} - to which local user? (rcpnt)
}

###############################################################################
# received packets

sub reply
{
    # A reply to a request that we sent
    # Parameter: Object, Results
    my ($me, %request) = @_;

    # Query answers
    my $answer = ();
    my $replytype = '';
    $answer->{'mud'} = $request{'name'};

    # Most commands just need to remove the associated ID and output the
    # DATA value! So do that first.
    my @ocommands = grep /^cmd:/, @{$me->{'data'}->{'types'}};
    my @qcommands = grep /^query:/, @{$me->{'data'}->{'types'}};
    my @ccommands = grep /^channel:cmd:/, @{$me->{'data'}->{'types'}};


    # Formatting via templates??

    my $done = 0;
    foreach my $ocom (@ocommands, @ccommands)
    {
	if($me->isID($request{'id'}, $ocom))
	{
	    $me->debug("Reply: found $ocom, $request{'data'}\n");

	    $answer->{'output'} = $request{'data'};
	    $answer->{'to'} = $request{'rcpnt'} if($request{'rcpnt'});
#	    $answer->{'type'} = $ocom;
	    my $type = $ocom;
	    $type =~ s/cmd:/cmd:reply:/;
	    $answer->{'type'} = $type;
#	    $replytype = $ocom;
	    $replytype = $answer->{'type'};
	    $me->removeID($request{'id'}, $ocom);
	    $done = 1;
	    last;
	}
    }
    if(defined($request{'query'}))
    {
	my @coms = grep {$_ eq 'query:' . $request{'query'}} @qcommands;

	if($me->isID($request{'id'}, $coms[0]))
	{
	    if($request{'rcpnt'} && lc($request{'rcpnt'}) ne 'perlmud')
	    {
		$answer->{'output'} = "$request{'data'}";
		$answer->{'to'} = $request{'rcpnt'};
		$answer->{'type'} = $coms[0];
		$replytype = $coms[0];
	    }
	    $me->addNewMudInfo($request{'name'}, $request{'query'}, 
				   $request{'data'});
	    $me->removeID($request{'id'}, $coms[0]);
	    $done = 1;
	}
	else
	{
	    $me->debug("Received a query answer we didnt ask for! " . 
		       $request{'query'} . ":" . $request{'data'} . "\n");
	    $done = 1;
	}
    }

    if($request{'id'} eq '0' && length($request{'data'}))
    {
	# Hmm, a reply with no ID, give it out anyway
	$answer->{'type'} = 'reply';
	$answer->{'to'} = $request{'rcpnt'} if($request{'rcpnt'});
	$answer->{'output'} = $request{'data'};
	$done = 1;
    }

    if(!$done)
    {
	$me->{$errormsg} = "Can't find ID matching: $request{'id'}";
	return undef;
    }

    # Special values
    if($replytype eq 'cmd:reply:locate')
    {
	if(!$request{'fnd'})
	{
	    $answer->{'type'} = 'cmd:reply:locate_no';
	}
	else
	{
	    $answer->{'type'} = 'cmd:reply:locate_yes';
	}
	# Locate request-answers at most muds are broken!
	# FND should contain 1 if found else 0 or undefined
	# USER should contain the user searched for
	# VBS should contain the search type 1 for immediate answer 2 for later
    }
    elsif($replytype eq 'query:hosts')
    {
	# Data contains the list of known hosts from a mud
	$me->parseHostList($request{'name'}, $request{'data'});
    }
    elsif($replytype eq 'cmd:ping')
    {
	# If that was a reply to an update IP.. then it worked, update
	$me->debug(Dumper($me->{'updates'}));
	if(defined($me->{'updates'}->{$request{'name'}}) &&
	   defined($me->{'updates'}->{$request{'name'}}->{$request{'id'}}))
	{
	    my $h = $me->{'updates'}->{$request{'name'}}->{$request{'id'}};
	    $me->addMud($request{'name'}, 
			$h->{'IP'},
			$h->{'Port'},
			$h->{'From'});
	    $me->debug($h->{'From'} . " changed " . $request{'name'} .
		       "'s IP to ".
		       $h->{'IP'} ." and it worked!\n");
	    delete $me->{'updates'}->{$request{'name'}}->{$request{'id'}};
	}
    }
    
#    $me->debug("Reply: " . Dumper($answer));
    return $answer;
}

sub ping
{
    # We're alive!
    # Parameter: Object, Results
    my ($me, %request) = @_;

    my $answer = ();
    $answer->{'mud'} = $request{'name'};
    $answer->{'answer'} = ['reply', "ID:$request{'id'}|DATA:" . 
			   $me->{'mudname'} . " is alive."];

    $me->debug(Dumper($answer));
    return $answer;
}

sub who
{
    # Who's here?
    # Parameter: Object, Results
    my ($me, %request) = @_;

    my $answer = ();
    $answer->{'mud'} = $request{'name'};
    $answer->{'answer'} = ['reply', 
			   "ID:$request{'id'}|RCPNT:$request{'snd'}|DATA:" .
			   $me->{'callbacks'}{'wholist'}->()];

    return $answer;
}

sub tell
{
    # Tell me something
    # Parameter: Object, Results
    my ($me, %request) = @_;

    my $answer = ();
    $answer->{'answer'} = ['reply', "ID:$request{'id'}|RCPNT:$request{'snd'}|DATA:"];
#    $answer->{'answer'} = ['reply', "ID:$request{'id'}|RCPNT:$request{'snd'}|SND:castaway|DATA:"];
    $answer->{'mud'} = $request{'name'};
    $answer->{'to'} = $request{'rcpnt'} if($request{'rcpnt'});
    $answer->{'from'} = $request{'snd'} . '@' . $request{'name'};

    if(!$me->isUser($request{'rcpnt'}))
    {
	$answer->{'answer'}[1] .= $me->{'mudname'} . 
	    $request{'rcpnt'} . " is not here.";
	return $answer;
    }
    elsif($request{'method'})
    {
	if(lc($request{'method'}) eq 'adverb')
	{
	    $answer->{'output'} = $me->convertTemplate('tell:adverb', 
						       \%request);
	    if($request{'data'} =~ /\*(\w+)\*\s(.*)/)
	    {
		$answer->{'output'} = ucfirst($request{'snd'}) . 
		    "\@$request{'name'} tells you $1: $2\n"
			if(!$answer->{'output'});
		$answer->{'answer'}[1] .= $me->convertTemplate('reply:tell', 
							       \%request) || 
		"You told " . 
		    ucfirst($request{'rcpnt'}) . "\@" . $me->{'mudname'} .
			"$1: $2";
		$answer->{'type'} = 'cmd:tell';
	    }
	}
	elsif(lc($request{'method'}) eq 'emote')
	{
	    $answer->{'output'} = $me->convertTemplate('tell:emote', 
						       \%request);
	    if($request{'data'} =~ /\*(.*)\*/s)
	    {
		$answer->{'output'} = ucfirst($request{'snd'}) . 
		    "\@$request{'name'} $1\n"
			if(!$answer->{'output'});
		$answer->{'answer'}[1] .= "Emote an " . 
		    ucfirst($request{'rcpnt'}) . "\@" . $me->{'mudname'} .
			" ok.\n";
		$answer->{'type'} = 'cmd:emote';
	    }
	} 
    }
    else
    {
	my $away = $me->getAway($request{'rcpnt'});
	$me->debug("Away message: $away\n") if($away);
	if($away && length($away))
	{
	    $answer->{'answer'}[1] .= ucfirst($request{'rcpnt'}) . " is away: " . 
		$away . "\n";
	}
	$answer->{'output'} = $me->convertTemplate('tell', 
						   \%request);
	$answer->{'output'} = ucfirst($request{'snd'}) . 
	    "\@$request{'name'} tells you: $request{'data'}\n"
		if(!$answer->{'output'});
	$answer->{'answer'}[1] .= "You told " . 
	    ucfirst($request{'rcpnt'}) . "\@" . $me->{'mudname'} . 
		": $request{'data'}\n";
	$answer->{'type'} = 'cmd:tell';
    }
	    
    return $answer;
}

sub query
{
    # Information about us
    # Parameter: Object, Results
    my ($me, %request) = @_;

    my $answer = ();
    $answer->{'mud'} = $request{'name'};
    my @qcommands = grep /^query:/, @{$me->{'data'}->{'types'}};
#    my @qcommands = ('commands', 'email', 'hosts', 'inetd', 'list', 'info',
#		     'mud_port', 'time', 'users', 'version', 'www'); 
    my @coms = grep {$_ eq 'query:' . $request{'data'}} @qcommands;
    $me->debug(Dumper(\@coms));

    if(!@coms)
    {
	$answer->{'answer'} = ['reply', 
			       "QUERY:$request{'data'}|ID:$request{'id'}|" . 
			       "RCPNT:$request{'snd'}|DATA:" . 
			        $me->{'mudname'} . 
			       ": Unknown query request:$request{'data'}"];
	$me->debug("Unknown request from $request{'name'}: $request{'data'}\n");
	return $answer;
    }
    my ($query) = $coms[0] =~ /^query:(.*)/;
    if(defined($me->{'data'}->{$query}))
    {
	$answer->{'answer'} = ['reply', 
			       "QUERY:$request{'data'}|ID:$request{'id'}|" . 
			       "RCPNT:$request{'snd'}|DATA:" . 
			       $me->{'data'}->{$query}];
	return $answer;
    }
    elsif($query eq 'time')
    {
        $answer->{'answer'} = ['reply',
                               "QUERY:$request{'data'}|ID:$request{'id'}|" .
                               "RCPNT:$request{'snd'}|DATA:" .
                               localtime()];
        return $answer;
    }
    elsif($query eq 'hosts')
    {
        $answer->{'answer'} = ['reply',
                               "QUERY:$request{'data'}|ID:$request{'id'}|" .
                               "RCPNT:$request{'snd'}|DATA:" .
                               $me->getHostList()];
        return $answer;
    }

    $answer->{'answer'} = ['reply', 
			   "QUERY:$request{'data'}|ID:$request{'id'}|" . 
			   "RCPNT:$request{'snd'}|DATA:" . 
			       $me->{'mudname'} . 
			   ": $request{'data'} not implemented."];
    return $answer;    
}

sub hosts
{
    # Return our host list
    # Parameter: Object, Results
    my ($me, %request) = @_;

    my $answer = ();
    $answer->{'mud'} = $request{'name'};
    my $hlist = $me->getHostList();
    if(!defined($hlist))
    {
	$me->debug($me->{$errormsg} . "\n");
	return $answer;
    }
    $answer->{'answer'} = ['reply', "ID:$request{'id'}|" . 
			   "RCPNT:$request{'snd'}|DATA:" .
			   $hlist];

    return $answer;
}

sub finger
{
    # Send a finger reply 
    # Parameter: Object, Results
    my ($me, %request) = @_;

    my $answer = ();
    $answer->{'mud'} = $request{'name'};
    $answer->{'answer'} = ['reply', "ID:$request{'id'}|" . 
			   "RCPNT:$request{'snd'}|"];
    $answer->{'answer'}[1] .= "DATA:" . 
	$me->{'callbacks'}{'fingerinfo'}->(%request);
    
    return $answer;
}

sub channel
{
    # Display a channel message
    # Parameter: Object, Results
    my ($me, %request) = @_;

    my $answer = ();
    $answer->{'mud'} = $request{'name'};

#    my @ccommands = grep /^channel:cmd:/, @{$me->{'data'}->{'types'}};
#    my @ccommands = ('emote', 'history', 'list');

    if(!$request{'channel'})
    {
	return 0;
    }

    # Add channel to type list if not known.
    if(!grep /^channel:$request{'channel'}$/, @{$me->{'data'}->{'types'}})
    {
	push @{$me->{'data'}->{'types'}}, 'channel:' . $request{'channel'};
	if($me->{'database'})
	{
	    $me->{'database'}->addChannels('i2', {$request{'channel'} =>
						      [$request{'name'}, 10]});
	    $me->{'database'}->addChannels('i2', {$request{'channel'} =>
						      [$me->{'mudname'}, 10]});
	}
    }

    if(defined($request{'cmd'}) && $request{'cmd'} eq 'emote')
    {
	$answer->{'output'} = $me->convertTemplate('channel:emote', 
						   \%request);

	$answer->{'output'} = '[' . ucfirst($request{'channel'}) . " " .
	    ucfirst($request{'snd'}) . "\@$request{'name'}"
	. 
	    ((defined($request{'emote'}) && $request{'emote'} eq '2') 
	      ? 's' : '') . " $request{'data'}\]\n"
		if(!$answer->{'output'});
	
    }
    elsif(defined($request{'cmd'}) && $request{'cmd'} eq 'history')
    {
	$answer->{'answer'} = ['reply', "ID:$request{'id'}|" . 
			       "RCPNT:$request{'snd'}|DATA:" .
			       $me->{'callbacks'}{'channelhist'}->($request{'channel'})];
    }
    elsif(defined($request{'cmd'}) && $request{'cmd'} eq 'list')
    {
	$answer->{'answer'} = ['reply', "ID:$request{'id'}|" .
			       "RCPNT:$request{'snd'}|DATA:" .
			       $me->{'callbacks'}{'channellist'}->($request{'channel'})];
    }
    elsif(defined($request{'cmd'}) && $request{'cmd'} eq 'join')
    {
	if($me->{'database'})
	{
	    $me->{'database'}->addChannels('i2', {$request{'channel'} =>
						      [$request{'name'}, 10]});
	}
    }	
    else
    {
	$answer->{'output'} = $me->convertTemplate('channel', 
						   \%request);

	$answer->{'output'} = '[' . ucfirst($request{'channel'}) . " " .
	    ucfirst($request{'snd'}) . "\@$request{'name'}"
		. "\] $request{'data'}"
		    if(!$answer->{'output'});
	$answer->{'type'} = 'channel:' . $request{'channel'};
	$answer->{'from'} = $request{'snd'} . '@' . $request{'name'};
	return $answer;
    }

    $answer->{'from'} = $request{'snd'} . '@' . $request{'name'};
    $answer->{'type'} = 'channel:' . $request{'channel'};
    return $answer;
}

sub man
{
    # Get local manpages
    # Parameter: Object, Results
    my ($me, %request) = @_;

    my $answer = ();
    $answer->{'mud'} = $request{'name'};
    $request{'data'} =~ s/[^\w\.\+:-]//sg;
    my $data = "Oops, man request didn't work.";
    if(open(MANP, "man $request{'data'}|"))
    {
	my @lines = <MANP>;
	chomp(@lines);
	$data = join("\n", @lines) . "\n";
    }

    $answer->{'answer'} = ['reply', "ID:$request{'id'}|" .
			 "RCPNT:$request{'snd'}|DATA:" .  $me->{'mudname'} . 
			   "Man: $request{'data'}:\n$data"];
    return $answer;
}

sub locate
{
    # Do we know this person?
    # Parameter: Object, Results
    my ($me, %request) = @_;

    my $answer = ();
    $answer->{'mud'} = $request{'name'};
    $answer->{'answer'} = ['reply', "ID:$request{'id'}|" . 
			  "RCPNT:$request{'snd'}|vbs:" . 
			   ($request{'vbs'} ? $request{'vbs'} : '0') . 
			  "|user:$request{'user'}|"];

    if($me->{'callbacks'}{'isuser'}->(%request))
    {
	$answer->{'answer'}[1] .= 'fnd:1|' . 
		 "DATA:" . $me->{'mudname'} . ': ' . $request{'data'} .
	    " is logged in.";
    }
    else
    {
	$answer->{'answer'}[1] .= 
	    'fnd:0|' .
		"DATA:" . $me->{'mudname'} . ': ' ." No $request{'data'} here.";
    }
    
    return $answer;
}

###############################################################################
#

sub debug
{
    # Debugging!
    # Parameter: Object, Text
    my ($me, $text) = @_;

  main::debug($text);
}

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

    return $me->{'errormsg'};
}

sub importInetdHosts
{
    # Import muds from INETD_HOSTS file
    # Parameter: Object, FileName
    my ($me, $file) = @_;

    $me->debug("Import: $file\n");

    my $res = open(INETD_HOSTS, $file);
    $me->debug("Can't open $file: $!\n") if(!defined($res));
        
    while (my $line = <INETD_HOSTS>)
    {
	chomp($line);
	my ($name, $IP, $udpport, $receivecmd, $sendcmd) = split(/;/, $line);
	$lname = lc($name);
	$me->addMud($name, $IP, $udpport, 'local');
#	$muds{$lname} = [$name, $IP, $udpport, $receivecmd, $sendcmd, "DOWN", scalar localtime];
    }
    close(INETD_HOSTS);
}
1;

# RCPNT:castaway|QUERY:mud_port|ID:258|REQ:reply|NAME:Regenbogen|UDP:4246|DATA:4711
# Mesg an 141.76.1.100, 4246: NAME:PerlMud|UDP:4248|REQ:reply|ID:2799|QUERY:commands|RCPNT:gawain|DATA:ping:who:tell:channel:finger
#
## 1. send: check if mud supports service before calling request method, else
#          return error text.
# 2. getAddressList - If params 'all' and 'channel', check if channel in MyChannels, and only send to muds in MyMudChannels ?
## 3. Host list import ? - addMuds should update/use MudServicesI2 !
#
# Channels table: ID, Name, Type, Listen
# i2 channels -> Type = '10', Listen == restricted !?
# update when a new channel is received? Updates with mud-name received from
# Central channels are mud_id 0?
# add own, restricted channels, sent to receiver list only
# MudChannels -> mud_id, channel_id