#!/usr/bin/perl
# New Perlmud using Intermud::v2 and Intermud::v3!
#
# $Revision: 1.6 $ $Date: 2003/12/03 00:38:02 $

use warnings;

use MUD::Intermud::DB;
use MUD::Intermud::v2;
# use MUD::Intermud::v3;
use HTML::Entities ('%entity2char');
use IO::Select;
use IO::Socket;
use Text::FormatTable;
use Text::Wrap;
use Text::German;
use Cwd;
use Devel::Size qw(size total_size);
use Data::Dumper;

$Text::Wrap::huge = 'overflow'; # Dont break URLs!
$Devel::Size::warn = 0;         # Dont show CVS warnings
my $MORE = 23;
my $MAXHIST = 20;
my $ALIASMAX = 30;
my $MAXUSERS = 10;

my %Users = ();
my %Mores = ();
my %Rooms = ();
my %TelnetOptions = ();
my %COLOURS = ();
my %Commands = ();
my %Texts = ();
my %Help = ();
my %MailD = ();

my @sockclients = ();
my $hostip;

my $idb = MUD::Intermud::DB->new({dbname =>
				      '/home/castaway/perl/data/perlmud.db',
				  DEBUG => 'log',
				  'logpath' => '/home/castaway/perl/log'});
$idb->createTables() unless $idb->isDatabase();
my $i2 = MUD::Intermud::v2->new({'mudname' => 'PerlMud',
				 'wholist'  => \&who_remote,
				 'fingerinfo' => \&finger_remote,
				 'channelhist' => \&channel_hist,
				 'channellist' => \&channel_list,
				 'isuser' => \&local_user,
				 'sendmail' => \&mail_deliver,
				 'database' => $idb,
				 'savefile' => '/home/castaway/perl/data/i2data.dat',
			         'DEBUG' => 'log'
			         });

# my $i3 = MUD::Intermud::v3->new({'mudname' => 'PerlMud',
# 				 'wholist'  => \&who_remote_i3,
# 				 'fingerinfo' => \&finger_remote_i3,
# 				 'channelhist' => \&channel_hist,
# 				 'channellist' => \&channel_list_i3,
# 				 'isuser' => \&local_user_i3,
# 				 'database' => $idb,
# 				 'savefile' => '/home/castaway/perl/data/i3data.dat',
# 			         'DEBUG' => 'log'
# 			         });

## $i2->importInetdHosts(cwd . '/etc/INETD_HOSTS');

my $server = IO::Socket::INET->new( # LocalAddr  => '192.168.1.1',
				    LocalPort  => 4242,
				    Proto      => 'tcp',
				    Listen     => 1,
				    Reuse      => 1,
				    Timeout    => 60);
die "Can't listen on 4242 ($!)" unless $server;

my $sel = IO::Select->new();
my $i2sock = $i2->getSocket();
# my $i3sock = $i3->getSocket();
$sel->add($i2sock);
# $sel->add($i3sock);
$sel->add(\*STDIN);
$sel->add($server);
#import_debug();
setup_colours();
load_users();
load_commands();
load_texts();
load_rooms();
load_maildispatch();
run();

sub run
{
    # Parameter: None

    while (1)
    {
        my $finish = 0;
        my $i2down = 0;
        my $i3down = 0;
        my @handles = $sel->can_read(5);
        foreach $handle (@handles)
        {
            my $ind;            # silly perl
#            debug("Handle: $handle, Socket: $i2sock\n");
            if ($handle == $i2sock)
            {
                my $result = $i2->readData();
                if (!defined($result))
                {
                    $i2down = 1;
#                    $finish = 1;
                    last;
                }
                next if($result eq '0');
                my $userid = get_user($result->{'to'});
                if (!$userid)
                {
                    foreach my $u (keys %Users)
                    {
                        if ($Users{$u}{'state'} && $Users{$u}{'state'} == 1)
                        {
                            print_output($u, $result) if ($result ne '0'); 
                        }
                    }
                }
                else
                {
                    debug("OUT: $userid, " . Dumper($result));
                    print_output($userid, $result) if ($result ne '0');
                }
            }
#             elsif ($handle == $i3sock)
#             {
#                 my $result = $i3->readSocket();
#                 if (!defined($result))
#                 {
#                     $i3down = 1;
# #                   $finish = 1;
#                     last;
#                 }
#                 next if($result eq '0');
#                 my $userid = get_user($result->{'to'});
#                 if (!$userid)
#                 {
#                     foreach my $u (keys %Users)
#                     {
#                         if ($Users{$u}{'state'} && $Users{$u}{'state'} == 1)
#                         {
#                             print_output($u, $result) if ($result ne '0'); 
#                         }
#                     }
#                 }
#                 else
#                 {
#                     debug("OUT: $userid, " . Dumper($result));
#                     print_output($userid, $result) if ($result ne '0');
#                 }
#             }
            elsif ($handle == \*STDIN)
            {
                $line = <STDIN>;
                chomp($line);
                if ($line eq 'q' || $line eq 'quit')
                {
                    $finish = 1;
                    last;
                }
                else
                {
                    parse_command(1, $line);
#                   parse_command_old(1, $i2, $line);
                }
            }
            elsif ($ind = get_user_socket($handle))
            {
                my $line = <$handle>;
                if (!$line)
                {
                    debug("Socket closed: $ind!\n");
                    logout_local($ind);
                    $Users{$ind}{'socket'} = undef;
                    $Users{$ind}{'state'} = 0;
                    $sel->remove($handle);
                    next;
                }
                $line = convert_backspace($line);
                $line = ignore_options($line);
                $line =~ s/[\r\n]//g;
#               chomp($line);
                if ($line eq 'q' || $line eq 'quit')
                {
                    print $handle "Goodbye!\n";
                    logout_local($ind);
                    $Users{$ind}{'socket'} = undef;
                    $Users{$ind}{'state'} = 0;
                    $sel->remove($handle);
                    $handle->close();
                }
                else
                {
#                    parse_command_old($ind, $i2, $line);
                    parse_command($ind, $line);
                }
            }           
            elsif ($handle == $server)
            {
                my $sockclient = $server->accept();
                debug(Dumper($server));
                if (@sockclients >= $MAXUSERS)
                {
                    print $sockclient "Sorry, we're full.\r\n";
                    $sockclient->close();
                    next;
                }
                $sel->add($sockclient);
                my $newind = @sockclients;
                $sockclients[$newind]{'socket'} = $sockclient;
                $sockclients[$newind]{'timeout'} = time();
                $sockclients[$newind]{'action'} = 'login';
                print $sockclient $Texts{'welcome'};
                debug("Sockclient: " . Dumper(\@sockclients));
#               login_user($#sockclients);
            }
            elsif (($ind) = grep($sockclients[$_]{'socket'} == $handle, 
                                 0..@sockclients-1))
            {
                debug("Sockclient: $ind\n");
                my $sock = $sockclients[$ind]{'socket'};
                $line = <$sock>;
                if (!$line)
                {
                    debug("Socket closed: $ind!\n");
                    $sel->remove($handle);
                    $handle->close();
                    splice(@sockclients, $ind, 1);
                    next;
                }
                $line = convert_backspace($line);
                $line = ignore_options($line);
                $line =~ s/\p{IsC}//g;
                $line =~ s/[\r\n]//g;
                if ($sockclients[$ind]{'action'} eq 'login')
                {
                    $sockclients[$ind]{'action'} = 'password';
                    my $userid = get_user($line);
                    if ($userid)
                    {
                        print $sock "Welcome back, $line!\r\n";
                        $sockclients[$ind]{'user'} = $userid;
                        $Users{$userid}{'state'} = -1; # logging in
                        debug("client-userid: $userid\n");
                        print $sock $Texts{'pprompt'};
                    }
                    elsif ($line =~ /\w+/ && length($line) <= 12)
                    {
                        $userid = create_user($line);
                        print $sock "Hi $line!\r\n";
                        $sockclients[$ind]{'user'} = $userid;
                        debug("client-userid: $userid\n");
                        print $sock $Texts{'pprompt'};
                    }
                    else
                    {
                        print $sock "Name is longer than 12 characters or " .
                          "contains illegal characters!\r\n";
                        $sel->remove($handle);
                        $handle->close();
                        splice(@sockclients, $ind, 1);
                    }
                }
                elsif ($sockclients[$ind]{'action'} eq 'password')
                {
                    my $userid = $sockclients[$ind]{'user'};
                    if ($Users{$userid}{'state'})
                    {
                        # - known user
                        if ($line eq 
                            $Users{$userid}{'password'})
                        {
                            if (my $socko = $Users{$userid}{'socket'})
                            {
                                print_output($userid, 
                                             {
                                              'output' => "Connection replaced!"});
                                $Users{$userid}{'socket'} = undef;
                                $Users{$userid}{'state'} = 0;
                                $sel->remove($socko);
                                $socko->close();
                            }
                            login_user($userid, $sock);
                            delete $sockclients[$ind];
                        }
                        else
                        {
                            print $sock "Wrong password!\r\n";
                            $sel->remove($handle);
                            $handle->close();
                            splice(@sockclients, $ind, 1);
                        }
                    }
                    else
                    {
                        # new user
                        if (length($Users{$userid}{'password'}) && 
                            $line eq $Users{$userid}{'password'})
                        {
                            login_user($userid, $sock);
                            add_user($userid);
                            delete $sockclients[$ind];
#			    login_local($ind);
                            print $sock "Have fun!\r\n" . 
                              "Type 'help' for a command list\r\n";
                        }
                        else
                        {
                            if ($line !~ /^\w+$/)
                            {
                                print $sock "Only letters and numbers please!";
                            }
                            else
                            {
                                $Users{$userid}{'password'} = $line;
                                print $sock "Again:";
                            }
                        }
                    }
                }
            }
        }
        if ($finish || ($i2down && $i3down))
        {
            $finish = 1;
            debug("Finished mainloop!\n");
            my @users = grep($Users{$_}{'state'} && $Users{$_}{'state'} == 1, keys(%Users));
            foreach my $u (@users)
            {
                my $sock = $Users{$u}{'socket'};
                print $sock "Going down!\n";
                $sock->close();
            }
            $server->close();
            $i2->closei2();
#            $i3->closei3();
            $idb->closedb();
            last;
        }
        my $res = $i2->checkTimeouts() if(!@handles);
        check_ip() if(!@handles);
        print_output(1, $res) if($res);
    }
}

sub check_ip
{
    # If PerlMud is left running and the router changes IP, re-ping all muds
    # Parameter: None

    my $ip = scalar gethostbyname('desert-island.dynodns.net');
    return if(!$ip);

    my $newhostip = inet_ntoa($ip);
#    debug("New: $newhostip, Old: $hostip\n");
    if($newhostip && $newhostip ne $hostip)
    {
	debug("New HostIP: $newhostip\n");
	$hostip = $newhostip;
	$i2->send('perlmud', 'all', 'ping');
    }

}

sub parse_command
{
    # Parse input command, comparing with %Commands
    # Parameter: Input
    my ($userid, $input) = @_;

    # Update idle time
    $Users{$userid}{'idle'} = time();
    if($Users{$userid}{'away'} && $Users{$userid}{'awayflag'})
    {
        # User typed something, was away, now isn't anymore..
        set_away($userid);
    }
    $input = $Users{$userid}{'prefix'} . 
        ((substr($input, 0, 2) eq '..') ? substr($input, 1) : $input) 
	    unless($input eq '.');
#    $input =~ s/^$Users{$userid}{'prefix'}
    $input = get_alias($userid, $input);
    debug("Alias converted: $input\n");

    $input =~ /^(\S+)/;
    if(!$1)
    {
        print_output($userid, {'output' => "No command!\r\n"});
        return 0;
    }
    my $com = $1;
    if(!$Commands{$com})
    {
        print_output($userid, {'output' => "Command not recognised: $com\r\n"});
        return 0;
    }
    my @command = @{$Commands{$com}};

    my @args = ();
    print_output($userid, {'output' => "You typed: $input\r\n"}) 
        unless($Users{$userid}{'echooff'});

    foreach my $commands (@command)
    {
#	debug("commands: " . Dumper($commands));
        if(defined($commands->{'command'}))
        {
            # Local command
            if(my @res = $input =~ /$commands->{'pattern'}/)
            {
                print_output($userid, $commands->{'command'}->($userid, @res));
                return 1;
            }
#	    print_output($userid, {'output' => 
#				       "Syntax: $command{'syntax'}\r\n"});;
#	    return 1;
        }
        if(my @res = $input =~ /$commands->{'pattern'}/)
        {       
            debug("results: " . Dumper(\@res));
            if(defined($commands->{'mudindex'}) && 
               $commands->{'mudindex'} ne '0')
            {
                if($idb)
                {
                    my $mudlist = $idb->getMudProtocol($res[$commands->{'mudindex'} - 1]);
                    if(!$mudlist)
                    {
                        print_output($userid, 
                                     {'output' => 
                                          "No muds found matching: " . 
                                          $res[$commands->{'mudindex'} - 1] . "\r\n"});
                        return 0;
                    }
                    my @muds = keys %{$mudlist};
                    if(@muds > 1)
                    {
                        print_output($userid, {'output' => 
                                                   "Found more than one match: " . 
                                                   join(", ", sort(@muds)) . "\r\n"});
                        return 1;
                    }
                    if(grep(/i2/, @{$mudlist->{$muds[0]}}))
                    {
#			$commands->{'commandi2'}->();
#                        @args = $commands->{'commandi2'}->($userid, @res);
                        @args = $commands->{'commandi2'}->(@res);
                        debug("ARGS: " . Dumper(\@args));
                        my $result = $i2->send($Users{$userid}{'user'}, @args);
                        debug(Dumper($result));
                        print_output($userid, $i2->getError(), 
                                     'error') if !defined($result);
                        print_output($userid, $result) if($result ne '0');
                    }
                    else
                    {
#           			    @args = $commands->{'commandi3'}->(@res);
#                        $i3->send(@args);
                    }
                }
                return 1;
            }
            # Send to all muds.. 
            # if channel command, check if its a i3 or i2 channel
            if($com =~ /^channel/)
            {
                if($idb->isChannel($1, 'i3'))
                {
                    debug("$1 is an i3 channel\n");
#                    @args = $commands->{'commandi3'}->($Users{$userid}{'user'}, @res);
#                    $i3->send(@args);
                    return;
                }
                else
                {
#                    @args = $commands->{'commandi2'}->($userid, @res);
                    @args = $commands->{'commandi2'}->(@res);
                    if(@args)
                    {
                        my $result = $i2->send($Users{$userid}{'user'}, @args);
                        debug("Send Result: " . Dumper($result));
                        print_output($userid, $i2->getError(), 'error') if !defined($result);
                        print_output($userid, $result) if($result ne '0');
                    }
                    return;
                }
            }
            # Not a channel command - locate or something, send to both
#            @args = $commands->{'commandi2'}->($userid, @res);
            @args = $commands->{'commandi2'}->(@res);
            if(@args)
            {
                my $result = $i2->send($Users{$userid}{'user'}, @args);
                debug(Dumper($result));
                print_output($userid, $i2->getError(), 'error') if !defined($result);
                print_output($userid, $result) if($result ne '0');
            }
#            @args = $commands->{'commandi3'}->($Users{$userid}{'user'}, @res);
#            $i3->send(@args);
        }
    }
}

sub print_output
{
    # Output something, add to history / colour when type is given
    # Parameter: Result Hash
    my ($userid, $output) = @_;

    debug(Dumper($output));
    if(!$output || !defined($output->{'output'}))
    {
	return 0;
    }

    if($output->{'type'} && $output->{'type'} =~ /^channel:/)
    {
	update_history(0, $output->{'type'}, $output->{'output'});
    }
    elsif($output->{'type'})
    {
	update_history($userid, lc($output->{'type'}), $output->{'output'});
    }

    if(!$Users{$userid} || !$Users{$userid}{'state'})
    {
	# Not here!
	return 0;
    }

    my $mesg = $output->{'output'};
#    debug(Dumper($output->{'type'}));
    my $ignoevents = $Users{$userid}{'ignoredevents'} || [];
    my $ignomuds = $Users{$userid}{'ignoredmuds'} || [];
#    debug(Dumper($ignoevents));
#    debug(Dumper($output->{'type'}));
    if($output->{'type'} && (grep(/^$output->{'type'}$/, @{$ignoevents}) || 
       grep(/^$output->{'mud'}$/, @{$ignomuds})))
    {
	# We're not listening!
	return 0;
    }

    if($output->{'type'})
    {
	$mesg = colour_output($userid, $output->{'type'}, $mesg);
    }

#    debug($mesg . "\n");
    if(my $pos = index($mesg, chr(255)) > -1)
    {
	substr($mesg, $pos, 0, chr(255));
    }
    my @lines = split('\n', $mesg);
    do_more($userid, @lines);
}

