# dAmnBot.pm - dAmn bot framework.
# Copyright © 2007 Kalle Räisänen.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

package dAmnBot;

use strict;
use warnings;

use IO::Socket::INET;
use POE;
use POE::Component::Client::TCP;
use Carp;
use Data::Dumper;

our $VERSION = '0.4.3';


# ============================================================================
# dAmnBot->new(\%config);
#		create new dAmnBot object.
# ============================================================================

sub new
{
	my $package = shift;
	my $cfg     = shift;
	my $self    = bless {}, $package;

	$self->{config} = {
		debug => 0,
		trace => 0,
		dAmn => {
			username => '',
			password => '',
			channels => ['', ''],
			command_prefix => '!',
			handlers => {
				dAmnServer => \&handle_dAmnServer,
				login      => \&handle_login,
				join       => \&handle_misc,
				part       => \&handle_misc,
				property => {
					members     => \&handle_members,
					privclasses => \&handle_privclasses,
					title       => \&handle_title,
					topic       => \&handle_topic,
				},
				recv  => {
					msg         => \&handle_msg,
					action      => \&handle_msg,
					join        => \&handle_recv_join,
					part        => \&handle_recv_part,
					privchg     => \&handle_privchg,
					kicked      => \&handle_kick,
				},
				send       => \&handle_misc,
				ping       => \&handle_ping,
				other      => \&handle_misc,
				bot        => {
#					xyzzy      => sub {
#						my ($self, $ch) = @_;
#						$self->damn_send($ch, "Nothing happens.");
#					}
				},
			},
			tablumps => {
				emote  => '{0}',
				link   => '<{0}>',
				img    => '<{cmd}:{0}>',
				dev    => '<http://{1}.deviantart.com/> ({0}{1})',
				thumb  => '<http://www.deviantart.com/view/{0}/> (\'{1}\' by {2})',
				avatar => '<{0}>',
				br     => "\n\t",
			},
		},
		server => {
			host => 'chat.deviantart.com',
			port => 3900,
		},
	};


	$self->{config} = $self->_parse_config($cfg, $self->{config});
	$self->{ci}     = {};

	my $poe_cfg  = $self->{config}->{server};
	my $damn_cfg = $self->{config}->{dAmn};

	if(length $damn_cfg->{username} && length $damn_cfg->{password}) {
		if(! $self->_get_authtoken($damn_cfg->{username}, $damn_cfg->{password})) {
			croak "Couldn't get authtoken!";
		}
	} else {
		croak "Missing password or username!";
	}


	POE::Component::Client::TCP->new(
		RemoteAddress => $poe_cfg->{host},
		RemotePort    => $poe_cfg->{port},
		Connected     => sub {
			$self->handle_connect(@_);
		},
		Disconnected  => sub {
			$self->handle_disconnect(@_);
		},
		ServerInput   => sub {
			$self->handle_input(@_);
		},
		Filter        => [ "POE::Filter::Line", Literal => "\000" ],
		SessionParams => [
			options => { 
				debug => $self->{config}->{debug},
				trace => $self->{config}->{trace},
			} 
		],
	);

	POE::Kernel->run();

	return $self;
}

# ============================================================================
# dAmnBot->_parse_config(\%config, \%default_config);
#		Recursively parse config hash(ref): replacing values in $default_config
#		with ones from $config.
# ============================================================================

sub _parse_config
{
	my ($self, $cfg, $def_cfg) = @_;
	my $config = $def_cfg;

	for my $k (keys %{$cfg}) {
		if(ref $cfg->{$k} eq 'HASH') {
			$config->{$k} = $self->_parse_config($cfg->{$k}, $config->{$k});
		} else {
			$config->{$k} = $cfg->{$k};
		}
	}

	return $config;
}


# ============================================================================
# dAmnBot->_debug($str, ...) and dAmnBot->_trace($str, ...)
#		Output strings if {debug,trace} is active.
# ============================================================================

sub _debug
{
	my $self = shift;
	return unless($self->{config}->{debug});

	for my $arg (@_) {
		print $arg;
	}
}

sub _trace
{
	my $self = shift;
	return unless($self->{config}->{trace});

	$self->_debug(@_) if(@_);
}

# ============================================================================
# dAmnBot->handle_connect, ->handle_disconnect, ->handle_input
#		Handlers for POE events.
# ============================================================================

