#!/usr/bin/perl

use warnings;
use strict;
use POE qw(Component::Server::TCP);

my %commands = (
	REG => "",
	UNREG => "",
);

POE::Component::Server::TCP->new(
	Port => 3009,
	ClientInput => \&client_input,
	ClientDisconnected => \&client_disconnect,
);

POE::Kernel->run();
exit;

sub client_input {
	my ( $heap, $input ) = @_[ HEAP, ARG0 ];
	print "Received: $input";
	#$input =~ s/ *//; # Remove leading spaces.
	if ( $input =~ /^REG ([^ \t]*)/ ) {
		if ($commands{$1}) {
			$heap->{client}->put("ERR $1 already registered.");
			print " - ERR already registered.\n";
		} else {
			$commands{$1} = $heap->{client};
			push @{$heap->{commands}}, $1;
		}
	} elsif ( $input =~ /^REG / ) {
		$heap->{client}->put("ERR Bad syntax.");
		print " - ERR bad syntax.\n"
	} elsif ( $input =~ /^UNREG ([^ \t]*)/ ) {
		if ($commands{$1}) {
			if ($heap->{client} == $commands{$1}) {
				delete $commands{$1};
				print " - command unregistered.\n";
			} else {
				$heap->{client}->put("ERR Cannot unregister other modules' commands");
				print " - ERR Wrong module.\n";
			}
		} else {
			$heap->{client}->put("ERR not registered.");
			print " - ERR No such command.\n";
		}
	} elsif ( $input =~ /^UNREG /) {
		$heap->{client}->put("ERR Bad Syntax");
		print " - ERR bad syntax.\n";
	} elsif ( $input =~ /^([^ \t]*)/ ) {
		if ($commands{$1}) {
			$commands{$1}->put($input);
			print " - sent to $1.\n"
		} else {
			$heap->{client}->put("ERR No such command.");
		}
	} else {
		$heap->{client}->put("ERR Leading spaces?");
		print " - ERR leading spaces?\n";
	}
}

sub client_disconnect {
	my $heap = $_[ HEAP ];

	for my $command (@{$heap->{commands}}) {
		delete $commands{$command};
	}
}