sub do_more
{
    # Output lines using more
    # Parameter: Lines
    my ($userid, @lines) = @_;

    my $sout = $Users{$userid}{'socket'};
    if(!$sout)
    {
	debug("Oops, buggy socket! $userid\n");
	return 0;
    }
#    debug("do_more: " . Dumper(\@lines));
    if(scalar(@lines) > $MORE)
#    while(scalar(@lines) > $MORE)
    {
	# if the output has more than $MORE lines
	# %Mores{$userid}[MORE][lines]
	debug("do_more: More than $MORE\n");
	if(!$Mores{$userid})
	{
	    $Mores{$userid}{'lines'} = [];
	    $Mores{$userid}{'more'} = 0;
	}
	else
	{
	    $Mores{$userid}{'more'} = 0;
	}
	$Mores{$userid}{'lines'} = \@lines;
	more_text($userid, undef);

	return 0;
#	for (my $i = 0; $i < $MORE; $i++)
#	{
#	    print $sout shift(@lines) . "\r\n";
#	}
#	print $sout "---- More ----";
#	ReadKey 0; ## Socket!?
    }	
    @lines = map { $_ if(defined($_)); } @lines;
    
    print $sout join("\r\n", @lines) . "\r\n";

}

sub more_text
{
    # Called by command 'more' with +, -, or q as parameter
    # + => Give out next $Mores{$userid}{'lines}[ .. {'current'}][ .. {'more'}]
    # - => Give out previous
    # q => delete current
    # Parameter: UserId, Param
    my ($userid, $param) = @_;

    if(!$Mores{$userid})
    {
	return {'output' => "No more texts available."};
    }
    if(!$Mores{$userid}{'lines'})
    {
	return {'output' => "Nothing more to show."};
    }

    my $result;
    my $sout = $Users{$userid}{'socket'};
    if(!defined($param))
    {
	my @lines;
	my $more = $Mores{$userid}{'more'} * $MORE;
	my $more2 = $more + $MORE - 1 > @{$Mores{$userid}{'lines'}} ?
	    @{$Mores{$userid}{'lines'}} - 1: $more + $MORE - 1;
#	debug("more_text: " . Dumper(\%Mores));
	
	@lines = @{$Mores{$userid}{'lines'}}[$more .. $more2];
	
	do_more($userid, @lines);
	print $sout "---- More ----\r\n";
    }
    elsif($param eq '+')
    {
	if($Mores{$userid}{'more'} >= @{$Mores{$userid}{'lines'}} - 2)
	{
	    $result->{'output'} = "No more text.";
	    return $result;
	}
	$Mores{$userid}{'more'}++;

	my @lines;
	my $more = $Mores{$userid}{'more'} * $MORE;
	my $more2 = $more + $MORE - 1 > @{$Mores{$userid}{'lines'}} ?
	    @{$Mores{$userid}{'lines'}} - 1: $more + $MORE - 1;
#	debug("more_text: " . Dumper(\%Mores));
	
	@lines = @{$Mores{$userid}{'lines'}}[$more .. $more2];
	
	do_more($userid, @lines);
	if($more2 < @{$Mores{$userid}{'lines'}} - 2)
	{
	    print $sout "---- More ----\r\n";
	}
	else
	{
	    $Mores{$userid}{'lines'} = [];
	}
    }
    elsif($param eq '-')
    {
	if($Mores{$userid}{'more'} < 1)
	{
	    $result->{'output'} = "Already at the beginning!";
	    return $result;
	}
	$Mores{$userid}{'more'}--;
	my @lines;
	my $more = $Mores{$userid}{'more'} * $MORE;
	my $more2 = $more + $MORE - 1 > @{$Mores{$userid}{'lines'}} ?
	    @{$Mores{$userid}{'lines'}} - 1: $more + $MORE - 1;
#	debug("more_text: " . Dumper(\%Mores));
	
	@lines = @{$Mores{$userid}{'lines'}}[$more .. $more2];
	
	do_more($userid, @lines);
	print $sout "---- More ----\r\n";
	
    }
    elsif($param =~ /\/([^\/]*)\//)
    {
    }
    elsif($param eq 'q')
    {
	$Mores{$userid}{'lines'} = [];
	$result->{'output'} = "More deleted.\n";
	return $result;
    }
    return 0;
}

sub update_history
{
    # Add a line to the history
    # - Add 'channels' and other central stuff to user 0 ?!
    # Parameter: UserId, Event, Content
    my ($userid, $event, $content) = @_;

    if(!$content || !$event)
    {
        return 0;
    }

    my $history = $Users{$userid}{'history'}{$event} ||= [];
    
    chomp($content);
    
    if(@$history  && substr($history->[-1], 15) eq $content)
    {
	# Got that already
	return 0;
    }
    
    while(@$history >= $MAXHIST)
    {
	shift @$history;
    }
    
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
    
    push @$history, sprintf "%02d.%02d %02d:%02d:%02d %s", $mday, $mon+1, $hour, $min, $sec, $content;

#    $Users{$userid}{'history'}{$event} = $history;

#    while(defined($Users{$userid}{'history'}{$event}) 
#       && @{$Users{$userid}{'history'}{$event}} >= $MAXHIST)
#    {
#	shift(@{$Users{$userid}{'history'}{$event}});
##        splice(@{$Users{$userid}{'history'}{$event}}, 0, 
##               @{$Users{$userid}{'history'}{$event}} - $MAXHIST + 1);
#    }

#    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
#        localtime(time);
#    chomp($content);
#    if(!defined($Users{$userid}{'history'}{$event}))
#    {
#        $Users{$userid}{'history'}{$event} = [];
#    }
#    else
#    {
#        if(@{$Users{$userid}{'history'}{$event}}  &&
#           substr($Users{$userid}{'history'}{$event}[
#              @{$Users{$userid}{'history'}{$event}} - 1], 15) eq $content)
#        {
#            # Got that already
#            return 0;
#        }
#    }

#    $Users{$userid}{'history'}{$event}->[scalar 
#          (@{$Users{$userid}{'history'}{$event}})] = 
#              sprintf("%02d.%02d %02d:%02d:%02d ", 
#                      $mday,$mon + 1,$hour,$min,$sec) . $content;
}

sub show_history
{
    # Output history contents
    # Parameter: UserId, Event
    my ($userid, $event) = @_;

    my $id = $userid;
    if($event =~ /^channel:/)
    {
	$id = 0;
    }
    if(!defined($Users{$id}{'history'}) || 
       !defined($Users{$id}{'history'}{$event}))
    {
	do_more($userid, "No history for: $event");
	return 1;
    }
    
    do_more($userid, @{$Users{$id}{'history'}{$event}});
    return 1;
}

sub list_muds
{
    # List all known muds
    # Parameter: UserId
    my ($userid) = @_;

    print_output($userid, $i2->listMuds());
}

###############################################################################
# ignore

sub load_ignoevents
{
    # Load ignored events from database
    # Parameter: UserId
    my ($userid) = @_;

    if($idb)
    {
	my $igevents = $idb->getValues('IgnoredEvents', 'user_id', $userid,
				      'Event');
	debug(Dumper($igevents));
	if(!$igevents)
	{
	    return [];
	}
	return $igevents;
    }
    return ['channel:d-news', 'channel:d-tv-alles', 'channel:d-tv', 
	    'query:hosts', 'error:timeout'];
}

sub load_ignomuds
{
    # Load ignored events from database
    # Parameter: UserId
    my ($userid) = @_;

    if($idb)
    {
	my $igevents = $idb->getValues('IgnoredMuds', 'user_id', $userid,
				      'Event');
	if(!$igevents)
	{
	    return [];
	}
	return $igevents;
    }
    return [];
}

sub list_ignore
{
    # Return output showing what is ignored
    # Parameter: UserId
    my ($userid) = @_;

    my $result;
    $result->{'output'} = '';

    if(@{$Users{$userid}{'ignoredevents'}})
    {
	$result->{'output'} .= "Ignored events:\n";
    }
    foreach my $e (@{$Users{$userid}{'ignoredevents'}})
    {
	$result->{'output'} .= "$e\n";
    }

    if(@{$Users{$userid}{'ignoredmuds'}})
    {
	$result->{'output'} .= "Ignored muds:\n";
    }
    foreach my $e (@{$Users{$userid}{'ignoredmuds'}})
    {
	$result->{'output'} .= "$e\n";
    }

    $result->{'output'} = "Nothing ignored." if(!length($result->{'output'}));
    return $result;
}

sub ignore
{
    # Add/Delete an event/mud to the ignore list
    # Parameter: UserId, 'event'/'mud', Name
    my ($userid, $type, $ding) = @_;

    my $result;
    if($i2)
    {
	if(lc($type) eq 'event')
	{
	    my @events = $i2->getEvents();
	    if(!grep(/^$ding$/, @events))
	    {
		$result->{'output'} = "No such event!\n";
		return $result;
	    }
	    
	    my @ignoevents = @{$Users{$userid}{'ignoredevents'}};
	    if(my ($index) = grep {$ignoevents[$_] eq lc($ding)} (0..$#ignoevents))
	    {
		$result->{'output'} = "$ding removed from ignore-list.\n";
		splice(@{$Users{$userid}{'ignoredevents'}}, $index, 1);
		if($idb)
		{
		    $idb->deleteFromTable('IgnoredEvents', 
					  ['user_id', 'Event'],
					  [$userid, $ding]);
		}
		return $result;
	    }
	    else
	    {
		push @{$Users{$userid}{'ignoredevents'}}, $ding;
		if($idb)
		{
		    $idb->appendTable('IgnoredEvents',
				      ['user_id', 'Event'],
				      [$userid, $ding]);
		}
	    }
	}
	elsif(lc($type) eq 'mud')
	{
	    my $rows = ($i2->listMuds('Name'))[1];
	    my @muds = map {$_->[0]} @{$rows};
	    if(!grep(/^$ding$/, @muds))
	    {
		$result->{'output'} = "No such mud!\n";
		return $result;
	    }
	    if(my ($index) = grep {$Users{$userid}{'ignoredmuds'}[$_] eq $ding} 
		    0..@{$Users{$userid}{'ignoredmuds'}} - 1)
#	my @lcind = grep {$names->[$_] eq 'last contact'} 0..(@{$names}-1);
	    {
		$result->{'output'} = "$ding removed from ignore-list.\n";
		delete $Users{$userid}{'ignoredmuds'}[$index];
		if($idb)
		{
		    $idb->deleteFromTable('IgnoredMuds', 
					  ['user_id', 'Mud'],
					  [$userid, $ding]);
		}
		return $result;
	    }
	    else
	    {
		push @{$Users{$userid}{'ignoredmuds'}}, $ding;
		if($idb)
		{
		    $idb->appendTable('IgnoredMuds',
				      ['user_id', 'Mud'],
				      [$userid, $ding]);
		}
	    }
	}
    }
    $result = '0';
    return $result;
}

sub events
{
    # List all available events
    # Parameter: None
    
    my @events = $i2->getEvents();
    my $result;
    $result->{'output'} = '';
    
    foreach my $e (@events)
    {
	$result->{'output'} .= $e . ", ";
    }
    substr($result->{'output'}, -2, 2, '');
    
    return $result;
}

###############################################################################
# Colours.

sub setup_colours
{
    # Create the ansi colour list
    # Parameter: None

    %COLOURS =
	(bold       => "\e[1m",
	 underscore => "\e[4m",
	 blink      => "\e[5m",
	 reverse    => "\e[7m",
	 normal     => "\e[0m",
	 
	 black      => "\e[30m",
	 red        => "\e[31m",
	 green      => "\e[32m",
	 yellow     => "\e[33m",
	 blue       => "\e[34m",
	 magenta    => "\e[35m",
	 cyan       => "\e[36m",
	 white      => "\e[37m",
	 
	 on_black   => "\e[40m",
	 on_red     => "\e[41m",
	 on_green   => "\e[42m",
	 on_yellow  => "\e[43m",
	 on_blue    => "\e[44m",
	 on_magenta => "\e[45m",
	 on_cyan    => "\e[46m",
	 on_white   => "\e[47m"
	 );
}

sub add_colour
{
    # Parameter: Event, Colour(s)
    my ($userid, $event, $colours) = @_;
    debug("add_colour :" . $event . ', ' . $colours . "\n");
    my @cols = split(' ', $colours);

    my $found = 0;
    foreach my $c (@cols)
    {
        $c = lc($c);
        if(is_member($c, keys %COLOURS) > -1)
        {
            $found += 1;
        }
    }
    if($found == scalar @cols)
    {
        $Users{$userid}{'coloureditems'}{$event} = $colours;
	add_colour_table($userid, $event, $colours);
	return 1;
    }
    return 0;
}

sub add_colour_table
{
    # Add/Update a colour/event to the database
    # Parameter: UserId, Event, Colour
    my ($userid, $event, $colour) = @_;

    if(!$idb)
    {
	return 0;
    }
    my $res = $idb->updateTable('ColouredEvents', ['user_id', 'Event'],
				[$userid, $event],
				['user_id', 'Event', 'Colour'],
				[$userid, $event, $colour]);
    if(!defined($res))
    {
	debug("Can't add coloured event to table: " . $idb->getError() . "\n");
    }
}

sub load_colours
{
    # Get all colouredevents from database
    # Parameter: UserId
    my ($userid) = @_;

    if(!$idb)
    {
	debug("LC: oops, no DB\n");
	return 0;
    }

    my $cevents = $idb->getValues('ColouredEvents', 'user_id', $userid,
				  'Event', 'Colour'); 

    debug("LC: " . Dumper($cevents));
    if(!defined($cevents))
    {
	return {};
    }
    my $ind = 0;
    my $result = {};
    while($ind < @{$cevents})
    {
	$result->{$cevents->[$ind]} = $cevents->[$ind + 1];
	$ind += 2;
    }
    return $result;
}

sub del_colour
{
    # Delete a coloured event from the list
    # Parameter: UserId, Event
    my ($userid, $event) = @_;

    debug("del_colour :" . $event . "\n");

    if(is_member($event, keys %{$Users{$userid}{'coloureditems'}}) > -1)
    {
	if($idb)
	{
	    $idb->deleteFromTable('ColouredEvents', 
				  ['user_id', 'Event'],
				  [$userid, $event]);
	}
        delete $Users{$userid}{'coloureditems'}{$event};
    }
    my $result;
    $result->{'output'} = "Deleted: $event\n";
    return $result;
}

sub list_events
{
    # Parameter: UserId
    my ($userid) = @_;

    debug("list_events\n");
    debug("list_events :" . scalar(keys(%{$Users{$userid}{'coloureditems'}})) . "\n");
    
    my $result;
    $result->{'output'} = '';
    if(!$Users{$userid}{'coloureditems'})
    {
	$result->{'output'} = "No coloured events.\n";
	return $result;
    }
    foreach $key (keys %{$Users{$userid}{'coloureditems'}})
    {
        $value = $Users{$userid}{'coloureditems'}{$key};
        $result->{'output'} .= "$key => " . 
	    colour_output($userid, $key, $value) . "\n";
    }
    return $result;
}

sub list_colours
{
    # Parameter: UserId
    my ($userid) = @_;

    my $result;
    $result->{'output'} = '';
    while(my ($key, $value) = each %COLOURS)
    {
        $result->{'output'} .= "$value$key" . $COLOURS{normal} . "\n";
    }
    return $result;
}


sub colour_output
{
    # Returns msg in colour
    # Parameter: UserId, Event, Mesg
    my ($userid, $event, $mesg) = @_;

#    debug("colour_event :" . $event . "\n");
#    debug("colour_event :" . $mesg . "\n");

    if(is_member($event, keys %{$Users{$userid}{'coloureditems'}}) > -1)
    {
        my @cols = split(' ', $Users{$userid}{'coloureditems'}{$event});
        my $foundcols = '';
        foreach my $c (@cols)
        {
            $c = lc($c);
            if(is_member($c, keys %COLOURS) > -1)
            {
                $foundcols .= $COLOURS{$c};
            }
        }
        if($foundcols)
        {
            if($mesg =~ /(.*)\n/)
            {
                chomp($mesg);
                return "$foundcols$mesg" . $COLOURS{normal} . "\n";
            }
            return "$foundcols$mesg" . $COLOURS{normal};
        }
    }

    return $mesg;
}

###############################################################################
# Aliases

sub add_alias
{
    # add an alias to our hash
    # Parameter: ID, Name, Parameter
    my ($userid, $alias, $value) = @_;

    my $result = '0';
    if($alias eq 'unalias')
    {
	$result->{'output'} = "You don't really want to make an 'unalias' alias!";
	return $result;
    }	
    if(scalar(keys(%{$Users{$userid}{'aliases'}})) > $ALIASMAX)
    {
	$result->{'output'} = "Alias maximum reached ($ALIASMAX)";
	return $result;
    }
    if(defined($Users{$userid}{'aliases'}{$alias}))
    {
	$result->{'output'} = "Previous value of '$alias': " . 
	    $Users{$userid}{'aliases'}{$alias};
#	return $result;
    }

    $Users{$userid}{'aliases'}{$alias} = $value;
    if($idb)
    {
	my $res = $idb->updateTable('Aliases', ['user_id', 'Name'],
				    [$userid, $alias],
				    ['user_id', 'Name', 'Command'],
				    [$userid, $alias, $value]);
	if(!defined($res))
	{
	    debug("Can't add alias to table: " . $idb->getError() . "\n");
	}
    }
    return $result;
}

sub delete_alias
{
    # Remove an alias from our hash
    # Parameter: User, Name
    my ($userid, $alias) = @_;

    my $result = '0';
    if(defined($Users{$userid}{'aliases'}{$alias}))
    {
	$result->{'output'} ="Deleted: $alias -> " . 
	    $Users{$userid}{'aliases'}{$alias}. "\n";
	delete $Users{$userid}{'aliases'}{$alias};
	if($idb)
	{
	    $idb->deleteFromTable('Aliases', ['user_id', 'Name'],
				  [$userid, $alias]);
	}
	return $result;
    }
    $result->{'output'} = "No such alias: $alias\n";
    return $result;
}

sub list_aliases
{
    # List current aliases
    # Parameter: User
    my ($userid) = @_;
    
    my $result;
    $result->{'output'} = '';
    if(!$Users{$userid}{'aliases'})
    {
	$result->{'output'} = "No aliases defined.\n";
	return $result;
    }
    foreach my $a (sort(keys(%{$Users{$userid}{'aliases'}})))
    {
	my $ali = sprintf("%15s", $a);
	$result->{'output'} .= "$ali => " . 
	    $Users{$userid}{'aliases'}{$a} . "\n";
    }
    return $result;
}

sub load_aliases
{
    # get aliases from database
    # Parameter: UserId
    my ($userid) = @_;

    if($idb)
    {
	my $vals = $idb->getAliases($userid);
#	debug(Dumper($vals));
	my $res = {};
	foreach my $row (@{$vals})
	{
	    $res->{$row->[0]} = $row->[1];
	}
	return $res;
    }
}

sub get_alias
{
    # Convert an alias .. 
    # Parameter: UserId, Input
    my ($userid, $input) = @_;

    return '' if(!$input && !length($input));

    my @words = split(/\s/, $input);
    
    if(!defined($Users{$userid}{'aliases'}{$words[0]}))
    {
	return $input;
    }

#    my $ali = $words[0];
    my $val = $Users{$userid}{'aliases'}{$words[0]};
    
    $val =~ s/\$(\d)/$words[$1]/g;
    my $all = join(' ', @words[1..$#words]);
    $val =~ s/\$\*/$all/g;

    return $val;
}

###############################################################################
# Commands

sub load_commands
{
    # Load commands from Database?
    # Create standard command list
    # Parameters: None
 
    # Communication
    $Commands{'tell'} = [
			 {
	'pattern'   => '^tell (\S+?)\@(.+?) (.+)$',               #'
	'mudindex'  => 2,
	'commandi2' => sub { my $n = $_[0]; 
			     my $m = $_[1];
			     my $t = $_[2];
			     # $n =~ s/_/ /g; 
                 return ($m, 'tell', $n, $t); },
	'commandi3' => sub { $user = shift; return ('tell', $user, $_[1], $_[0], 
				      ucfirst($user), $_[2]); },
	'syntax'    => 'tell <name>@<mudname> <text>',
	'help'      => 
'tell <someone>@<mud> <text>' . "\n" .
"---------------------------\n" .
"Communicate a message to someone on another Mud.\n".
'Example: tell castaway@perlmud hi castaway!' . "\n".
"See also: muds, who, emote\n"
	},
			 {
	'pattern'   => '^tell (\S+?) (.+)$',               #'
	'command' => sub { return tell_local(shift, $_[0], $_[1]); },
	'syntax'    => 'tell <name> <text>',
	'help'      => 
"tell <someone> <text>\n" .
"---------------------\n" .
"Communicate a message a local user.\n".
"Example: tell castaway hi castaway!\n".
"See also: who, emote\n" 
	}];
	

    $Commands{'emote'} = [
			  {
	'pattern'   => '^emote (\w+?)\@(.+?) (.*)$',               #'
	'mudindex'  => 2,
	'commandi2' => sub { return ($_[1], 'emote', $_[0], $_[2]); },
	'commandi3' => sub { $user = shift; 
                         return ('emoteto', $user, $_[1], $_[0], $_[2]); },
	'syntax'    => 'emote <name>@<mudname> <message>',
	'help'      => 
'emote <someone>@<mud> <text>' . "\n" .
"----------------------------\n" .
"Send an action to somone on another Mud.\n".
'Example: emote castaway@perlmud nods to you.' . "\n".
"Castaway sees: 'Yourname nods to you.\n".
"See also: muds, who, tell\n" 
	},
			  {
	'pattern'   => '^emote (.+)$',               #'
	'command' => sub { return emote_local(shift, $_[0]); },
	'syntax'    => 'emote <emote> or <name>#<text>#<text2>', 
	'help'      => 
"emote <someone> <text> OR emote <someone>#<text for someone>#<text for rest>\n" .
"----------------------------------------------------------------------------\n" .
"Send an action to somone in the same room.\n".
"Example: emote castaway#nods to you.#nods at Castaway.\n".
"Castaway sees: 'Yourname nods to you.'\n".
"Others see: 'Yourname nods at Castaway.'\n".
"See also: who, tell\n" 
	}];

    $Commands{'gemote'} = [
			  {
	'pattern'   => '^gemote (.+)$',               #'
	'command' => sub { return gemote_local(shift, $_[0]); },
	'syntax'    => 'gemote <emote> or <name>#<text>#<text2>', 
	'help'      => 
"gemote <someone> <text> OR gemote <someone>#<text for someone>#<text for rest>\n" .
"----------------------------------------------------------------------------\n" .
"Send an action to somone in the same room.\n".
"Example: gemote Giraffe nods.\n".
"Others see: 'Yournames Giraffe nods.'\n".
"See also: who, tell, emote\n" 
	}];

    $Commands{'say'} = [
			{
	'pattern'   => '^say (.+)$',               #'
	'command' => sub { return say_local(shift, $_[0]); },
	'syntax'    => 'say <name> <text>',
	'help'      =>
"say <text>\n".
"----------\n".
"Say a text to everyone in the same room as you.\n".
"See also: look\n"
	}];

    # Info 
    $Commands{'who'} = [
                        {
        'pattern'   => '^who (.+)$',                              #'
        'mudindex'  => 1,
        'commandi2' => sub { return ($_[0], 'who'); },
        'commandi3' => sub { $user = shift;
                             return ('who-req', $user, $_[0]);},
        'syntax'    => 'who <mudname>',
	'help'      => 
"who <mud>\n" .
"---------\n" .
"Get a list of all players visible on another Mud.\n".
"See also: muds\n" 
        },
                        {
        'pattern'   => '^who$',                                     #'
        'command'   => sub { return who_local(shift); },
        'syntax'    => 'who',
	'help'      =>
"who\n".
"---\n".
"Show a list of all users logged onto PerlMud.\n".
"See also: muds\n"
        }];


    $Commands{'finger'} = [
			   {
	'pattern'   => '^finger (.+?)\@(.+)$',                    #'
	'mudindex'  => 2,
	'commandi2' => sub { return ($_[1], 'finger', $_[0]); },
	'commandi3' => sub { $user = shift;
                         return ('finger-req', $user, $_[1], $_[0]); },
	'syntax'    => 'finger <name>@<mudname>',
	'help'      =>
'finger <someone>@<mud>' . "\n".
"----------------------\n".
"Show information about someone in another Mud.\n".
"See also: muds, who\n"
	},
			   {
	'pattern'   => '^finger (\w+)$',                                     #'
	'command'   => sub { return finger_local(shift, $_[0]); },
	'syntax'    => 'finger <name>',
	'help'      =>
"finger <someone>\n".
"----------------\n".
"Show information about someone.\n".
"See also: who\n"

	}];

    $Commands{'man'} = [
			   {
	'pattern'   => '^man (.+?)\@(.+)$',                    #'
	'mudindex'  => 2,
	'commandi2' => sub { return ($_[1], 'man', $_[0]); },
	'commandi3' => '',
	'syntax'    => 'man <page>@<mudname>',
	'help'      =>
'man <page>@<mud>' . "\n".
"-----------------\n".
"Show a manpage from another Mud.\n".
"See also: muds\n"
	}];

    $Commands{'locate'} = [{
	'pattern'   => '^locate (.+)$',                           #'
	'mudindex'  => 0,
	'commandi2' => sub { return ('all', 'locate', $_[0], 1); },
	'commandi3' => sub { $user = shift;
                         return ('locate-req', $user, $_[0]); },
	'syntax'    => 'locate <name>',
	'help'      =>
"locate <name>\n".
"-------------\n".
"Find out if someone is a player on another mud (queries all muds)\n".
"See also:\n"
	}];

    # Channels
    $Commands{'channel'} = [{
	'pattern'   => '^channel (\S+) (.+)$',                     #'
	'mudindex'  => 0,
	'commandi2' => sub { return ('all', 'channel', $_[0], '', $_[1]); },
	'commandi3' => sub { $user = shift;
                         return ('channel-e', $user, $_[0], $_[1]); },
	'syntax'    => 'channel <channel> <text>',
	'help'      =>
"channel <channel> <text>\n".
"------------------------\n".
"Send a message on an intermud channel, goes to all listening muds.\n".
"See also: muds\n"
	}];

    $Commands{'channel:'} = [{
	'pattern'   => '^channel: (\S+) (.+)$',                    #'
	'mudindex'  => 0,
	'commandi2' => sub { return ('all', 'channel', $_[0], 'emote', $_[1]); },
	'commandi3' => sub { $user = shift;
                         return ('channel-e', $user, $_[0], $_[1]); },
	'syntax'    => 'channel: <channel> <text>',
	'help'      =>
"channel: <channel> <text>\n".
"-------------------------\n".
"Send an action on an intermud channel, goes to all listening muds.\n".
"Example: 'channel: test waves.', shows [test yourname\@perlmud waves.]'\n".
"See also: muds\n"
	}];
    
    $Commands{'channel;'} = [{
	'pattern'   => '^channel; (\S+) (.+)$',                    #'
	'mudindex'  => 0,
	'commandi2' => sub { return ('all', 'channel', $_[0], 'gemote', $_[1]); },
	'commandi3' => sub { $user = shift;
                         return ('channel-e', $user, $_[0], $_[1]); },
	'syntax'    => 'channel; <channel> <text>',
	'help'      =>
"channel; <channel> <text>\n".
"-------------------------\n".
"Send an action on an intermud channel, goes to all listening muds.\n".
"Example: 'channel; test giraffe waves.', shows [test yourname\@perlmuds giraffewaves.]'\n".
"See also: muds\n"
	}];
    
    $Commands{'channel-who'} = [{
	'pattern'   => '^channel-who (\S+)\@(\S+)$',       #'
	'mudindex'  => 2,
	'commandi2' => sub { return ($_[1], 'channel', $_[0], 'list', ''); },
	'commandi3' => sub { $user = shift;
                         return ('chan-who-req', $_[1], $user, $_[0]); },
	'syntax'    => 'channel-who <channel>@<mudname>',
	'help'      => 
'channel-who <channel>@<mud>' . "\n".
"---------------------------\n".
"Find out who is listening to a channel at the given Mud.\n".
"See also: muds, channel, channel:\n"
    }];

    $Commands{'channel-hist'} = [{
	'pattern'   => '^channel-hist (\S+)\@(\S+)$',       #'
	'mudindex'  => 2,
	'commandi2' => sub { return ($_[1], 'channel', $_[0], 'history', ''); },
	'commandi3' => sub { return ($_[1], 'channel', 'history', ''); },
	'syntax'    => 'channel-hist <channel>@<mudname>',
	'help'      => 
'channel-hist <channel>@<mud>' . "\n".
"---------------------------\n".
"Get the history for a channel from the given Mud.\n".
"See also: muds, channel, channel:\n"

    }];

    $Commands{'channel>'} = [{
	'pattern'   => '^channel> (\S+) (\w+)\@(\S+) (.*)$',       #'
	'mudindex'  => 3,
	'commandi2' => '',
	'commandi3' => sub { $user = shift;
                         return ('channel-t', $user, $_[0], $_[2], $_[1], $_[3]); },
	'syntax'    => 'channel> <channel> <name>@<mudname> <action>',
	'help'      =>
'channel> <someone> <channel>@<mud> <emote>' . "\n".
"---------------------------\n".
"Send a directed emote on an intermud channel to the given Mud.\n".
"See also: muds, channel, channel:\n"

	}];

    $Commands{'createchan'} = [{
	'pattern'   => '^createchan (\S+)$',                       #'
	'mudindex'  => 0,
	'commandi2' => sub { },   # change local list?
	'commandi3' => sub { $user = shift;
                         return ('channel-add', $user, $_[0], 1); },
	'syntax'    => 'createchan <channel>',
	'help'      => 
"createchan <channel>\n".
"--------------------\n".
"Create a new channel on intermud3\n"
    }];

    $Commands{'removechan'} = [{
	'pattern'   => '^removechan (\S+)$',                       #'
	'mudindex'  => 0,
	'commandi2' => sub { },   # local?
	'commandi3' => sub { $user = shift;
                         return ('channel-remove', $user, $_[0], 1); },
	'syntax'    => 'removechan <channel>',
	'help'      =>
"removechan <channel>\n".
"--------------------\n".
"Remove a channel from intermud3\n"
}];

    # Remote mud commands
    $Commands{'query'} = [{
	'pattern'   => '^query (\S+)\@(.+)$',                      #'
	'mudindex'  => 2,
	'commandi2' => sub { return ($_[1], 'query', $_[0]); },
	'commandi3' => '',
	'syntax'    => 'query <command>@<mudname>',
	'help'      =>
'query <command>@<mud>' . "\n".
"---------------------\n".
"Query a specific information about the given mud. For a list see 'events'.\n".
"See also: events\n"
}];

    # Internal commands
    $Commands{'away'} = [{
	'pattern'   => '^away\s?(.*)$',                             #'
	'command'   => sub { set_away(shift, $_[0]); },
	'syntax'    => 'away [<text>]',
	'help'      =>
"away [<text>]\n".
"-------------\n".
"Set/Unset a text to be shown when anybody tries to contact you.\n".
"A parameter of '-a' creates an away message which automatically disappears ".
"the next time something is typed.\n".
"See also: tell, emote.\n"
}];

    $Commands{'colour'} = [{
	'pattern'   => '^colour (\S+)\s(.+)$',                      #'
	'command'   => sub { add_colour(shift, $_[0], $_[1]); 
			     return list_events(shift); },
	'syntax'    => 'colour <event> <colour(s)>',
	'help'      =>
"colour <event> <colour list>\n".
"----------------------------\n".
"Cause messages with the given event type to always be shown\n".
" in the chosen colour. See 'levents' for an event list.\n".
"See also: levents, events, colours\n"
}];

    $Commands{'colours'} = [{
	'pattern'   => '^colours$',                                 #'
	'command'   => sub { return list_colours(shift); },
	'syntax'    => 'colours',
	'help'      =>
"colours\n".
"-------\n".
"Show a list of possible colours. Bold can be used with each to\n".
"intensify the colour.\n".
"See also: colour, levents, events\n"
}];

    $Commands{'events'} = [{
	'pattern'   => '^events$',                                  #'
	'command'   => sub { return list_events(shift); },
	'syntax'    => 'events',
	'help'      => 
"events\n".
"------\n".
"Show a list of all the events that have been coloured and their colours.\n".
"See also: colour, colours, levents.\n"
}];

    $Commands{'levents'} = [{
	'pattern'   => '^levents$',                                  #'
	'command'   => sub { return events(); },
	'syntax'    => 'levents',
	'help'      => 
"levents\n".
"-------\n".
"Show a list of all the events that can be coloured, or ignored.\n".
"See also: colour, colours, events.\n"
}];

    $Commands{'ignore'} = [{
	'pattern'   => '^ignore (event|mud) (\S+)$',                #'
	'command'   => sub { return ignore(shift, $_[0], $_[1]); },
	'syntax'    => 'ignore <event|mud> <event>',
	'help'      =>
"ignore <event|mud> <which>\n".
"--------------------------\n".
"Add a mud or event to the ignore list, no messages will be shown from the\n".
"chosen event, but the history will be kept.\n".
"See also: lignore, levents.\n"
}];

    $Commands{'lignore'} = [{
	'pattern'   => '^lignore$',                                 #'
	'command'   => sub { return list_ignore(shift); },
	'syntax'    => 'lignore',
	'help'      =>
"lignore\n".
"-------\n".
"Show a list of the currently ignored muds and events.\n".
"See also: ignore, levents.\n"
}];

    $Commands{'history'} = [{
	'pattern'   => '^history (\S+)$',                           #'
	'command'  => sub { return show_history(shift, $_[0]); },
	'syntax'    => 'history <event>',
	'help'      =>
"history <event>\n".
"---------------\n".
"Show the last 20 entries for the given event.\n".
"See also: levents.\n"
}];

    $Commands{'alias'} = [{
	'pattern'   => '^alias (\S+) (.+)$',                        #'
	'command'   => sub { return add_alias(shift, $_[0], $_[1]); },
	'syntax'    => 'alias <alias> <command>',
	'help'      =>
"alias <alias> <command(s)>\n".
"--------------------------\n".
"Make a complex, often used command shorter, by assigning it an alias.\n".
'The special character \'$*\' will be replaced by all the parameters given' . "\n".
'when using the alias, and \'$1\', \'$2\' by the individual words.' . "\n".
'Example: alias -d channel d-chat $*'. "\n".
"See also: unalias, lalias.\n"
}];

    $Commands{'unalias'} = [{
	'pattern'   => '^unalias (\S+)$',                           #'
	'command'   => sub { return delete_alias(shift, $_[0]); },
	'syntax'    => 'unalias <alias>',
	'help'      =>
"unalias <alias>\n".
"---------------\n".
"Delete an alias.\n".
"See also: alias, lalias.\n"
}];

    $Commands{'lalias'} = [{
	'pattern'   => '^lalias$',                                  #'
	'command'   => sub { return list_aliases(shift); },
	'syntax'    => 'lalias',
	'help'      =>
"lalias\n".
"---------------\n".
"List all aliases.\n".
"See also: alias, unalias.\n"
}];

    $Commands{'muds'} = [{
	'pattern'   => '^muds$',                            #'
	'command'   => sub { return list_muds(shift); },
	'syntax'    => 'muds',
	'help'      =>
"muds\n".
"----\n".
"Lists all available/known muds.\n".
"See also: who.\n"
}];

    $Commands{'help'} = [{
	'pattern'   => '^help\s?(\S*)$',                            #'
	'command'   => sub { show_help(shift, $_[0]); },
	'syntax'    => 'help [<command>]',
	'help'      =>
"help\n".
"----\n".
"Show the command list or help about a command.\n".
"See also: \n"
}];

    # Mail
    $Commands{'mail'} = [
			 {
        'pattern'   => '^mail (\w+?)(?:\s(.+?)(?:\@(.+?))?)?$',          #'
        'command'   => sub { return mail_start(shift, $_[0], $_[1], $_[2]); },
        'syntax'    => 'mail <write|list|read|delete|forward|set> '.
	    '[<name>[@<mud>]|<number>]',
	'help'      =>
"mail <write|list|read|delete|forward|set> [<name>[@<mud>]|<number>]\n".
"-------------------------------------------------------------------\n".
"Write <name>   : Send a mail message to someone locally or on another Mud.\n".
"List           : Show a list of messages in your local mailbox.\n".
"Read <number>  : Read one of your messages.\n".
"Delete <number>: Remove a message from your mailbox.\n".
"See also: mail list, mail read, mail delete\n"
        }];

    $Commands{'mail forward'} = [
			 {
        'pattern'   => '^mail forward (\d+?) (.+)$',                #'
        'command'   => sub { return mail_forward(shift, $_[0], $_[1]); },
        'syntax'    => 'mail forward <number> <to>',
	'help'      =>
"mail forward <number> <to>\n".
"--------------------------\n".
"Send a mail in your mailbox to someone else.\n".
"See also: mail, mail list, mail read\n"
        }];

    $Commands{'mail set'} = [
			 {
        'pattern'   => '^mail set (.+?) (.+)$',                #'
        'command'   => sub { return mail_set(shift, $_[0], $_[1]); },
        'syntax'    => 'mail set <param> <value>',
	'help'      =>
"mail set <param> <value>\n".
"------------------------\n".
"Set a value in the mail system.\n".
"See also: mail, mail list, mail read, mail forward\n"
        }];

    $Commands{'change'} = [{
	'pattern'   => '^change (\w+) (.*)$',               #'
	'command'   => sub { change_param(shift, $_[0], $_[1]); },
	'syntax'    => 'change <title|level|location|password> <value> [<oldvalue>]',
        'help'      =>
"change <title|level|location|password> <value> [<oldvalue>]\n".
"-----------------------------------------------------------\n".
"Change your title, level or location, shown in the finger and who commands,\n".
" or your password, by giving your current password as an extra argument.\n".
"See also: finger, who.\n"
	}];

    $Commands{'prefix'} = [{
	'pattern'   => '^prefix (.*)$',                     #'
	'command'   => sub { change_prefix(shift, $_[0]); },
	'syntax'    => 'prefix <command>',
	'help'      =>
"prefix <command>\n".
"----------------\n".
"Prepends all following text with the given command, until a single '.'".
" is entered.\n".
"Example: prefix say\n".
"Everything typed is now output as 'You say:' .. even other commands.\n".
"See also: .\n"
}];

    $Commands{'echo'} = [{
	'pattern'   => '^echo\s*(off|on|)$',                     #'
	'command'   => sub { change_echostatus(shift, $_[0]); },
	'syntax'    => 'echo <on|off>',
	'help'      =>
"echo <on|off>\n".
"-------------\n".
"Turns on or off the echoing of your commands: (The 'You typed:' .. )\n".
"Example: echo on\n".
"See also: .\n"
}];

    $Commands{'.'} = [{
	'pattern'   => '^\.$',                              #'
	'command'   => sub { change_prefix(shift, undef); },
	'syntax'    => '.',
	'help'      =>
".\n".
"-\n".
"Turns off prefix-mode.\n".
"See also: prefix.\n"
	}];

    $Commands{'!'} = [{
	'pattern'   => '^!(.*)$',                              #'
	'command'   => sub { escape_prefix(shift, undef); },
	'syntax'    => '.',
	'help'      =>
".\n".
"-\n".
"Turns off prefix-mode.\n".
"See also: prefix.\n"
	}];

    $Commands{'more'} = [{
	'pattern'   => '^more\s?(\+|-|q|\/[^/]*\/)?$',      #'
	'command'   => sub { more_text(shift, $_[0]); },
	'syntax'    => 'more <+|-|q>',
	'help'      =>
"more <+|-|q>\n".
"------------\n".
"Show pages in the 'more' buffer.\n".
"If any command produces an output longer than 23 lines, ".
"'---- More ----' is shown, indicating that there are more lines to be seen.".
" To see the same 'page' again, type 'more', to see the next page, type ".
"'more +', to see the previous page, type 'more -'. 'more q' clears the more".
" buffer (which will be overwritten by the next long output anyway).\n".
"See also:\n"
	}];

    # Rooms
    $Commands{'create'} = [{
	'pattern'   => '^create room (\S+)$',               #'
	'command'   => sub { create_room(shift, $_[0]); },
	'syntax'    => 'create room <name>',
	'help'      =>
"create room <name>\n".
"------------------\n".
"Create a new room with the given shortcut. The name must not contain any ".
"spaces. The room can then be entered with 'goto' using this name.\n".
"See also: goto, edit room.\n"
	}];

    $Commands{'add'} = [{
	'pattern'   => '^add detail (\S+)\s?(.*)$',               #'
	'command'   => sub { create_detail(shift, $_[0], $_[1]); },
	'syntax'    => 'add detail <name> [<text>]',
	'help'      =>
"add detail <name> [<text>]\n".
"--------------------------\n".
"Create a room detail which can be looked at, using a word (no spaces) as the".
" name. The text can be optionally entered, or edited using 'edit'.\n".
"See also: create room, edit.\n"
	}];

    $Commands{'look'} = [{
	'pattern'   => '^look$',                            #'
	'command'   => sub { look_local(shift); },
	'syntax'    => 'look',
	'help'      =>
"look\n".
"----\n".
"Show the description of the current room, and list the people in it.\n".
"See also: who, people, lrooms, create room, goto.\n"
	}];

    $Commands{'examine'} = [{
	'pattern'   => '^examine (\S+)$',                            #'
	'command'   => sub { examine_local(shift, $_[0]); },
	'syntax'    => 'examine <name>',
	'help'      =>
"examine <name|item>\n".
"-------------------\n".
"Look at a person or a room detail.\n".
"See also: look, people, who, add detail.\n" 
	}];

    $Commands{'goto'} = [{
	'pattern'   => '^goto (\S+)$',                      #'
	'command'   => sub { goto_room(shift, $_[0]); },
	'syntax'    => 'goto <name>',
	'help'      =>
"goto <name>\n".
"-----------\n".
"Move to another room.\n".
"See also: people, lrooms, create room.\n"
	}];

    $Commands{'lrooms'} = [{
	'pattern'   => '^lrooms$',                          #'
	'command'   => sub { list_rooms(shift); },
	'syntax'    => 'lrooms',
	'help'      =>
"lrooms\n".
"------\n".
"Show a list of all rooms.\n".
"See also: create room, goto, people.\n"
	}];

   $Commands{'describe'} = [{
	'pattern'   => '^describe room (.*)$',                     #'
	'command'   => sub { describe_room(shift, 0, $_[0]); },
	'syntax'    => 'describe room <text>' ,
	'help'      =>
"describe room <text>\n".
"--------------------\n".
"Write a description for the room you are standing in. Only works if you are".
" also the creator of the room.\n".
"See also: look, lrooms, people, create room.\n"
}];

    $Commands{'lock'} = [{
	'pattern'   => '^lock$',                              #'
	'command'   => sub { lock_room(shift); },
	'syntax'    => 'lock',
	'help'      =>
"lock\n".
"----\n".
"Lock the room you are standing in. A locked room cannot be entered by ".
"anyone else, but people can still leave. You can only lock rooms which you ".
"have created. Use 'unlock' to let people in again. The room will be ".
"automatically unlocked when you leave it.\n".
"See also: unlock.\n"
	}];

    $Commands{'unlock'} = [{
	'pattern'   => '^unlock$',                              #'
	'command'   => sub { unlock_room(shift, $_[0]); },
	'syntax'    => 'unlock',
	'help'      =>
"unlock\n".
"------\n".
"Unlock the room and let people back in. Only works if you are the creator ".
"of the room.\n".
"See also: lock.\n"
	}];

    $Commands{'edit'} = [{
	'pattern'   => '^edit (room|detail|show|save|forget)\s?(\S*)$',    #'
	'command'   => sub { edit_item(shift, $_[0], $_[1]); },
	'syntax'    => 'edit <room|detail|show|save|forget> [<name>]',
	'help'      =>
"edit <room|detail|show|save|forget> [<name>]\n".
"--------------------------------------------\n".
"Editor commands to edit the text of various things.\n".
"To start editing the room you are standing in, use 'edit room', to edit one ".
"of the details of the current room, type 'edit detail <name>', the detail ".
"must already exist.\n".
"To show the current contents of the editor, use 'edit show', to finish ".
"editing and save the changes, use 'edit save', to finish editing and discard".
" any changes, use 'edit forget'.\n".
"The actual editing is done with the 'e' command.\n".
"See also: create room, add detail, e, mail.\n"
	}];

    $Commands{'e'} = [{
	'pattern'   => '^e (\d+) ([sciad])\s?(.*)$',             #'
	'command'   => sub { edit_current(shift, $_[0], $_[1], $_[2]); },
	'syntax'    => 'e [<line number>] <s|c|i|a|d> <text|pattern>',
	'help'      =>
"e <line number> <s|c|i|a|d> <text|pattern>\n".
"------------------------------------------\n".
"Edit lines of the text contained in the editor.\n".
"The commands are similar to ed/edlin/vi commands, only one line may be ".
"changed at a time, if the text added is longer than the line edited or ".
"replaced, the line numbers will change!\n".
"s - search-and-replace /oldpattern/newpattern/ - using perl regexps.\n".
"c - replace an entire line with the text entered.\n".
"i - insert a line before the line number given.\n".
"a - add a line after the line number given.\n".
"d - delete this line.\n".
"See also: edit, mail.\n"
	}];

    $Commands{'>'} = [{
	'pattern'   => '^> (\d+) (.*)$',                              #'
	'command'   => sub { describe_room(shift, $_[0], $_[1]); },
	'syntax'    => '> <line number> <new text>',
	'help'      =>
"> <line number> <new text>\n".
"--------------------------\n".
"<Dont use> - use the editor instead.\n".
"See also: edit, e.\n"
	}];

    $Commands{'people'} = [{
	'pattern'   => '^people$',                                  #'
	'command'   => sub { show_people(shift); },
	'syntax'    => 'people',
	'help'      =>
"people\n".
"------\n".
"Show a list of rooms and the users in them.\n".
"See also: lrooms, look, who.\n"
	}];

    # Debug etc.
    $Commands{'size'} = [{
	'pattern'   => '^size (\S+)$',                              #'
	'command'   => sub { show_size(shift, $_[0]); },
	'syntax'    => 'size <%Users|%Mores|%Commands etc>',
	'help'      =>
"size <variable>\n".
"---------------\n".
"Show the amount of memory taken up by the given internal variable.\n".
"See also: dump.\n"
	}];

    $Commands{'dump'} = [{
	'pattern'   => '^dump (\S+)$',                              #'
	'command'   => sub { show_dump(shift, $_[0]); },
	'syntax'    => 'size <%Users|%Mores|%Commands etc>',
	'help'      =>
"dump <variable>\n".
"---------------\n".
"Show the contents of an internal variable.\n".
"See also: size.\n"
	}];

    $Commands{'poke'} = [{
	'pattern'   => '^poke (\S+) (.*)$',                              #'
	'command'   => sub { poke_value(shift, $_[0], $_[1]); },
	'syntax'    => 'poke <variable> <value>',
	'help'      =>
"poke <variable> <value>\n".
"-----------------------\n".
"Set the value of an internal variable. Admin only!\n".
"See also: dump, size.\n"
	}];

    $Commands{'sql'} = [{
	'pattern'   => '^sql (.*)$',                              #'
	'command'   => sub { do_sql(shift, $_[0]); },
	'syntax'    => 'sql <query>',
	'help'      =>
"sql <query>\n".
"-----------\n".
"Use any SQL query on the internal database. Only SELECT is allow for non-".
"admins!\n".
"See also: \n"
	}];

    $Commands{'hexify'} = [{
	'pattern'   => '^hexify (.*)$',                           #'
	'command'   => sub { show_hexvalue(shift, $_[0]); },
	'syntax'    => 'hexify <text>',
	'help'      =>
"hexify <text>\n".
"-------------\n".
"Shows the results of the text given after being run through perls 'hex'".
" function.\n".
"See also: \n"
	}];

    $Commands{'reduce'} = [{
	'pattern'   => '^reduce (\w+)$',                           #'
	'command'   => sub { show_reduced(shift, $_[0]); },
	'syntax'    => 'reduce <text>',
	'help'      =>
"reduce <word>\n".
"-------------\n".
"Reduce a german word to its basic form (Text::German).\n".
"See also: \n"
	}];

}

###############################################################################
# Users

sub load_users
{
    # Load Users from database
    # Parameters: None

    if($idb)
    {
	my $vals = $idb->getUsers();
	foreach my $row (@{$vals})
	{
	    $Users{$row->[0]}{'user'} = $row->[1];
	    $Users{$row->[0]}{'password'} = $row->[2];
	    $Users{$row->[0]}{'title'} = $row->[3];
	    $Users{$row->[0]}{'desc'} = $row->[4];	    
	    $Users{$row->[0]}{'level'} = $row->[5];
	    $Users{$row->[0]}{'location'} = $row->[6];
	    $Users{$row->[0]}{'room'} = $row->[7];
	    $Users{$row->[0]}{'login'} = $row->[8];
	    $Users{$row->[0]}{'logout'} = $row->[9];
	}

	foreach my $userid (keys %Users)
	{
	    $Users{$userid}{'aliases'} = load_aliases($userid);
	    $Users{$userid}{'coloureditems'} = load_colours($userid);
	    $Users{$userid}{'ignoredevents'} = load_ignoevents($userid);
	    $Users{$userid}{'ignoredmuds'} = load_ignomuds($userid);
	    $Users{$userid}{'state'} = 0;
	    $Users{$userid}{'idle'} = 0;
	    $Users{$userid}{'away'} = '';
	    $Users{$userid}{'prefix'} = '';
	    $Users{$userid}{'screenwidth'} = 80;
	    $Users{$userid}{'screenheight'} = 25;
	    $Users{$userid}{'title'} = "%N is here." 
		if(!defined($Users{$userid}{'title'}));
	    $Users{$userid}{'level'} = "User" 
		if(!defined($Users{$userid}{'level'}));
	    $Users{$userid}{'location'} = "PerlMud" 
		if(!defined($Users{$userid}{'location'}));
	    $Users{$userid}{'room'} = 1 
		if(!defined($Users{$userid}{'room'}));
	}
    }
    $Users{1}{'socket'} = \*STDOUT;
    $Users{1}{'state'} = 1;
    $Users{1}{'login'} = time();
    $Users{1}{'idle'} = time();
    debug(Dumper(\%Users));
}

sub create_user
{
    # Create a new user with default values
    # Parameters: Name,
    my ($name) = @_;
    my $maxi = 0; 
    foreach my $k (keys %Users)
    { 
        $maxi= $k if($maxi < $k); 
    }
    $maxi++;
    $Users{$maxi}{'user'} = $name;
    $Users{$maxi}{'password'} = '';
    $Users{$maxi}{'title'} = "%N is here.";
    $Users{$maxi}{'desc'} = '';
    $Users{$maxi}{'level'} = "User";
    $Users{$maxi}{'location'} = "PerlMud";
    $Users{$maxi}{'room'} = 1;
    $Users{$maxi}{'prefix'} = '';
    $Users{$maxi}{'away'} = '';
    $Users{$maxi}{'aliases'} = {};
    $Users{$maxi}{'coloureditems'} = {};
    $Users{$maxi}{'ignoredevents'} = ['channel:d-news', 'channel:d-tv-alles',
				      'channel:d-tv', 
				      'query:hosts', 'error:timeout'];
    $Users{$maxi}{'ignoredmuds'} = [];
    $Users{$maxi}{'screenwidth'} = 80;
    $Users{$maxi}{'screenheight'} = 25;
    $Users{$maxi}{'state'} = 0;

    return $maxi;
}

sub login_user
{
    # Setup user who just logged in
    # Parameter: UserId, Socket
    my ($userid, $sock) = @_;

    $Users{$userid}{'socket'} = $sock;
    $Users{$userid}{'state'} = 1;
    $Users{$userid}{'login'} = time();
    $Users{$userid}{'idle'} = time();
    $Users{$userid}{'room'} = 1 unless($Users{$userid}{'room'});

    print_output($userid, {'output' => 'Have fun!'});
    print_output($userid, check_mail($userid));

    login_local($userid);
}

sub get_user
{
    # Get an id of a user name
    # Parameter: Name
    my ($name) = @_;

    if(!$name)
    {
	return undef;
    }
    debug("get_user: $name\n");
    my ($userid) = grep(lc($Users{$_}{'user'}) eq lc($name), keys(%Users));
#    debug("userid: $userid\n");
    return $userid ? $userid : undef;
}

sub local_user
{
    # Callback, return true if user in Hash->{'data'} is logged in
    # Parameter: Request
    my ($name) = @_;

    my $id = get_user($name);
    return 1 if($id && $Users{$id}{'state'});

    return 0;
}

sub local_user_i3
{
    # Callback, return true if user in Hash->{'data'} is logged in
    # Parameter: Request
    my ($user) = @_;

    my $id = get_user($user);
    return 0 if(!$id);

    my $answer;
    $answer->{'name'} = ucfirst($user);
    $answer->{'idletime'} = time() - $Users{$id}{'idle'};
    $answer->{'status'} = 'Away: ' . $Users{$id}{'away'} 
      if($Users{$id}{'away'});
    return $answer;
}

sub add_user
{
    # Add a new user to the database
    # Parameter: UserId
    my ($userid) = @_;

    if($idb)
    {
	my $res = $idb->appendTable('Users', 
				['ID', 'Name', 'Password', 'login', 'room'],
				[$userid,
				 $Users{$userid}{'user'},
				 $Users{$userid}{'password'},
				 $Users{$userid}{'login'},
				 $Users{$userid}{'room'}]);
	if(!defined($res))
	{
	    debug("Can't add user $Users{$userid}{'user'}: " . 
		  $idb->getError() . "\n");
	}
	foreach $e (@{$Users{$userid}{'ignoredevents'}})
	{
	    $idb->appendTable('IgnoredEvents',
			      ['user_id', 'Event'],
			      [$userid, $e]);
	}
    }
    
}

sub get_user_socket
{
    # Return the id of a user with this socket, if existant
    # Parameter: Socket
    my ($sock) = @_;

    return if(!$sock);

    foreach my $user (keys %Users)
    {
	if($Users{$user}{'socket'} && $Users{$user}{'socket'} == $sock)
	{
	    return $user;
	}
    }
    return undef;
}

sub set_away
{
    # Set/Unset away..
    # Parameter: UserId, Text
    my ($userid, $text) = @_;

    if(!$Users{$userid})
    {
	return 0;
    }
    if(!$text)
    {
	my $result;
	$Users{$userid}{'away'} = undef;
	$Users{$userid}{'awayflag'} = undef;
	if($idb)
	{
	    my $res = $idb->updateTable('Users', ['ID'], [$userid],
					['away'], ['']);
	    if(!defined($res))
	    {
		debug("Can't set away for user $Users{$userid}{'user'}: " . 
		      $idb->getError() . "\n");
	    }
	}
	$result->{'output'} = "Welcome back!";
	return $result;
    }

    if($text =~ s/^-a//)
    {
	$Users{$userid}{'awayflag'} = 1;
    }

    $Users{$userid}{'away'} = $text;
    my $result;
    $result->{'output'} = "You are now away: $text";

    if($idb)
    {
	my $res = $idb->updateTable('Users', ['ID'], [$userid], 
				['away'],
				[$text]);
	if(!defined($res))
	{
	    debug("Can't set away for user $Users{$userid}{'user'}: " . 
		  $idb->getError() . "\n");
	}
    }

    return $result;
}

sub login_local
{
    # Show who logged in
    # Parameter: UserId, Text
    my ($userid, $text) = @_;

    my $result;
    
    foreach my $u (keys %Users)
    {
	next if(!$Users{$u}{'state'});
	next if($u == $userid);
	if($Users{$u}{'room'} == $Users{$userid}{'room'})
	{
	    print_output($u, {'output' => ucfirst($Users{$userid}{'user'}) .
				  " logs in.",
			      'type'   => 'channel:login'});
	}
    }
    return '0';
}

sub logout_local
{
    # Show who logged out
    # Parameter: UserId, Text
    my ($userid, $text) = @_;

    my $result;
    
    foreach my $u (keys %Users)
    {
	next if(!$Users{$u}{'state'});
	next if($u == $userid);
	if($Users{$u}{'room'} == $Users{$userid}{'room'})
	{
	    print_output($u, {'output' => ucfirst($Users{$userid}{'user'}) .
				  " logs out.",
			      'type'   => 'channel:login'});
	}
    }
    $Users{$userid}{'logout'} = time();
    if($idb)
    {
	my $res = $idb->updateTable('Users', ['ID'], [$userid], 
				['logout'],
				[$Users{$userid}{'logout'}]);
	if(!defined($res))
	{
	    debug("Can't set logout for user $Users{$userid}{'user'}: " . 
		  $idb->getError() . "\n");
	}
    }

    my $rid = $Users{$userid}{'room'};
    if($Rooms{$rid}{'locked'} && $Rooms{$rid}{'creator'} == $userid)
    {
	$Rooms{$rid}{'locked'} = 0;
    }
    
    return '0';
}

sub tell_local
{
    # Tell somebody something..
    # Parameter: UserId, UserId, Text
    my ($userid, $target, $text) = @_;

    my $result;
    $result->{'type'} = 'cmd:tell';
    my $uid = get_user($target);
    if(!$uid || !$Users{$uid}{'state'}) 
    {
	$result->{'output'} = "$target is not here!";
	return $result;
    }
    
    print_output($uid, {'output' => ucfirst($Users{$userid}{'user'}) .
			    ' tells you: ' . $text,
			'type' => 'cmd:tell'});
    $result->{'output'} = "You told " . ucfirst($target) . ": $text";
    if($Users{$uid}{'away'})
    {
	$result->{'output'} .= "\n" . ucfirst($target) . " is away: " .
	    $Users{$uid}{'away'};
    }

    return $result;
}

sub finger_local
{
    # Give out local finger info?
    # Text::Template??
    # Parameter: UserId, UserId
    my ($userid, $user) = @_;

    my $uid = get_user($user);
    if(!$uid)
    {
	return {'output' => "Unknown user: " . ucfirst($user) . "\n"}; 
    }

    my $width = $userid > 1 ? $Users{$userid}{'screenwidth'} - 1 : 79;
    my $output = '';
    $output .= '+' . '-' x ($width - 2) . '+' . "\n";
    my $name = $Users{$uid}{'title'};
    $name =~ s/%N/ucfirst($Users{$uid}{'user'})/eg;
    $output .= '| ' . $name . ' ' x ($width - length($name) - 3) . '|' . "\n";
    $output .= '|' . ' ' x ($width - 2) . '|' . "\n";
    $output .= '| Level:    ' . ucfirst($Users{$uid}{'level'}) . 
	' ' x ($width - 12 - length($Users{$uid}{'level'}) - 1) . '|' . "\n";
    $output .= '| Location: ' . ucfirst($Users{$uid}{'location'}) .
	' ' x ($width - 12 - length($Users{$uid}{'location'}) - 1) . '|' . "\n";

    $output .= '|' . ' ' x ($width - 2) . '|' . "\n";

    my $line = '| ' . ($Users{$uid}{'state'} ? 'Logged in since ' 
		       : 'Logged out since ');

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
	localtime($Users{$uid}{'state'} ? $Users{$uid}{'login'} : 
		  $Users{$uid}{'logout'});
    my $time = sprintf("%04d-%02d-%02d %02d:%02d ", 
		       $year + 1900,$mon + 1,$mday,$hour,$min);
    $line .= $time;
    $output .= $line . ' ' x ($width - length($line) - 1)  . '|' . "\n";
    my $idle = time() - $Users{$uid}{'idle'};

    if($idle > 60 * 5 && $Users{$uid}{'state'}) 
    {
	my $mins = $idle / 60;
	my $hours = int($mins / 60);
	$mins %= 60;
	$line = '| idle for ' . $hours . " hours and " . $mins . " minutes.";
	$output .= $line . ' ' x ($width - length($line) - 1)  . '|' . "\n";
    }
    if($Users{$uid}{'away'})
    {
	$output .= '| Away: ' . $Users{$uid}{'away'} . 
	    ' ' x ($width - 8 - length($Users{$uid}{'away'}) - 1) . '|' . "\n";
    }
    $output .= '+' . '-' x ($width - 2) . '+' . "\n";

    my $result;
    $result->{'output'} = $output;

    return $result;

#+-----------------------------------------------------------------------------+
#| Castaway bastelt rum.                                                       |
#|                                                                             |
#|  Level:    Admin                                                            |
#|  Location: PerlMud                                                          |
#|                                                                             |
#|  logged in since 9999-12-31 23:59                                           |
#|  idle for 9 hours and 9 minutes.                                            |
#|  away: dinner                                                               |
#+-----------------------------------------------------------------------------+
}

sub finger_remote
{
    # Return remote finger information
    # Parameter: Name
    my (%request) = @_;

    my $uid = get_user($request{'data'});
    if(!$uid)
    {
	return "PerlMud: User not found: $request{'data'}\n";
    }

    return finger_local(0, $request{'data'})->{'output'};
    
}

sub finger_remote_i3
{
    # remote finger information for i3
    # Parameter: Name
    my ($user) = @_;

    my $uid = get_user($user);
    if(!$uid)
    {
	return 0;
    }

    my $answer;
    $answer->{'name'} = ucfirst($user);
    my $name = $Users{$u}{'title'};
    $name =~ s/%N/ucfirst($Users{$u}{'user'})/eg;
    $answer->{'title'} = $name;
    $answer->{'loginout'} = $Users{$uid}{'state'} ? $Users{$uid}{'login'} : 
	$Users{$uid}{'logout'};
    $answer->{'level'} = $Users{$uid}{'level'};
    $answer->{'extra'} = $Users{$uid}{'plan'} if($Users{$uid}{'plan'});
}

sub emote_local
{
    # A local emote
    # Parameter: UserId, Text
    my ($userid, $text) = @_;

    my $result;
    $result->{'type'} = 'cmd:emote';
    my @texts = split('#', $text);
    my $uid;

    if(@texts == 3)
    {
	# An emote to someone?.
	$uid = get_user($texts[0]);
	if(!$uid || !$Users{$uid}{'state'} || 
	   $Users{$userid}{'room'} != $Users{$uid}{'room'})
	{
	    $result->{'output'} = "No " . ucfirst($texts[0]) . " here.";
	    return $result;
	}
	print_output($uid, {'output' => ucfirst($Users{$userid}{'user'}) .
				' ' . $texts[1],
			    'type'   => 'cmd:emote'});
	$text = $texts[2];
    }
    foreach my $u (keys %Users)
    {
	next if(!$Users{$u}{'state'});
	next if($uid && $u == $uid);
	next if($Users{$userid}{'room'} != $Users{$u}{'room'});
	print_output($u, {'output' => ucfirst($Users{$userid}{'user'}) .
			      ' ' . $text,
			  'type'   => 'cmd:emote'});
    }
    $result = '0';
}

sub gemote_local
{
    # A local gemote
    # Parameter: UserId, Text
    my ($userid, $text) = @_;

    my $result;
    $result->{'type'} = 'cmd:gemote';
    my @texts = split('#', $text);
    my $uid;

    if(@texts == 3)
    {
	# An emote to someone?.
	$uid = get_user($texts[0]);
	if(!$uid || !$Users{$uid}{'state'} || 
	   $Users{$userid}{'room'} != $Users{$uid}{'room'})
	{
	    $result->{'output'} = "No " . ucfirst($texts[0]) . " here.";
	    return $result;
	}
	print_output($uid, {'output' => ucfirst($Users{$userid}{'user'}) .
				's ' . $texts[1],
			    'type'   => 'cmd:gemote'});
	$text = $texts[2];
    }
    foreach my $u (keys %Users)
    {
	next if(!$Users{$u}{'state'});
	next if($uid && $u == $uid);
	next if($Users{$userid}{'room'} != $Users{$u}{'room'});
	print_output($u, {'output' => ucfirst($Users{$userid}{'user'}) .
			      's ' . $text,
			  'type'   => 'cmd:gemote'});
    }
    $result = '0';
}

sub who_local
{
    # Return a list of local users
    # Parameter: UserId
    my ($userid) = @_;

    my $result;
    $result->{'output'} = '';

    my $table = Text::FormatTable->new('l l r');
    $table->head("Level", "Title", "Location");

    

    foreach my $u (keys %Users)
    {
	if(!$Users{$u}{'state'})
	{
	    next;
	}
	my $name = $Users{$u}{'title'};
	$name =~ s/%N/ucfirst($Users{$u}{'user'})/eg;
	$table->row($Users{$u}{'level'}, ucfirst($name), 
		    $Users{$u}{'location'});
    }

    $result->{'output'} .= $table->render(
					  $userid > 0 ? 
					  $Users{$userid}{'screenwidth'}-1
					  : 79);
    $result->{'type'} = 'cmd:who';
    return $result;
}

sub who_remote
{
    # Remote who list (return local who list with header and removing headers)
    # Parameter: None

    my $answer = '';
    $answer .= '-' x 79 . "\n";
    $answer .= ' ' x 35 . "PerlMud\n";
    my $wholist = who_local(0);
    substr($wholist->{'output'}, 0, index($wholist->{'output'}, "\n"), '');
    $answer .= $wholist->{'output'};
    $answer .= '-' x 79 . "\n";
    return $answer;
}

sub who_remote_i3
{
    # Remote who list (return local who list with header and removing headers)
    # Parameter: None

    my $answer = [];
    foreach my $u (keys %Users)
    {
	next if(!$Users{$u}{'state'});
	my $person = [];
	$person->[scalar(@$person)] = ucfirst($Users{$u}{'user'});
	$person->[scalar(@$person)] = time() - $Users{$u}{'idle'};

	my $name = $Users{$u}{'title'};
	$name =~ s/%N/ucfirst($Users{$u}{'user'})/eg;
	$person->[scalar(@$person)] = $name;

	$answer->[scalar(@$answer)] = $person;
    }
    return $answer;
}

sub say_local
{
    # Say something so that everyone logged in (or in current room!?) can hear.
    # Parameter: UserId, Text
    my ($userid, $text) = @_;

    my $result;
    
    foreach my $u (keys %Users)
    {
	next if(!$Users{$u}{'state'});
	next if($u == $userid);
	if($Users{$u}{'room'} == $Users{$userid}{'room'})
	{
	    print_output($u, {'output' => ucfirst($Users{$userid}{'user'}) .
				  " says: $text",
			      'type'   => 'cmd:say'});
	}
    }
    $result->{'output'} = "You say: $text";
    $result->{'type'} = 'cmd:say';
    return $result;
}

sub change_prefix
{
    # Set/unset a prefix to set before every input
    # Parameter: UserId, Text
    my ($userid, $text) = @_;

    my $result;
    if(!$text)
    {
	# Unset
	$Users{$userid}{'prefix'} = '';
	$result->{'output'} = "Prefix deleted.";
	return $result;
    }

    # Check if prefix is a known command
    if(!$Commands{$text} && 
       !$Commands{substr($text, 0, index($text, ' '))} &&
       !$Users{$userid}{'aliases'}{$text} &&
       !$Users{$userid}{'aliases'}{substr($text, 0, index($text, ' '))}
       )
    {
	$result->{'output'} = ucfirst($text) . " is not a known command";
	return $result;
    }
    
    $Users{$userid}{'prefix'} = "$text ";

    $result->{'output'} = "Prefix is now set to: $text.";
    return $result;
}

sub change_echostatus
{
    # Set/unset a 'echooff' (default: undef - echo is on)
    # Parameter: UserId, Text
    my ($userid, $text) = @_;

    my $result;
    if(!$text)
    {
        # Change status
        $Users{$userid}{'echooff'} = !$Users{$userid}{'echooff'};
        $result->{'output'} = "Echo " . ($Users{$userid}{'echooff'} ? 'off.' :
                                         'on.');
        return $result;
    }
    
    if($text eq 'on')
    {
        # Turn echo back on
        $Users{$userid}{'echooff'} = 0;
        $result->{'output'} = "Echo on.";
        return $result;
    } 

    if($text eq 'off')
    {
        # Turn echo off
        $Users{$userid}{'echooff'} = 1;
        $result->{'output'} = "Echo off.";
        return $result;
    } 

    $result->{'output'} = "Unknown parameter $text.";
    return $result;
}

sub escape_prefix
{
    # Execute a perlmud command while in prefix mode?
}

sub change_param
{
    # Change a user parameter
    # Parameter: UserId, Parameter, Value
    my ($userid, $param, $value) = @_;

    my $result;
    $param = lc($param);
    my @params = ('title', 'level', 'location', 'desc', 'password');
    if(!grep(/^$param$/, @params))
    {
	$result->{'output'} = "No such parameter: $param";
	return $result;
    }
    
    if($param eq 'level' && lc($value) eq 'admin' && $userid != 1)
    {
	$result->{'output'} = "No, no, anything but that!";
	return $result;
    }
    if(($param eq 'title' && length($value) > 65) || 
       ($param eq 'level' && length($value) > 10) ||
       ($param eq 'location' && length($value) > 15) ||
       ($param eq 'desc' && length($value) > 1024))
    {
	$result->{'output'} = "Parameter too long.";
	return $result;
    }

    if($param eq 'title' && $value !~ /\%N/)
    {
	$result->{'output'} = "There is no %N in your title!";
	return $result;
    }

    if($param eq 'password')
    {
	my $oldp;
	($value, $oldp) = split(' ', $value, 2);
	if($oldp ne $Users{$userid}{'password'})
	{
	    $result->{'output'} = "Use change password <newpassword> <oldpassword>".
		" to change your password."; 
	    return $result;
	}
    }

    $Users{$userid}{$param} = $value;
    if($idb)
    {
	my $res = $idb->updateTable('Users', ['ID'], [$userid],
				    [$param], [$value]);
	if(!$res)
	{
	    debug("Error writing to Users table: " . $idb->getError() . "\n");
	}
    }
    $result->{'output'} = "$param set to $value";
    return $result;
}

sub channel_list
{
    # Return a list of the users on the given channel
    # Parameter: Channel
    my ($channel) = @_;

    my $answer = "[$channel:PerlMud]: ";
    my @events = $i2->getEvents();
    if(!grep(/^channel:$channel$/, @events))
    {
	return $answer . "\r\n";
    }
    foreach my $u (grep {$_->{'state'}} values %Users)
    {
	if(!grep (/^channel:$channel$/, @{$u->{'ignoredevents'}}))
	{
	    $answer .= $u->{'user'} . ", ";
	}
    }
    return $answer . "\r\n";
}

sub channel_list_i3
{
    # Return a list of the users on the given channel
    # Parameter: Channel
    my ($channel) = @_;

    my $answer = [];
    my @events = $i2->getEvents();
    if(!grep(/^channel:$channel$/, @events))
    {
	return [];
    }
    foreach my $u (grep {$_->{'state'}} values %Users)
    {
	if(!grep (/^channel:$channel$/, @{$u->{'ignoredevents'}}))
	{
	    $answer->[scalar(@$answer)] = $u->{'user'};
	}
    }
    return $answer;
}

sub channel_hist
{
    # Returns the last 20 line of channel history from our store
    # Paramters: Channel
    my ($channel) = @_;

    if(my $hist = $Users{0}{'history'}{'channel:' . $channel})
    {
	return join("\r\n", @{$hist});
    }
    return '';
}

###############################################################################
# Rooms

sub load_rooms
{
    # Load Rooms from database
    # Parameter: None

    if($idb)
    {
	my $vals = $idb->getTableVals('Rooms', 'ID', 'Creator', 'Name', 
				      'Description');

	foreach my $row (@{$vals})
	{
	    $Rooms{$row->[0]}{'creator'} = $row->[1];
	    $Rooms{$row->[0]}{'name'} = $row->[2];
	    $Rooms{$row->[0]}{'desc'} = $row->[3] || '';
	    $Rooms{$row->[0]}{'details'} = load_details($row->[0]);
	}

	foreach my $roomid (keys %Rooms)
	{
	    $Rooms{$roomid}{'locked'} = 0;
	}
    }
    $Rooms{1}{'creator'} = 1 unless($Rooms{1}{'creator'});
    $Rooms{1}{'name'} = 'beach' unless($Rooms{1}{'name'});
    $Rooms{1}{'desc'} = 'On the beach.' unless($Rooms{1}{'desc'});
    $Rooms{1}{'details'} = {} unless($Rooms{1}{'details'});

    debug(Dumper(\%Rooms));

}

sub load_details
{
    # Load Rooms from database
    # Parameter: RoomId
    my ($roomid) = @_;

    my $result = {};
    if($idb)
    {
	my $vals = $idb->getValues('RoomDetails', 'RoomId', $roomid,
				   'Name', 'Description');

	if(!$vals)
	{
	    debug("Error getting RoomDetails: $roomid " . $idb->getError() 
		  ."\n");
	}
	my $i = 0;
	while($i < @{$vals})
	{
	    $result->{$vals->[$i]} = $vals->[$i+1];
	    $i += 2;
	}
    }
    return $result;
}

sub look_local
{
    # Return the description of the current room.
    # Parameter: UserId
    my ($userid) = @_;

    my $roomid = $Users{$userid}{'room'};
    debug("look_local: $roomid\n");

    my $desc = $Rooms{$roomid}{'desc'} . "\n";
    
    my @users = grep { $Users{$_}{'state'} && 
	($Users{$_}{'room'} == $roomid)
		   } keys %Users;


    foreach $u (@users)
    {
	my $name = $Users{$u}{'title'};
	$name =~ s/\%N/ucfirst($Users{$u}{'user'})/eg;
	$desc .= "$name\n";
    }

    $Text::Wrap::columns = $Users{$userid}{'screenwidth'};
    $desc = wrap('', '', $desc);
    return {'output' => $desc };
}

sub examine_local
{
    # Return the description of the given detail/user.
    # Parameter: UserId, Name
    my ($userid, $name) = @_;

    my $roomid = $Users{$userid}{'room'};
    debug("examine_local: $roomid\n");

    my $uid = get_user($name);
    my $desc;
    if($uid)
    {
	if($Users{$userid}{'room'} == $Users{$uid}{'room'})
	{
	    $desc = $Users{$uid}{'desc'}
	}
    }
    elsif($Rooms{$roomid}{'details'}{lc($name)})
    {
	$desc = $Rooms{$roomid}{'details'}{lc($name)} . "\n";
    }
    if(!$desc)
    {
	return {'output' => "You can't see $name anywhere here."};
    }
    
    $Text::Wrap::columns = $Users{$userid}{'screenwidth'};
    $desc = wrap('', '', $desc);
    return {'output' => $desc };

}

sub create_room
{
    # Create a new room with the given name (length max 40 chars)
    # Parameter: UserId, Name
    my ($userid, $name) = @_;

    if(get_room($name))
    {
	return {'output' => "That room already exists."};
    }

    my $maxi = 0;
    foreach my $k (keys %Rooms)
    { 
	$maxi = $k if($maxi < $k); 
    }
    $maxi++;
    
    $Rooms{$maxi}{'name'} = $name;
    $Rooms{$maxi}{'desc'} = '';
    $Rooms{$maxi}{'details'} = {};
    $Rooms{$maxi}{'creator'} = $userid;
    $Rooms{$maxi}{'locked'} = 0;

    if($idb)
    {
	my $res = $idb->appendTable('Rooms', 
				['ID', 'Creator', 'Name'],
				[$maxi,
				 $Rooms{$maxi}{'creator'},
				 $Rooms{$maxi}{'name'}]);
	if(!defined($res))
	{
	    debug("Can't add room $Rooms{$maxi}{'name'}: " . 
		  $idb->getError() . "\n");
	}
    }
    return {'output' => "Created room $name."};
}

sub check_room
{
    # Check if room is still locked/occupied
    # Parameter: RoomId
    my ($roomid) = @_;

    if(grep { $_->{'room'} == $roomid } values %Users)
    {
	return 1;
    }
    $Rooms{$roomid}{'locked'} = 0;
    return 0;	
}

sub goto_room
{
    # Move user to another room
    # Parameter: UserId, Name
    my ($userid, $name) = @_;

    my $roomid = get_room($name);
    if(!$roomid)
    {
	return {'output' => "Room $name does not exist."};
    }
    if($Rooms{$roomid}{'locked'})
    {
	if(check_room($roomid))
	{
	    return {'output' => "Sorry, that room is locked."};
	}
    }

    # - check room we're leaving to see if we locked it..
    my $oldid = $Users{$userid}{'room'};
    if($Rooms{$oldid}{'locked'} && $Rooms{$oldid}{'creator'} == $userid)
    {
	$Rooms{$oldid}{'locked'} = 0;
	print_output($userid, {'output' => 
				   "Unlocking $Rooms{$oldid}{'name'}"});
    }
    enter_room($userid, $roomid);
    $Users{$userid}{'room'} = $roomid;
    leave_room($userid, $oldid);
    return look_local($userid);   
}

sub enter_room
{
    # A user has just entered a room, send a message to the people in the room.
    # Parameter: UserId, RoomId
    my ($userid, $roomid) = @_;

    my @users = grep { $Users{$_}{'state'} && 
			   $Users{$_}{'room'} == $roomid
		     } keys %Users;

    foreach $u (@users)
    {
	print_output($u, {'output' => ucfirst($Users{$userid}{'user'}) .
			      " enters the room."});
    }
}

sub leave_room
{
    # A user just left the room..
    # Parameter: UserId, RoomId
    my ($userid, $roomid) = @_;

    my @users = grep { $Users{$_}{'state'} &&
			   $Users{$_}{'room'} == $roomid
		     } keys %Users;

    foreach $u (@users)
    {
	print_output($u, {'output' => ucfirst($Users{$userid}{'user'}) .
			      " leaves the room."});
    }
    
}

sub describe_room 
{
    # Add a description to the room
    # Parameter: UserId, Line, Text
    my ($userid, $linenr, $text) = @_;

    my $roomid = $Users{$userid}{'room'};
    if($userid != 1 && $Rooms{$roomid}{'creator'} != $userid)
    {
	return {'output' => "Sorry, you didn't create that room."};
    }

    if(!$linenr)
    {
	$Rooms{$roomid}{'desc'} = $text;
    }
    else
    {
	$Text::Wrap::columns = $Users{$userid}{'screenwidth'};
	my $lines = wrap('','', $Rooms{$roomid}{'desc'});
	my @lines = split("\n", $lines);
	debug("describe_room: " . @lines . "\n");
	debug("describe_room: " . Dumper(\@lines));
	$lines[$linenr - 1] = $text;
	$Rooms{$roomid}{'desc'} = join("\n", @lines);
    }
    if($idb)
    {
	my $res = $idb->updateTable('Rooms', ['ID'], [$roomid], 
				['description'],
				[$Rooms{$roomid}{'desc'}]);
	if(!defined($res))
	{
	    debug("Can't set description for room $Rooms{$roomid}{'name'}: " . 
		  $idb->getError() . "\n");
	}
    }

    return look_local($userid);
}

sub lock_room
{
    # Lock the room we're standing in
    # Parameter: UserId
    my ($userid) = @_;

    my $roomid = $Users{$userid}{'room'};

    if($Rooms{$roomid}{'creator'} != $userid)
    {
	return {'output' => "Sorry, you didn't create that room."};
    }
    
    $Rooms{$roomid}{'locked'} = 1;
    return {'output' => "Room locked."};
}

sub unlock_room
{
    # UnLock the room we're standing in
    # Parameter: UserId
    my ($userid) = @_;

    my $roomid = $Users{$userid}{'room'};

    if($Rooms{$roomid}{'creator'} != $userid)
    {
	return {'output' => "Sorry, you didn't create that room."};
    }
    
    $Rooms{$roomid}{'locked'} = 0;
    return {'output' => "Room unlocked."};
}

sub get_room
{
    # Find the room with the given name
    # Parameter: Name
    my ($name) = @_;

    if(!$name)
    {
	return undef;
    }
    debug("get_room: $name\n");
    my ($roomid) = grep(lc($Rooms{$_}{'name'}) eq lc($name), keys(%Rooms));
    return $roomid ? $roomid : undef;
    
}

sub list_rooms
{
}

sub show_people
{
    # Show who is logged in, and where they are
    # Parameter: UserId
    my ($userid) = @_;

    my $result;
    $result->{'output'} = '';

    my $table = Text::FormatTable->new('l l');
    $table->head("Location", "Name");

    foreach my $u (keys %Users)
    {
	next if(!$Users{$u}{'state'});
	$table->row($Rooms{$Users{$u}{'room'}}{'name'},  
		    ucfirst($Users{$u}{'user'}));
    }

    $result->{'output'} .= $table->render(
					  $userid > 0 ? 
					  $Users{$userid}{'screenwidth'}-1
					  : 79);
    $result->{'type'} = 'cmd:who';
    return $result;
    
}

sub create_detail
{
    # Add a detail to the current room
    # Parameter: Name
    my ($userid, $name, $text) = @_;

    my $roomid = $Users{$userid}{'room'};
    if($userid !=1 && $Rooms{$roomid}{'creator'} != $userid)
    {
	return {'output' => "You didn't create this room."};
    }

    if($Rooms{$roomid}{'details'}{lc($name)})
    {
	return {'output' => "That detail exists already."};
    }

    $text = '' if(!$text);
    if(length($text) > 800)
    {
	return {'output' => "Too long! (Limit: 800 characters)."};	
    }
    $Rooms{$roomid}{'details'}{lc($name)} = $text;

    if($idb)
    {
	my $res = $idb->appendTable('RoomDetails', 
				['RoomId', 'Name', 'Description'],
				[$roomid,
				 lc($name),
				 $text]);
	if(!defined($res))
	{
	    debug("Can't add Detail $name: " . 
		  $idb->getError() . "\n");
	}
    }

    return {'output' => "Created detail $name."};
}

sub edit_item
{
    # Make a copy of the given item for editing
    # Room, Detail, Show, Save
    # Parameter: Type/Command, Name
    my ($userid, $command, $name) = @_;

    if($command eq 'forget')
    {
        if($Users{$userid}{'edit'} =~ /Mail/i)
        {
            $Users{$userid}{'mail'}{'create'} = 0;
            $Users{$userid}{'mail'} = {};
        }
        $Users{$userid}{'edit'} = undef;
        $Users{$userid}{'editing'} = undef;
# Check if mail, delete mail vars?
        return {'output' => "Ok, forgot that."};
    }

    if($command eq 'save')
    {
        if($Users{$userid}{'edit'} =~ /Mail subject/i)
        {
            $Users{$userid}{'mail'}{'subject'} = $Users{$userid}{'editing'};
            $Users{$userid}{'edit'} = 'Mail message';
            $Users{$userid}{'editing'} = '';
            return edit_item($userid, 'show');
        }
        elsif($Users{$userid}{'edit'} =~ /Mail message/i)
        {
            $Users{$userid}{'mail'}{'text'} = $Users{$userid}{'editing'};
            $Users{$userid}{'edit'} = undef;
            $Users{$userid}{'editing'} = undef;
            return mail_send($userid);
        }
        elsif($Users{$userid}{'edit'} && 
              $Users{$userid}{'edit'} =~ /^(\d+)\/(\S+)$/)
        {
            my $roomid = $1;
            my $detail = $2;
            my $newtext = $Users{$userid}{'editing'};
            if(!$newtext)
            {
                return {'output' => "Oops, nothing was being edited!"};
            }
            if($detail eq '0')
            {
                $Rooms{$roomid}{'desc'} = $newtext;
                if($idb)
                {
                    my $res = $idb->updateTable('Rooms', ['ID'], [$roomid], 
                                                ['description'],
                                                [$Rooms{$roomid}{'desc'}]);
                    if(!defined($res))
                    {
                        debug("Can't set description for room $Rooms{$roomid}{'name'}: " . 
                              $idb->getError() . "\n");
                    }
                }
            }
            else
            {
                $Rooms{$roomid}{'details'}{$detail} = $newtext;
                if($idb)
                {
                    my $res = $idb->updateTable('RoomDetails', 
                                                ['RoomId', 'Name'], 
                                                [$roomid, $detail], 
                                                ['description'],
                                                [$Rooms{$roomid}{'details'}{$detail}]);
                    if(!defined($res))
                    {
                        debug("Can't set description for room $Rooms{$roomid}{'details'}{$detail}: " . 
                              $idb->getError() . "\n");
                    }
                }
            }
            $Users{$userid}{'edit'} = undef;
            $Users{$userid}{'editing'} = undef;
            return {'output' => "Done."};
        }
        return {'output' => "You weren't editing a room or detail!"};
    }

    if($command eq 'show')
    {
        if($Users{$userid}{'edit'})
        {    
            my $result;
            if($Users{$userid}{'edit'} =~ /^(\d+)\/(\S+)$/)
            {
                my $roomid = $1;
                my $detail = $2;
                my $newtext = $Users{$userid}{'editing'};
                if(!$newtext)
                {
                    return {'output' => "Oops, nothing was being edited!"};
                }
                $Text::Wrap::columns = $Users{$userid}{'screenwidth'} - 6;
                my $desc = wrap('', '', $newtext);
                my @lines = split("\n", $desc);
                my $result = "Room: $Rooms{$roomid}{'name'}\n";
                $result .= "Detail: $detail\n" if($detail ne '0');
                foreach $l (1 .. @lines)
                {
                    $result .= sprintf("%02d ", $l) . $lines[$l - 1] . "\n";
                }
#		return {'output' => "$result"};
            }
            
            elsif($Users{$userid}{'edit'} =~ /Mail/i)
            {
                $Text::Wrap::columns = $Users{$userid}{'screenwidth'} - 6;
                my $desc = wrap('', '', $Users{$userid}{'editing'});
                my @lines = split("\n", $desc);
                $result = "$Users{$userid}{'edit'}\n";
                foreach $l (1 .. @lines)
                {
                    $result .= sprintf("%02d ", $l) . $lines[$l - 1] . "\n";
                }
            }
            return {'output' => "$result"};
        }
        return {'output' => "You weren't editing anything!"};
    }
    if($Users{$userid}{'edit'} && $Users{$userid}{'editing'})
    {
        return {'output' => "You are already editing. Type 'edit show' to see what."};
    }
    
    my $roomid = $Users{$userid}{'room'};
    if($userid != 1 && $Rooms{$roomid}{'creator'} != $userid )
    {
        return {'output' => "You can't do that here."};
    }
    
    if($command eq 'room')
    {
        $Users{$userid}{'edit'} = "$roomid/0";
        $Users{$userid}{'editing'} = $Rooms{$roomid}{'desc'};
        return edit_item($userid, 'show');
    }
    if($command eq 'detail' && $name && 
       defined($Rooms{$roomid}{'details'}{lc($name)}))
    {
        $Users{$userid}{'edit'} = "$roomid/$name";
        $Users{$userid}{'editing'} = $Rooms{$roomid}{'details'}{lc($name)};
        return edit_item($userid, 'show');
    }
    
    return {'output' => "Oops, error in edit routine!"};
}

sub edit_current
{
    # Change something about part of the currently edited item.
    # s -> s///, c-> replace line, i-> insert before line, a->append after line
    # d-> delete line
    # Parameter: Command, Text
    my ($userid, $line, $command, $text) = @_;

    if(!$Users{$userid}{'edit'} || !defined($Users{$userid}{'editing'}))
    {
	return {'output' => "You're not editing anything!"};
    }

    $Text::Wrap::columns = $Users{$userid}{'screenwidth'} - 6;
    my @lines = split("\n", wrap('', '', $Users{$userid}{'editing'}));

    $line = @lines if($line == 0);
    if($command eq 'd' && $line > 0)
    {
	splice(@lines, $line - 1, 1);
	$Users{$userid}{'editing'} = join("\n", @lines);
	return {'output' => "Done.", 'type' => 'info'};
    }
    if($command eq 'c' && $text && $line > 0)
    {
	$lines[$line - 1] = $text;
	$Users{$userid}{'editing'} = join("\n", @lines);
	return {'output' => "Done.", 'type' => 'info'};
    }
    if($command eq 'i' && $text && @lines)
    {
	return {'output' => "Can't do that.", 'type' => 'info'} if($line == 0);
	splice(@lines, $line - 1, 0, $text);
	$Users{$userid}{'editing'} = join("\n", @lines);
	return {'output' => "Done.", 'type' => 'info'};
    }
    if($command eq 'a' && $text)
    {
	splice(@lines, $line, 0, $text);
	$Users{$userid}{'editing'} = join("\n", @lines);
	return {'output' => "Done.", 'type' => 'info'};
    }
    if($command eq 's' && $text)
    {
	my $oldline = $lines[$line - 1];
	$text = "/$text/" if($text !~ m|/(.*)/|); 
	my $eval = "\$oldline =~ s$text";
	eval $eval;
	if($@)
	{
	    return {'output' => "Error: $@", 'type' => 'info'};
	}
	$lines[$line - 1] = $oldline;
	$Users{$userid}{'editing'} = join("\n", @lines);
	return {'output' => "Done.", 'type' => 'info'};
    }

    return {'output' => "Edit: Unknown or incorrect command."};
}

###############################################################################
# Mail

sub load_maildispatch
{
    # Dispatch table for mail commands
    # Parameter: None

    $MailD{'list'} = \&mail_list;
    $MailD{'read'} = \&mail_read;
    $MailD{'delete'} = \&mail_delete;
    $MailD{'forward'} = \&mail_forward;
}

sub mail_start
{
    # Start writing a mail
    # Parameter: UserId, To, Mud (Optional)
    my ($userid, $command, @params) = @_;

    # $Users{$userid}{'mail'}{'create'} = 1;
    # $Users{$userid}{'mail'}{'subject'} = '';
    # $Users{$userid}{'mail'}{'to'} = '';
    # $Users{$userid}{'mail'}{'tomud'} = '';
    # $Users{$userid}{'mail'}{'text'} = '';
    # edit show, save etc. (save to ?)

    my @mailcommands = ('write', 'read', 'delete', 'list');
    if(!grep(/$command/, @mailcommands))
    {
        return {'output' => "Command 'mail $command', not found"};
    }

    debug("mail_start: $command.\n");
    if($command ne 'write')
    {
        return $MailD{$command}->($userid, @params);
    }

    my ($to, $mud) = @params;

    if($Users{$userid}{'mail'} && $Users{$userid}{'mail'}{'create'})
    {
        return {'output' => "You are already writing a mail. Use 'edit forget' to throw it away."};
    }

    my $user = get_user($to) if(!$mud);
    if(!$user && !$mud)
    {
        return {'output' => "No such user: $to"};
    }

    $Users{$userid}{'mail'}{'create'} = 1;
    $Users{$userid}{'mail'}{'subject'} = '';
    $Users{$userid}{'mail'}{'text'} = '';    
    $Users{$userid}{'mail'}{'to'} = $user || $to;
    $Users{$userid}{'mail'}{'tomud'} = $mud;

    $Users{$userid}{'edit'} = 'Mail subject';
    $Users{$userid}{'editing'} = '';

    return edit_item($userid, 'show');
}

sub mail_send
{
    # Send the completed mail.
    # Parameter: UserId
    my ($userid) = @_;

    if(!$Users{$userid}{'mail'}{'subject'} || !$Users{$userid}{'mail'}{'text'})
    {
        $Users{$userid}{'mail'} = {};
        return {'output' => "You didn't write anything!\n"};
    }

    if(!$Users{$userid}{'mail'}{'tomud'})
    {
        # Send locally
        # Check size of mailbox?
        if($idb)
        {
            my $res = $idb->appendTable('Mail', 
                                        ['user_id', 'MailFrom', 'Subject', 
                                         'Date', 'Text'], 
                                        [$Users{$userid}{'mail'}{'to'},
                                         $userid,
                                         $Users{$userid}{'mail'}{'subject'},
                                         time(),
                                         $Users{$userid}{'mail'}{'text'}]); 
#             my $res = $idb->updateTable('Mail', 
#                                         ['user_id'],
#                                         [$userid],
#                                         ['user_id', 'MailFrom', 'Subject', 
#                                          'Date', 'Text'], 
#                                         [$Users{$userid}{'mail'}{'to'},
#                                          $userid,
#                                          $Users{$userid}{'mail'}{'subject'},
#                                          time(),
#                                          $Users{$userid}{'mail'}{'text'}]); 
            if(!defined($res))
            {
                debug("Can't send mail from $userid: " . 
                      $idb->getError() . "\n");
                return {'output' => "Can't send Mail."};
            }
        }
        
        print_output($Users{$userid}{'mail'}{'to'}, 
                     {'output' => "You have new mail."});
        $Users{$userid}{'mail'} = {};

        return {'output' => "Sent mail."};
    }

    $i2->send($Users{$userid}{'user'}, 
              $Users{$userid}{'mail'}{'tomud'},
              'mail',
              $Users{$userid}{'mail'}{'to'},
              $Users{$userid}{'mail'}{'subject'},
              $Users{$userid}{'mail'}{'text'});

    my $recip = $Users{$userid}{'mail'}{'to'};
    $Users{$userid}{'mail'} = {};

    return {'output' => "Sent mail to $recip."};
	
}

sub mail_deliver
{
    # Deliver mail from another mud internally
    # Parameter: Request
    my (%request) = @_;

    my $userid = get_user($request{'rcpnt'});

    if($idb)
    {
        my $res = $idb->appendTable('Mail', 
                                    ['user_id', 'MailFrom', 'Subject', 
                                     'Date', 'Text'], 
                                    [$userid,
                                     $request{'udpm_writer'} . '@' .
                                       $request{'name'},
                                     $request{'udpm_subject'},
                                     time(),
                                     $request{'data'}
                                     ]); 
#         my $res = $idb->appendTable('Mail', 
#                                     ['user_id'],
#                                     [$userid],
#                                     ['user_id', 'MailFrom', 'Subject', 
#                                      'Date', 'Text'], 
#                                     [$userid,
#                                      $request{'udpm_writer'} . '@' .
#                                        $request{'name'},
#                                      $request{'udpm_subject'},
#                                      time(),
#                                      $request{'data'}
#                                      ]); 
        if(!defined($res))
        {
            debug("Can't deliver mail to $userid: " . 
                  $idb->getError() . "\n");
            return 0;
        }

        print_output($userid, {'output' => "You have new mail."});
        return 1;
    }

    return 0;
}

sub check_mail
{
    # Check if a given user has new mail (since last logout)
    # Parameter: UserId
    my ($userid) = @_;

    if($idb)
    {
	my $mails = $idb->getValues('Mail', 'user_id', $userid,
				    'Date');
	debug("check_mail: $userid: " . Dumper($mails));

	if(!$mails)
	{
	    return {'output' => 'No new mail.'};
	}
	my @newmails = grep { $_ > $Users{$userid}->{'logout'} } @$mails;
	if(!@newmails)
	{
	    return {'output' => 'No new mail.'};
	}
	return {'output' => 'You have ' .  @newmails . ' new mails!'};
    }

    return {'output' => 'No new mail.'};

}

sub mail_list
{
    # List current mails
    # Parameter: UserId
    my ($userid) = @_;

    if($idb)
    {
        my $mails = $idb->getValues('Mail', 'user_id', $userid, 
                                    'Date', 'MailFrom', 'Subject');
        my $ind = 0;
        my %maillist = ();
        while ($ind < @$mails)
        {
            $maillist{$mails->[$ind]} = [$mails->[$ind+1], $mails->[$ind+2]];
            $ind += 3;
        }

        debug(Dumper($mails) . "\n" . Dumper(\%maillist));
        my $result = '';
        $ind = 0;
        foreach my $key (sort keys %maillist)
        {
            $ind++;
            # Format into colums!
            $maillist{$key}[0] = get_user($1) 
                if($maillist{$key}[0] =~ /^(\d+)$/);
            
            $result .= $ind . ":" . localtime($key) . " = " . 
                $maillist{$key}[0] . " " . $maillist{$key}[1] . "\n";
        }
        return {'output' => $result};
    }

    return {'output' => 'No Database available.'};
}

sub mail_read
{
    # Show a mail in the users mailbox
    # Parameter: UserId, MailId
    my ($userid, $mailid) = @_;

    if($idb)
    {
        my $mails = $idb->getValues('Mail', 'user_id', $userid, 
                                    'Date', 'MailFrom', 'Subject', 'Text');
        # Sort mails by date!
        my $ind = 0;
        my %maillist = ();
        while ($ind < @$mails)
        {
            $maillist{$mails->[$ind]} = {'from' => $mails->[$ind+1], 
                                         'subject' => $mails->[$ind+2],
                                         'text' => $mails->[$ind+3] };
            $ind += 4;
        }

        my $result = '';
        $ind = 0;
        foreach my $key (sort keys %maillist)
        {
            $ind++;
            next if($ind != $mailid);

            $result .= "Date: " . localtime($key) . "\n" .
              "From: " . ($maillist{$key}{'from'} =~ /^(\d+)$/ ?
                          get_user($1) : $maillist{$key}{'from'}) . "\n" .
              "Subject: " . $maillist{$key}{'subject'} . "\n" . "\n" .
              $maillist{$key}{'text'};
            return {'output' => $result};
        }
        return {'output' => "Can't find the $mailid mail, sorry." };
    }
    return {'output' => 'No Database available.'};
}

sub mail_delete
{
}

sub mail_forward
{
}

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

sub load_texts
{
    %Texts = (
	      'welcome' => "Welcome to PerlMudv2!\r\nWho are you?:",
	      'pprompt' => "Password:",
	      'tell'    => "X tells you: Y",
	      'told'    => "X told you: Y")
	    ;
}

sub load_help
{
    # Create
}

sub show_help
{
    # Show a list of all syntaxes, or help on a particular command
    # UserId, Command
    my ($userid, $help) = @_;
    debug("UserId: $userid\n");

    my @help;
    $help[0] =  "PerlMud Commands";
    $help[1] = '-' x 79 . "";

    if(!$help)
    {
	my @list = sort keys %Commands;
	$colwidth = length((sort {length($b) <=> length($a)} @list)[0] ) +1;
	$ncol = int( $Users{$userid}{'screenwidth'}/$colwidth );
	$nrow = int( scalar(@list) / $ncol );
	$nrow++ if ( scalar(@list) % $ncol );
	$fmt = "%-${colwidth}s";

	foreach my $r ( 0 .. $nrow-1 ) 
	{
	    my $ind = @help;
	    $help[$ind] = '';
	    foreach my $c ( 0 .. $ncol-1 ) 
	    {
		my $i = $c * $nrow + $r;
#		debug("Formatting: $i, " . $list[$i] . "\n");
		$help[$ind] .= sprintf( $fmt, $list[$i] ) if($list[$i]);
	    }
#	    print "\n";
	}
	$help[scalar(@help)] = '-' x 79 . "";
	$help[scalar(@help)] = "Type 'help <command>' to get further help.";
	$help[scalar(@help)] = '-' x 79 . "";


    }
    elsif($Commands{lc($help)})
    {

	foreach my $c (@{$Commands{lc($help)}})
	{
	    splice(@help, @help, 0, split("\n", $c->{'help'}));
	}
    }
    else
    {
	return {'output' => "Unknown help topic!"};
    }

    do_more($userid, @help);
}

###############################################################################
# Telnet Opts

sub ignore_options
{
    # remove all telnet options from incoming text
    # Parameter: Text
    my ($text) = @_;

    my $chIAC = chr(255);
    my $chDONT = chr(254);
    my $chDO = chr(253);
    my $chWONT = chr(252);
    my $chWILL = chr(251);
    my $chSB = chr(250);
    my $chSE = chr(240);
    my $chSEND = chr(1);
    my $chIS = chr(0);
    my $chEOR = chr(239);
    my $pos = -1;
    while(($pos = index($text, $chIAC, $pos)) > -1)
    {
	my $nextchar = substr($text, $pos + 1, 1);
	if(!length($nextchar))
	{
	    last;
	}
	if($nextchar eq $chIAC)
	{
	    substr($text, $pos, 1) = '';
	    $pos++;
	}
	elsif($nextchar =~ /($chDONT|$chDO|$chWONT|$chWILL)/)
	{
	    substr($text, $pos, 3) = '';
	}
	elsif($nextchar eq $chSB)
	{
	    my $endpos = index($text, $chSE, $pos);
	    substr($text, $pos, $endpos - $pos + 1) = '';
	}
	elsif($nextchar eq $chEOR)
	{
	    substr($text, $pos, 2) = '';
	}
	else
	{
	    substr($text, $pos, 2) = '';
	}
    }
    return $text;
}

sub convert_backspace
{
    # Windows Telnet sends backspace + delete chars extra, parse correct text
    # (Only if no linemode??)
    # Parameter: UserId, Text
    my ($text) = @_;

    my $pos = index($text, chr(8));
    while($pos > 0)
    {
	substr($text, $pos - 1, 2) = '';
	$pos = index($text, chr(8));
    }

    $pos = index($text, chr(127));
    while($pos >= 0)
    {
	substr($text, $pos, 2) = '';
	$pos = index($text, chr(127));
    }

    return $text;
}

###############################################################################
# Utils

sub show_size
{
    # Show how much memory a particular variable is using
    # Parameter: UserId, Variable
    my ($userid, $var) = @_;

    my $result;
    my $ans = '';

    if($var =~ /^\%main::/)
    {
	$result->{'output'} = "You dont wanna do that!";
	return $result;
    }

    if($var eq 'all')
    {
	foreach my $k (keys %main::)
	{
	    next if($k =~ /main/);
	    my $eval = "\$ans .= Dumper(\\$k) . \"\\n\" if($k)";
	    eval $eval;
	}
    }
    else
    {
	my $eval = "\$ans = 'Size:' . size(\\$var) . ' Total_Size:' . 
                total_size(\\$var) if($var)";
	eval $eval;
    }
    if($@)
    {
	$result->{'output'} = "Eval failed: $@";
	return $result;
    }
    $result->{'output'} = "Size of $var: $ans";
    return $result;
    
}

sub show_dump
{
    # Dump the contents of a variable to a users output.
    # Parameter: UserId, Variable
    my ($userid, $var) = @_;

    my $result;
    my $ans = '';

    if($var =~ /^\%main::/)
    {
	$result->{'output'} = "You dont wanna do that!";
	return $result;
    }

    if($var eq 'all')
    {
	foreach my $k (keys %main::)
	{
	    next if($k =~ /main/);
	    my $eval = "\$ans .= Dumper(\\$var) . \"\\n\" if($var)";
	    eval $eval;
	}
    }
    else
    {
	my $eval = "\$ans .= Dumper(\\$var) . \"\\n\" if($var)";
	eval $eval;
    }
    if($@)
    {
	$result->{'output'} = "Eval failed: $@";
	return $result;
    }
    $ans =~ s/'password' => '(.*?)'/'password' => '<censored>'/sg if($ans);
    $result->{'output'} = "Contents of $var: $ans";
    return $result;
    
}

sub poke_value
{
    # Change an inner variable, dangerous!
    # Parameter: UserId, Variable, Value
    my ($userid, $var, $value) = @_;

    if($userid != 1)
    {
	debug($Users{$userid}{'user'} . " tried to change the value of: $var\n");
	return {'output' => "Sorry, only Castaway is allowed to do that!"};
    }

    debug("Castaway: Changing value of $var to $value\n");

    my $temp;
    eval "\$temp = $var";
#    if(!$temp || $@)
#    {
#	return {'output' => "Error getting current value!"};
#    }
    debug("poke_value: previous value: $temp\n");

    my $eval = "$var = $value";
    eval $eval;
    if($@)
    {
	$result->{'output'} = "Eval failed: $@";
	return $result;
    }

    return {'output' => "$var set to $value, was $temp"};
}

sub show_hexvalue
{
    # Show the hexidecimal values of a text argument (sprintf %x ..)
    # Parameter: UserId, Text
    my ($userid, $text) = @_;

    my $len = length($text);
    if($len > 20)
    {
	return {'output' => 'Try that with something shorter than 20 characters'};
    }

    my $pattern = '%x ' x $len;
    
    return {'output' => sprintf($pattern, map {ord} split(//, $text))};
}

sub show_reduced
{
    # Show the basic form of a german word
    # Parameter: UserId, Word
    my ($userid, $word) = @_;
    
    return({'output' => 'Try that with something shorter than 50 characters'})
        if(length($word) > 50);
    
    return({'output' => Text::German::reduce($word)});
}

sub do_sql
{
    # Execute an SQL query and return the results
    # Parameter: UserId, Query
    my ($userid, $query) = @_;

    if(!$idb)
    {
	return {'output' => "No database available."};
    }

    if(($query !~ /^SELECT/i && $userid != 1) || 
       ($query =~ /users/i && $userid != 1))
    {
	return {'output' => "Sorry, selects only for non-admins!."};
    }

    # Cheat, get internal DB handle.
    my $dbh = $idb->{'databasehandle'};

    if($query =~ /^SELECT/i)
    {
	my $stm = $dbh->prepare($query);
	my $res = $stm->execute();
	if(!$res)
	{
	    return {'output' => "Error! . " . $dbh->errstr()};
	}
	return {'output' => Dumper($stm->fetchall_arrayref())};
    }
    my $res = $dbh->do($query);
    if(!$res)
    {
	return {'output' => "Error! . " . $dbh->errstr()};
    }
    return {'output' => Dumper($res)};

}

#####
# Is $item contained in the given list?
#
sub is_member
{
    ($item, @liste) = @_;
#    debug("Item: $item List: @liste\n");

    if(!$item || !@liste)
    {
        return -1;
    }
    for($i = 0; $i<@liste; $i++)
    {
        if ($liste[$i] eq $item)
        {
            return $i;
        }
    }
    return -1;
}


#####
# Debug ausgaben
#
sub debug
{
    $DEBUG = 'log';
    # Parameter: None.
    if ($DEBUG eq 'on')
    {
	print STDOUT "$_[0]";
    } elsif ($DEBUG eq 'log')
    {
	# Append text to debug log
	my $filename = '/home/castaway/perl/log/debug_i2_connect.log';
	
	open(DEBUGFILE, ">>", $filename) or die "Can't open $filename: $!\n";
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
	    localtime(time);
	my $time = sprintf("%02d.%02d %02d:%02d:%02d ", 
			   $mday,$mon + 1,$hour,$min,$sec) . $_[0];
	print DEBUGFILE "$time";
        close(DEBUGFILE);
    }
}

## Welcome to PerlMud!
## Who are you? <name input>
## check name length < 10 ?
# user maximum! (10?)
## create in user-table if not already present / load settings?
## change email, change title, level, plan, .. ?
## own history, own colours, own ignoredevents .. 
## channel output to all
# local tell/chat channel?
## tell (\S+) (.*) - tell_user
## User hash -> socket, settings
## 'help', 'help <command>'
# change language ??
# ??
# list channels
## list events ?
## list ignores
## 'converse' mode (tell, say, channel)
## remove double-entries (one pro user) in channel histories
# 
# telnet protocol
# add FF in outgoing text before an FF
# man perlport /Newlines ! ($CRLF)
## Commands - ignore! levents! cmd:say
## delete coloured events?
## delete aliases from DB
## add 'away' to users table
# atconnect alias? (command to execute upon login) (auto-*)
# .. 
#
## $Users{$userid}{'room'} = room number..
## $Rooms{$number}{'desc'} = .. 
## $Rooms{$number}{'name'} = 'room'
## 'goto <roomname>' (user name?)
## 'create room <name>' ..
## 'lock room' (dont let anyone else in, unlock when 'locker' leaves!)
# As a Hotel? (with beach etc.. ?)
# exits?? Details??
# chat channel? ;)
## callback fuer channel-list/channel-hist anfragen? (list alle die den kanal nicht ignorieren, etc)
## edit room <name>, edit detail <name>
## sets 'edit' variable to RoomId/DetailId
## Where Detail0 is the roomdesc
## another 'edit' prompts that something is being edited already.. ?
## in edit mode possible commands:
## e <line> <command> (eval??) - gets the line and applies the operation to it
## e save -> save edited object
# delete room/detail
#
# Loading rooms - load rooms as needed from the DB, with a timeout, which 
# removes them from memory when not entered for a while?
# 
## 'who' ('people') command with RoomName where people are..
# Ausgaenge..
# 'force' ?
# add 'commit' method/option?
# aliases: a text starting with ~ will not be parsed for aliases !
# prevent auto-aliases from containing 'quit'?
#
# Doremi says: wenn man z.b. tippt "history castaway cmd:tell" gibt es nur die mit castaway aus. das castaway argument kann es ja von dem cmd:tell dadurch unterscheiden, dass kein : drin ist
#
# change password
# return error when user not found? (call back?)
#
# Add mud <IP> <UDPPort> ?
#
# prefix command: add a ! escape to use other commands while in prefix mode?
#
## Text::Template strings for return formats!
# Callback a function to format for each user??
## Table: Templates:
## Name, Value
## 'channel', 
##'[{ucfirst($channel)} {ucfirst($snd)}@{$name}{
## (defined($emote) ? (($emote eq "2" ? "s" : "") . $data . "] ") : "]" . $data}"
## 'tell:adverb',
##'{ucfirst($snd)}@{$name} tells you {$data =~ /\*(\w+)\*\s(.*)/ ? $1 . ": " . $2 : ": " . $data}'
## 'tell:emote',
##"{$data =~ /\*(.*)\*/s ? ucfirst($snd) . '@' . $name $1}"
## 'tell', 
##"{ucfirst($snd)}@{$name} tells you: {$data}"
## Callbacks?

#Name,Value
#'tell','{ucfirst($snd)}@{$name} tells you: {$data}'
#'tell:emote','{$data =~ /\*(.*)\*/s ? ucfirst($snd) . "\@$name $1" : ""}'
#'tell:adverb','{ucfirst($snd)}@{$name} tells you {$data =~ /\*(\w+)\*\s(.*)/ ? $1 . q(: ) . $2 : q(: ) . $data}'
#'channel:emote','[{ucfirst($channel)} {ucfirst($snd)}@{$name}{(defined($emote) && $emote eq "2" ? "s " : " ") . $data . "]"}'
#'channel', '[{ucfirst($channel)} {ucfirst($snd)}@{$name}] {$data}'

#Use of uninitialized value in substitution (s///) at perlmudv2.perl line 178, <GEN1130> line 1.
#Use of uninitialized value in length at perlmudv2.perl line 235, <GEN1130> line 1.
#Use of uninitialized value in index at perlmudv2.perl line 3123, <GEN1130> line 1.
#Use of uninitialized value in substitution (s///) at perlmudv2.perl line 178, <GEN1130> line 1.
#Use of uninitialized value in length at perlmudv2.perl line 235, <GEN1130> line 1.
#[Perlmonks Diotalevi@PerlMonks] I suppose you could say <code>sub froof { map substr($_[0], $-[$_], $+[$_] - $-[$_]), grep defined$-[$_]) and defined($+[$_]), 1 .. $#+;   }</code>. That takes your match input and fetches all the bits from it.
#[Perlmonks Diotalevi@PerlMonks] You'd then say <code>$floo =~ /(moo)(cow)/; @moo = froof( $floo )</code>. But then why isn't <code>@moo = $floo =~ /.../</code> good enough? Same effect (I think), less code.

#[graff]
## emulation of "ls" to demonstrate multi-column text output

#$stty = `stty -a`;
#($swidth) = ($stty =~ /columns (\d+)/); # get screen width (on unix)

#@list = `ls -1`;  # get a list of text items (another unix command)
#chomp @list;

#$colwidth = length((sort {length($b) <=> length($a)} @list)[0] ) +1;
#$ncol = int( $swidth/$colwidth );
#$nrow = int( scalar(@list) / $ncol );
#$nrow++ if ( scalar(@list) % $ncol );
#$fmt = "%-${colwidth}s";

#foreach my $r ( 0 .. $nrow-1 ) {
#    foreach my $c ( 0 .. $ncol-1 ) {
#	my $i = $c * $nrow + $r;
#	printf( $fmt, $list[$i] );
#    }
#    print "\n";
#}

#
# Format output from sql select in columns?
#
# cpan://Safe!! (dump)
#
# Auto ignore (ignore all new channels)
# Echo off (no 'You typed: .. ')
## Auto_Away - Sets an away message, and turns off the message as soon as
# something is typed again.. 
#
#10.07 12:04:29 Doremi says: es gibt noch kein automatisch-space-vor-dem-$-wegkuerzenden parameter, wenn der parameter leer ist, oder?
#10.07 12:05:20 You say: heh?
#10.07 12:06:09 Doremi says: naja, mein alias heisst "grins emote grinst $*." ... und wenn ich den parameter weglasse, hab ich ein haessliches space vor dem punkt
# 10.07 12:10:42 Doremi says: oder wenn dir solche space-magic nicht behagt, wie waere es mit nem parameter ($+ oder so), der _alles_ nach dem alias-namen frisst, also auch das oder die spaces, falls vorhanden. also beispielsweise ich mach "alias grins emote grinst$+." und dann tippe ich "grins" -> "emote grinst." oder "grins  dumm" -> "emote grinst  dumm."
#
# Remove, add muds from list
# Auto clean, muds with same IP/Ports ?