sub handle_connect
{
	my $self = shift;
	my ($kernel, $heap) = @_[KERNEL, HEAP];
	my $user = $self->{config}->{dAmn}->{username};

	$self->_debug(sprintf("Connected to %s\n", $self->{config}->{server}->{host}));

	$heap->{server}->put("dAmnClient 0.2\nagent=$user\nmisc=$user\n\000");
}

sub handle_disconnect
{
	my $self = shift;
	$self->_debug(sprintf("Disconnected from %s\n", $self->{config}->{server}->{host}));
}

sub handle_input
{
	my $self = shift;
	my ($heap, $input) = @_[HEAP, ARG0];

	$self->{heap} = $heap;

	$self->_debug("Got packet: ", (join('|', split(/\n/, $input))), "\n");

	my $cfg       = $self->{config}->{dAmn};
	my $callbacks = $cfg->{handlers};

	my %p = $self->_parse_packet($input);


	if($p{cmd} eq 'dAmnServer') {
		$callbacks->{dAmnServer}->($self, \%p);
	} elsif($p{cmd} eq 'login') {
		$callbacks->{login}->($self, \%p);
	} elsif($p{cmd} eq 'join') {
		my $chan = [];
		if($p{param} =~ /(p?chat):(.*)/) {
			$chan = [$2, $1];
		}
		if($p{arg} =~ /e=(.*)/) {
			my $e = $1;
			if($e ne 'ok') {
				croak "/join " . $chan->[0] . " failed! ($e)";
			}
			$self->add_channel($chan);
			$callbacks->{join}->($self, \%p, $chan->[0]);
		} else {
			croak "#" . $chan->[0] .": Got invalid join from dAmnServer!";
		}
	} elsif($p{cmd} eq 'ping') {
		$callbacks->{ping}->($self, \%p);
	} elsif($p{cmd} eq 'property') {
		my $chan = [];
		if($p{param} =~ /(p?chat):(.*)/) {
			$chan = [$2, $1];
		}
		if($p{arg} eq 'title' || $p{arg} eq 'topic') {
			my $tt = $p{body}->[3];
			$callbacks->{property}->{$p{arg}}->($self, \%p, $chan->[0], $tt);
		} elsif($p{arg} =~ 'p=(privclasses|members)') {
			$callbacks->{property}->{$1}->($self, \%p, $chan->[0]);
		}
	} elsif($p{cmd} eq 'recv') {
		my ($subcmd, $targ) = split / /, $p{body}->[0];
		my $chan = [];
		if($p{param} =~ /(p?chat):(.*)/) {
			$chan = [$2, $1];
		}

		if($subcmd eq 'msg') {
			my (undef, $nick, $msg) = 
				(split(/=/, $p{body}->[1]), $p{body}->[3]);

			my $prefix = $self->{config}->{dAmn}->{command_prefix};

			if(($nick ne $self->{config}->{dAmn}->{username})
			   and ($msg =~ /^$prefix(.*)/)) {
				my $c = $1;
				my @args = split(/ /, $c);
				if(@args) {
					$c = shift @args;
					if(exists $callbacks->{bot}->{$c}) {
						$callbacks->{bot}->{$c}->($self, $chan->[0], $nick, $c, @args);
					} elsif(exists $callbacks->{bot}->{'_'}) {
						$callbacks->{bot}->{'_'}->($self, $chan->[0], $nick, $c, @args);
					}
				}
			} else {
				$callbacks->{recv}->{msg}->($self, \%p, $chan->[0], $targ);
			}
		} elsif(exists $callbacks->{recv}->{$subcmd}) {
			$callbacks->{recv}->{$subcmd}->($self, \%p, $chan->[0], $targ);
		}
	} else {
		my $chan = ['', ''];
		if($p{param} =~ /(p?chat):(.*)/) {
			$chan = [$2, $1];
		}
		$callbacks->{other}->($self, \%p, $chan->[0]);
	}
}

# ============================================================================
# Property handling methods.
# ============================================================================

sub add_channel
{
	my ($self, $chan) = @_;
	my @channels = @{$self->{channels}};

	push @channels, $chan->[1];

	$self->{channels} = \@channels;
}

sub authtoken
{
	my ($self) = @_;
	return (exists $self->{authtoken} ? $self->{authtoken} : undef);
}

sub channelinfo
{
	my ($self, $ch) = @_;

	$self->{ci}->{$ch} = {} unless(exists $self->{ci}->{$ch});

	return $self->{ci}->{$ch};
}

