Piddlebot, used on irc.perl.org#pdl

piddlebot.pl

#!/usr/bin/perl
use warnings;
use strict;
use POE;
use POE::Component::IRC::State;
use constant CHANNEL => '#pdl';

# Load the current piddlebot functions:
use piddlebot;
my $last_modified = (stat('piddlebot.pm'))[9];

# Create the component that will represent an IRC network.
our ($irc) = POE::Component::IRC::State->spawn();
our $my_nick = 'liddle_piddle_bot';

# Make sure the bot gets operator status
use POE::Component::IRC::Plugin::CycleEmpty;
$irc->plugin_add('CycleEmpty', POE::Component::IRC::Plugin::CycleEmpty->new());

# Create the bot session using methods in the main package, which are
# defined below. Note that irc_public, irc_message, and irc_join are just
# stubs that ensure the latest piddlebot.pm has been loaded, and then calls
# the latest do* response function. This way, I can make updates to the bot
# without having to restart it.
POE::Session->create(
	package_states => [
		main => [ qw(_start irc_001 irc_join irc_public irc_msg) ]
	]
);

# Run the bot!
$poe_kernel->run();



#!!!!!!!!!!!!!! No lexicals below this point !!!!!!!!!!!!!!#

# The bot session has started.  Register this bot with the "magnet"
# IRC component. Select a nickname. Connect to a server.
sub _start {
	$irc->yield(register => "all");
	$irc->yield(
		connect => {
			Nick     => $my_nick,
			Server   => 'irc.perl.org',
			Port     => '6667',
		}
	);
}

# A function that ensures that the latest piddlebot.pm is in use:
sub ensure_up_to_date {
	my $latest_modified = (stat('piddlebot.pm'))[9];
	do 'piddlebot.pm' if $last_modified < $latest_modified;
}

# The bot has successfully connected to a server.  Join a channel.
sub irc_001 {
	$irc->yield(join => CHANNEL);
}

############# Modifiable Callbacks #############

# The bot has received a public message. Reload the latest and 
sub irc_public {
	ensure_up_to_date;
	goto &do_public_response;
}

# The bot has received a public message.  Parse it for commands, and
# respond to interesting things.
sub irc_msg {
	ensure_up_to_date;
	goto &do_private_response;
}

sub irc_join {
	ensure_up_to_date;
	goto &do_join;
}

############# Response and Logging Functions #############

# Save the message to the logfile:
sub log_it {
	open my $logfile, '>>', 'pdl.log';
	my $ts = scalar localtime;

	print $logfile " [$ts] ", @_;
	print $logfile "\n" if (substr($_[-1], -1) ne "\n"); 
}

sub say_it {
	$irc->yield(privmsg => CHANNEL, join('', @_));
	log_it(@_);
}

piddlebot.pm

use strict;
use warnings;

our ($irc, $my_name);

# Load the channel ops file:
open my $fh, '<', 'pdl-channel-ops.txt';
my %ops;
while(my $line = <$fh>) {
	chomp $line;
	$ops{$line}++;
}
close $fh;

# Sub to write the verifications file out to disk:
sub write_out {
	open $fh, '>', 'pdl-channel-ops.txt';
	foreach my $nick (keys %ops) {
		print $fh "$nick\n";
	}
	close $fh;
}

sub private_message {
	my $nick = shift;
	for my $line (@_) {
		$irc->yield(privmsg => $nick, $line);
	}
}

# Find the pdl documentation
use PDL::Doc;
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;
	}
}

############# Doers #############

sub do_public_response {
	my ($kernel, $who, $where, $msg) = @_[KERNEL, ARG0, ARG1, ARG2];
	my $nick    = (split /!/, $who)[0];
	log_it("<$nick> $msg\n");
	
	# Construct hyperlink if cpan is requested:
	if ($msg =~ /^cpan (.+)/) {
		say_it("http://p3rl.org/$1");
	}
	# Construct a link to the docs on the web site:
	elsif ($msg =~ /^help (.+)/) {
		my $to_find = $1;
		(my $location = $to_find) =~ s{::}{/}g;
		say_it("$nick: http://pdl.perl.org/?docs=$location&title=PDL::$to_find");
	}
	elsif ($msg =~ /^paste/) {
		say_it("$nick: http://scsys.co.uk:8001/");
	}
	elsif ($msg =~ /^liddle_piddle_bot.+?trust (\S+)/) {
		my $to_op = $1;
		chomp $to_op;
		if ($ops{$nick}) {
			# Op the person:
			$irc->yield(mode => '#pdl +o', $to_op);
			
			# Add the ident as a trusted nick
			$ops{$to_op}++;
			write_out();
			
			# Send the new user their temporary password:
			private_message($to_op
				, "Welcome, $to_op, to the inner sanctum. To learn more about what this means, please read"
				, "https://github.com/PDLPorters/pdl/wiki/PDL-IRC"
			);
			
		}
		else {
			say_it("Silly $nick: only trusted users can tell me to trust someone");
		}
	}
	elsif ($msg =~ /^whereis (.*)/) {
		my $command = $1;
		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;
			say_it("$nick: $where_is");
		}
		else {
			say_it("$nick: Could not find $command.");
		}
	}


}

sub do_private_response {
	my ($who, $message) = @_[ARG0, ARG2];
	my $nick = (split /!/, $who)[0];
	
	private_message($nick, "https://github.com/PDLPorters/pdl/wiki/PDL-IRC");
}

sub do_join {
	my ($who, $channel) = @_[ARG0, ARG1];
	my $nick = (split /!/, $who)[0];

	# Make an op if they're recognized:
	if ($ops{$nick}) {
		$irc->yield(mode => '#pdl +o', $nick);
	}

# Handy way to deliver one-off messages to a particular nick:	
#	if ($nick eq 'run4flat' and not -f 'run4flat.told') {
#		say_it('This is a test');
#		`touch run4flat.told`;
#	}

}

1;