Original Piddlebot.pl

piddlebot.pl

#!/usr/bin/perl
use strict;
use warnings;

use POE;
use POE::Component::IRC::State;
use POE::Component::IRC::Plugin::AutoJoin;
#use POE::Component::IRC::Plugin::BotTraffic;
use POE::Component::IRC::Plugin::BotCommand;
use POE::Component::IRC::Plugin::CycleEmpty;

use PDL::Doc;
# Find the pdl documentation
my ($d,$f);
my $pdldoc;
DIRECTORY: for $d (@INC) {
	$f = $d."/PDL/pdldoc.db";
	if (-f $f) {
		print "Found docs database $f\n";
		$pdldoc = new PDL::Doc ($f);
		last DIRECTORY;
	}
}

die("Unable to find docs\n") unless $pdldoc;

my $irc = POE::Component::IRC::State->spawn(
	Nick   => 'piddlebot',
	Server => 'irc.perl.org',
);
print "Spawned bot...\n";

POE::Session->create(
	package_states => [
		main => [ qw(_start irc_join irc_botcmd_whereis irc_botcmd_leave) ]
	]
);


$poe_kernel->run();


sub _start {
	print "Starting...\n";
	$irc->plugin_add('AutoJoin', POE::Component::IRC::Plugin::AutoJoin->new(
		Channels => [ '#pdl' ]
	));
	print "Added AutoJoin...\n";

	$irc->plugin_add('CycleEmpty', POE::Component::IRC::Plugin::CycleEmpty->new());

	$irc->plugin_add('BotCommand', POE::Component::IRC::Plugin::BotCommand->new(
		Commands => {
			whereis => 'Returns a url to documentation for the requested function',
			leave   => 'Makes me leave',
		}
	));
	print "Added BotCommand...\n";

	
	$irc->yield(register => qw(join botcmd_whereis botcmd_leave));
	$irc->yield('connect');
}

my @channel_ops = qw(run4flat Hyppolit_pdl);

sub irc_join {
	print "Got join message...\n";
	my $nick = (split /!/, $_[ARG0])[0];
	my $channel = $_[ARG1];

	# only send the message if we were the one joining
	if ($nick eq $irc->nick_name()) {
		$irc->yield(privmsg => $channel, 'Hi everybody!');
	}
	elsif ($nick ~~ @channel_ops) {
		if ($irc->is_operator($nick)) {
			$irc->yield(privmsg => $channel, "I see $nick is already an op");
		}
		else {
			$irc->yield(privmsg => $channel, "/op $nick");
		}
	}
}

# Looks up a function in the help and passes along a useful
# url for more information.
sub irc_botcmd_whereis {
	my $nick = (split /!/, $_[ARG0])[0];
	my ($channel, $command) = @_[ARG1, ARG2];

	my $where_is = '';
	my @matches = $pdldoc->search("m/^(PDL::)?$command\$/", ['Name']);
	if (@matches) {
		$where_is = "Found $command in ";
		my @modules;
		foreach my $match (@matches) {
			(undef, my $hash) = @$match;
			my $module = $hash->{Module};
			# Build the url:
			(my $url = $module) =~ s/^PDL:://;
			$url =~ s/::/\//g;
			$url = 'http://pdl.sourceforge.net/PDLdocs/' . $url . ".html#$command";
			push @modules, "$module ($url)";
		}
		$where_is .= join ', ', @modules;
	}
	else {
		$where_is = "Could not find $command.";
	}

	print "Got usage request from $nick for $command\nResults are $where_is\n";
	
	$irc->yield(privmsg => $channel, "$nick: $where_is");
	return;
}

sub irc_botcmd_leave {
	my $nick = (split /!/, $_[ARG0])[0];

	my ($channel, $command) = @_[ARG1, ARG2];
	print "Got leave command from $nick\n";
	if ($nick eq 'run4flat') {
		$irc->yield(shutdown => "Even bots have to take breaks!");
	}
	$irc->yield(privmsg => $channel, "Sorry, only David can stop me.");
	return;
}