sub channels
{
	my ($self) = @_;

	if(!exists $self->{channels}) {
		$self->{channels} = $self->{config}->{dAmn}->{channels};
	}	

	return $self->{channels};
}

sub members
{
	my ($self, $ch) = @_;
	my $ci = $self->channelinfo($ch);
	$ci->{members} = {} unless(exists $ci->{members});

	return $ci->{members};
}

sub password
{
	my ($self) = @_;
	return $self->{config}->{dAmn}->{password};
}

sub privclasses
{
	my ($self, $ch) = @_;
	my $ci = $self->channelinfo($ch);
	$ci->{pc} = {} unless(exists $ci->{pc});

	return $ci->{pc};
}

sub title
{
	my ($self, $ch) = @_;

	return $self->channelinfo($ch)->{title};
}

sub topic
{
	my ($self, $ch) = @_;

	return $self->channelinfo($ch)->{topic};
}

sub username
{
	my ($self) = @_;
	return $self->{config}->{dAmn}->{username};
}


# ============================================================================
# dAmnBot->damn_*
#		dAmn commands
# ============================================================================

sub damn_admin
{
	my ($self, $ch, $data) = @_;

	$self->_put(
		$self->_build_packet(
			'send', "chat:$ch",
			"\nadmin",
			($data)
		)
	);
}

sub damn_ban
{
	my ($self, $ch, $nick) = @_;
	my $grp = $self->privclasses($ch)->{1};

	$self->damn_demote($ch, $nick, $grp);
}

sub damn_demote
{
	my ($self, $ch, $nick, $grp) = @_;

	$self->_put(
		$self->_build_packet(
			'send', "chat:$ch",
			"\ndemote $nick",
			($grp ? ($grp) : ())
		)
	);
}

sub damn_join
{
	my ($self, $channel) = @_;

	$self->_put(
		$self->_build_packet(
			'join', "chat:$channel"
		)
	);
}

sub damn_kick
{
	my ($self, $ch, $nick, $reason) = @_;

	$self->_put(
		$self->_build_packet(
			'kick', "chat:$ch",
			"u=$nick",
			($reason)
		)
	);
}

sub damn_login
{
	my ($self) = @_;

	$self->_get_authtoken($self->username(), $self->password())
		unless($self->authtoken());

	$self->_put(
		$self->_build_packet(
			'login', $self->username(),
			'pk=' .  $self->authtoken()
		)
	);
}

# Thank you, NoodleBot
sub damn_note
{
	my ($self, $nick, $subj, $msg) = @_;

	my $sendto  = $self->_urlencode($nick);
	my $subject = $self->_urlencode($subj);
	my $body    = $self->_urlencode($msg);
	my $ref     = $self->_urlencode("http://my.deviantart.com/notes/");

	my $payload = sprintf 'ref=%s&recipients=%s&subject=%s&body=%s&friends=',
	                      $ref, $sendto, $subject, $body;
	my $len     = length $payload;

	$self->_debug("damn_note(): $payload.\n");

	my $ui = $self->{userinfo};

	my $packet = qq(POST /notes/send HTTP/1.1\r\nHost: my.deviantart.com\r\nUser-Agent: sendnote.pl/0.1\r\nAccept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5\r\nAccept-Language: en-us,en;q=0.5\r\nAccept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7\r\nKeep-Alive: 300\r\nConnection: keep-alive\r\nReferer: http://my.deviantart.com/notes/\r\nContent-Type: application/x-www-form-urlencoded\r\nCookie: $ui\r\nContent-Length: ${len}\r\n\r\n${payload});

	my $socket = IO::Socket::INET->new(
		PeerAddr => 'my.deviantart.com',
		PeerPort => 80,
		Proto => 'tcp'
	) or die "Unable to open socket: $!";

	print $socket $packet;

	my $response = join("\n", <$socket>);
	$self->_debug("damn_note(): $response\n");

	close $socket;

	return ($response =~ m|HTTP/1\.1 302|) ? 1 : 0;
}

sub damn_part
{
	my ($self, $channel) = @_;

	$self->_put(
		$self->_build_packet(
			'part', "chat:$channel"
		)
	);
}

sub damn_parse_tab_lumps
{
	my ($self, $t) = @_;
  
	return $t unless $t;

	my $tlc = $self->{config}->{dAmn}->{tablumps};
  
	while($t =~ m/&((?:[^\t\&]+\t+)+|(?:\t))/g) {
		my ($tablump, $pos) = ($1, pos($t));
		my ($cmd, @args) = split /\t/, $tablump;
		my $tl;
    
		$cmd = '' unless $cmd;

		if($cmd eq '') {
			$tl = '';
		} else {
			my $handler;
			if(exists $tlc->{$cmd}) {
				$handler = $tlc->{$cmd};
			} elsif(exists $tlc->{'_'}) {
				$handler = $tlc->{'_'};
			}
			if($handler) {
				if(ref($handler) eq 'CODE') {
					$tl = $handler->($cmd, @args);
				} else {
					my ($tpl, $i) = ($handler, 0);
					$tpl =~ s/\{cmd\}/$cmd/g;

					for(; $i <= $#args; $i++) {
						$tpl =~ s/\{$i\}/$args[$i]/g;
					}
					$tpl =~ s/\{\d\}//g;

					$tl = $tpl;
				}
			} else {
				$tl  = "<$cmd";
				$tl .= '[' . join('|', @args) . ']' if @args;
				$tl .= '>';
			}
		}

		substr($t, $pos-length($tablump)-1, length($tablump)+1, $tl);
	}
  
	return $t;
}

sub damn_pjoin
{
	my ($self, $user) = @_;
	my $me = lc($self->username());
	$user  = lc($user);

	my $chan = ($me lt $user) ? "$me:$user" : "$user:$me";
		

	$self->_put(
		$self->_build_packet(
			'join', "pchat:$chan"
		)
	);
}

sub damn_pong
{
	my ($self) = @_;

	$self->_put("pong\n\000");
}

sub damn_promote
{
	my ($self, $ch, $nick, $grp) = @_;

	$self->_put(
		$self->_build_packet(
			'send', "chat:$ch",
			"\npromote $nick",
			($grp ? ($grp) : ())
		)
	);
}

sub damn_raw_send
{
	my ($self, $data) = @_;
	$self->_put($data);
}

sub damn_send
{
	my ($self, $ch, $msg) = @_;
	my @msg_arr = (ref($msg) eq 'ARRAY' ? @{$msg} : split(/\n/, $msg));

	$self->_put(
		$self->_build_packet(
			'send',
			"chat:$ch", "\nmsg main",
			@msg_arr
		)
	);
}

# ============================================================================
# dAmnBot->_put($data)
#		Post $data to server.
# ============================================================================

sub _put
{
	my ($self, $data) = @_;

	$self->{heap}->{server}->put($data);
}

# ============================================================================
# Data manipulation methods
# ============================================================================

# _get_authtoken, _build_packet, _parse_ih, _parse_packet: from dAmnhack
sub _get_authtoken
{
	my ($self, $username, $password) = @_;
	my $authtoken;
	my $ui;

	my $socket = IO::Socket::INET->new(
		PeerAddr => 'www.deviantart.com',
		PeerPort => 80,
		Proto => 'tcp'
	) or die "Unable to open socket: $!";

	my $payload = "username=${username}&password=${password}&reusetoken=1";
	my $l = length($payload);
	my $packet = qq(POST /users/login HTTP/1.1\r\nHost: www.deviantart.com\r\nUser-Agent: getauth.pl/0.1\r\nAccept: text/html\r\nCookie: skipintro=1\r\nContent-Type: application/x-www-form-urlencoded\r\nContent-Length: ${l}\r\n\r\n${payload});

	print $socket $packet;

	while(defined (my $line = <$socket>)) {
		if($line =~ m/^Set-Cookie: /) {
			my ($userinfo) = ($line =~ m/\b(userinfo=[^\s]+)\b/);
			$ui = $userinfo;
			$userinfo =~ s/\+/ /g;
			$userinfo =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("c",hex($1))/eg;
			($authtoken) = ($userinfo =~ m/"authtoken";s:32:"([0-9a-f]{32})";/);
			last;
		}
	}

	print "Got authtoken for $username ($authtoken)\n"
		if($authtoken && $self->{config}->{trace});

	$self->{userinfo}  = ($ui)        ? $ui        : 0;
	$self->{authtoken} = ($authtoken) ? $authtoken : 0;
	return ($authtoken) ? 1 : 0;
}

sub _build_packet
{
	my ($self, $cmd, $param, $arg, @body) = @_;
  
	my $pkt = '';

	if($param and $param =~ /^chat:(.*):(.*)/) {
		$param = "p$param";
	}

	$pkt .= $cmd;
	$pkt .= " $param" if $param;
	$pkt .= "\n";
	$pkt .= "$arg\n" if $arg;
	$pkt .= "\n" . join("\n", @body) if @body;
	$pkt .= "\000";
  
	return $pkt;
}

sub _parse_ih
{
	my ($self, @f) = @_;
	my %r;

	foreach my $l(@f) {
		next unless $l;
		my ($k, $v) = split /=/, $l;
		$r{$k} = $v;
	}

	return %r;
}

sub _parse_packet
{
	my ($self, $packet) = @_;

	my ($cmd, $param, $arg, @body, $channel);
	my @lines = split(/\n/, $packet);

	($cmd, $param) = split(/ /, $lines[0]);

	$arg = $lines[1] if ($#lines >= 1);
	@body = @lines[2..$#lines] if ($#lines >= 2);

	if($cmd =~ m/^(send|recv)$/) {
		(undef, $channel) = split(/:/, $param);
	}

	$param = '' unless $param;
	$arg = '' unless $arg;
	@body = () unless @body;
	$channel = '' unless $channel;
  
	return (
		cmd     => $cmd,
		param   => $param,
		arg     => $arg,
		body    => \@body,
		channel => $channel
	);
}

sub _urlencode
{
	my ($self, $toencode) = @_;

	$toencode =~ s/([^a-zA-Z 0-9_\\\-@.=])/sprintf("%%%02X",ord($1))/ego;
	$toencode =~ s/ /+/gm;

	return $toencode;
}


# ============================================================================
# dAmnBot->handle_*()
#		Default handlers for dAmn events.
# ============================================================================

sub handle_dAmnServer
{
	my ($self) = @_;

	$self->damn_login();
}

sub handle_kick
{
	my ($self, $p, $ch, $nick) = @_;

	my $m = $self->members($ch);

	if(exists $m->{$nick}) {
		delete $m->{$nick};
	}
	$self->_debug(Dumper($m), "\n");
}

sub handle_login
{
	my ($self) = @_;

	$self->_debug("Logged in.\n");

	my $chans = $self->channels();

	for my $ch (@{$chans}) {

		$self->_debug("\tJoining #$ch.\n");

		$self->damn_join($ch);
	}
}

sub handle_members
{
	my ($self, $p, $ch) = @_;

	my $members = $self->members($ch);
	my $pcs     = $self->privclasses($ch);

	my @ma = split(/\n\n/, join("\n", @{$p->{body}}));
	if(@ma) {
		for my $m (@ma) {
			my @m = split(/\n/, $m);
			my %m;
			for my $n (@m) {
				my ($k, $v) = split(/=/,$n,2);
				if($k) {
					if($k =~ /member (.*)/) {
						$m{nick} = $1;
					} else {
						$m{$k} = $v;
					}
				}
			}
			$m{pcid} = $pcs->{$m{pc}}
				if(exists $m{pc} and exists $pcs->{$m{pc}});
			$m{joincount} = 1;
			$members->{$m{nick}} = $m = \%m;
		}
	}

	$self->_debug(Dumper($members), "\n");
}

sub handle_misc
{
	my ($self, $p, $ch) = @_;
	$self->_debug('Command: ', join('|', @{$p->{body}}), "\n");
}

sub handle_msg
{
	my ($self, $p, $ch, $targ) = @_;

	if($targ eq 'main') {
		my ($chan, undef, $nick, $msg) =
			($ch, split(/=/, $p->{body}->[1]), $p->{body}->[3]);

		$self->_debug("#$chan: <$nick> $msg\n");
	} else {
		carp "Unknown target, $targ";
	}
}

sub handle_privclasses
{
	my($self, $p, $ch) = @_;

	my $pcs = $self->privclasses($ch);

	for my $pc (@{$p->{body}}) {
		my ($pid, $name) = split(/:/, $pc);
		if($pid && $name) {
			$pcs->{$name} = $pid;
			$pcs->{$pid}  = $name;
		}
	}
	$self->_debug(Dumper($pcs), "\n");
}

sub handle_ping
{
	my ($self) = @_;

	$self->_debug("Sending pong.\n");

	$self->damn_pong();
}

sub handle_privchg
{
	my ($self, $p, $ch, $nick) = @_;
	my (undef, $pc) = split(/=/, $p->{body}->[2]);

	my $m = $self->members($ch);
	my $pcs = $self->privchannels($ch);

	if(exists $m->{$nick}) {
		$m->{$nick}->{pc} = $pc;
		$m->{$nick}->{pcid} = $pcs->{$pc};

		$self->_debug(Dumper($m), "\n");
	}
}

sub handle_recv_join
{
	my ($self, $p, $ch, $targ) = @_;
	my %ih = $self->_parse_ih(@{$p->{body}});

	my $members = $self->members($ch);
	my $pcs     = $self->privclasses($ch);

	for my $k (keys %ih) {
		if($k =~ /join (.*)/) {
			$ih{nick} = $1;
			delete $ih{$k};
		}
	}
	$ih{pcid} = $pcs->{$ih{pc}}
		if(exists $ih{pc} and exists $pcs->{$ih{pc}});

	if(exists $members->{$ih{nick}}) {
		$members->{$ih{nick}}->{joincount}++
	} else {
		$members->{$ih{nick}} = \%ih;
	}

	$self->_debug(Dumper($members), "\n");
}

sub handle_recv_part
{
	my ($self, $p, $ch, $nick) = @_;

	my $members = $self->members($ch);

	if(exists $members->{$nick}) {
		delete $members->{$nick};
	}

	$self->_debug(Dumper($members));
}

sub handle_title
{
	my ($self, $p, $ch, $title) = @_;
	my $ci = $self->channelinfo($ch);

	$ci->{title} = $title;
}

sub handle_topic
{
	my ($self, $p, $ch, $topic) = @_;
	my $ci = $self->channelinfo($ch);

	$ci->{topic} = $topic;
}


1;

__END__

=head1 NAME

dAmnBot - Framework for creating dAmn bots.

=head1 SYNOPSIS

 use dAmnBot;

 # These are default values and handlers for all options
 dAmnBot->new({
   debug => 0,
   trace => 0,
   dAmn => {
     username => '',
     password => '',
     channels => ['', ''],
     command_prefix => '!',
     handlers => {
       dAmnServer => \&handle_dAmnServer,
       login      => \&handle_login,
       join       => \&handle_misc,
       part       => \&handle_misc,
       property => {
         members     => \&handle_members,
         privclasses => \&handle_privclasses,
         title       => \&handle_title,
         topic       => \&handle_topic,
       },
       recv  => {
         msg         => \&handle_msg,
         action      => \&handle_msg,
         join        => \&handle_recv_join,
         part        => \&handle_recv_part,
         privchg     => \&handle_privchg,
         kicked      => \&handle_kick,
       },
       send       => \&handle_misc,
       ping       => \&handle_ping,
       other      => \&handle_misc,
       bot        => {
#        xyzzy => sub {
#        my ($damn, $channel) = @_;
#          $damn->damn_send($channel, "Nothing happens.");
#        },
#			_     => sub { # default handler
#				my ($damn, $channel, $cmd) = @_;
#				carp "Unhandled command: $cmd!";
#			},
       },
     }
     tablumps => {
       emote  => '{0}',
       link   => '<{0}>',
       img    => '<{cmd}:{0}>', # {cmd} is the "command"; in this case: img
       dev    => '<http://{1}.deviantart.com/> ({0}{1})',
       thumb  => '<http://www.deviantart.com/view/{0}/> (\'{1}\' by {2})',
       avatar => '<{0}>',
       br     => "\n\t",
       _      => sub { # replacements can be function references. _ is the default handler
         my ($cmd, @args) = @_;
         my $t = "<$cmd";
         $t   .= '[' . join('|', @args) . ']' if @args;
         $t   .= '>';
         return $t;
       },
     },
   },
   server => {
       host => 'chat.deviantart.com',
       port => 3900,
   },
 });

=head1 DESCRIPTION

This module provides a framework for creating a dAmn bot. It
keeps an automatically updated list of users connected to a given
channel, and is customised by plugging in handlers for dAmn
events.


=head1 HANDLERS

Handlers receive two arguments: B<$damn> and B<$packet>. Respectively:
a reference to a dAmnBot object, and a reference to a hash containing the received
packet. Where applicable, handlers also receive a third argument: $channel. Some
handlers also receive a fourth, context-specific, argument:

I<title> and I<topic> receive the title or topic and all the I<recv> handlers
receive the 'target' of the action (username, &c).

=head2 BOT COMMANDS

Bot action handlers receive all recv=>msg events where the message
begins with I<command_prefix>. They receive four arguments: B<$damn>,
B<$username>, B<$command>, and B<@arguments>.

You can also define a default handler, which will be passed all commands
that don't have handlers associated with them, by adding a '_' field
to the dAmn=>handlers=>bot hash.

=head2 $packet

The structure of B<$packet> is as follows:

 $packet = {
   cmd     => $cmd,
   param   => $param,
   arg     => $arg,
   body    => @body,
   channel => $channel # recv and send events
 };

=head1 THE $damn OBJECT

The damn object contains the following methods and properties:

=over 8

=item B<$damn-E<gt>channels()>

Returns an array containing the names of all channels dAmnBot is
connected to.

=item B<$damn-E<gt>channelinfo($channel)>

Returns the channel information structure for I<$channel>.

=item B<$damn-E<gt>members($channel)>

Returns the members in I<$channel>, indexed by nick name.

=item B<$damn-E<gt>privclasses($channel)>

Returns the privclasses in I<$channel>, indexed by both name
and id.

=item B<$damn-E<gt>topic($channel)>

=item B<$damn-E<gt>title($channel)>

Return the topic/title of I<$channel>.

=item B<$damn-E<gt>username()>

Returns the username of the bot.

=item B<$damn-E<gt>password()>

Returns the password of the bot.

=item B<$damn-E<gt>authtoken()>

Returns the authtoken of the bot.

=item B<$damn-E<gt>damn_admin($channel, $data)>

Perform /admin command in I<$channel>, with I<$data> as argument.

=item B<$damn-E<gt>damn_ban($channel, $user)>

In I<$channel>: demote I<$user> to the group with ID 1 -- i.e., ban them.

=item B<$damn-E<gt>damn_demote($channel, $user, [$group])>

Demote I<$user> to I<$group>, or if I<$group> is omitted,
demote them one step.

=item B<$damn-E<gt>damn_join($channel)>

Join I<$channel> (sans '#').

=item B<$damn-E<gt>damn_kick($channel, $user, $reason)>

Kick I<$user> for I<$reason>.

=item B<$damn-E<gt>damn_login()>

Log in to the dAmn server. No arguments. You shouldn't need
to use this.

=item B<$damn-E<gt>damn_note($user, $subject, $body)>

Send I<$user> a deviantNOTE with the subject of I<$subject> and a
body of I<$body>.

=item B<$damn-E<gt>damn_part($channel)>

Leave I<$channel> (sans '#').

=item B<$damn-E<gt>damn_parse_tab_lumbs($text)>

Parse 'tablumps' (dAmn formatting codes) in I<$text>. Performs replacements
as specified in I<$damn-E<gt>{config}-E<gt>{dAmn}-E<gt>{tablumps}>.

=item B<$damn-E<gt>damn_pjoin($user)>

Join a private chat with $user. Equivalent to calling C<$damn-E<gt>damn_join($un lt $user ? "$un:$user" : "$user:$un");>
($un == $damn-E<gt>username).

=item B<$damn-E<gt>damn_pong()>

Send a pong to dAmnServer. You need to call this in a ping handler
or you'll be kicked off the server.

=item B<$damn-E<gt>damn_promote($channel, $user, $group)>

Promote I<$user> to I<$group> in I<$channel>. Or, if I<$group> is omitted,
promote them one step.

=item B<$damn-E<gt>damn_raw_send($channel, $data)>

Send raw data I<$data> to dAmnServer.

=item B<$damn-E<gt>damn_send($channel, $msg)>

Send the message I<$msg> in I<$channel>. I<$msg> can be either a string or a
reference to an array of strings.

=item B<$damn-E<gt>{config}>

Contains all options passed to dAmnBot->new().

=item B<$damn-E<gt>{heap}>

A reference to the L<POE::Component::Client::TCP> heap. You shouldn't
need to access this.

=back

=head1 LICENSE & DISCLAIMER

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

=head1 AUTHOR & COPYRIGHT

Copyright (c) 2007 Kalle Räisänen <kal@five-by-five.se>

=head1 SEE ALSO

L<http://chat.deviantart.com/>, L<http://moeffju.net/w/dAmn/moin.cgi/dAmn/Protocol>,
L<POE::Component::Client::TCP>.

=cut